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 aab935dbf4..063a63b183 100644 --- a/.gitignore +++ b/.gitignore @@ -1,106 +1,26 @@ +.DS_Store .bash_history .cache +.cargo +.config .mal-history +.mal_history .crystal .lein +.local .m2 .ivy2 .sbt +.npm +.node-gyp */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 +node_modules */notes - +GPATH +GTAGS +GRTAGS logs old - -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/build -factor/mal.factor -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 -js/mal.js -js/web/mal.js -kotlin/*.jar -kotlin/.idea -kotlin/*.iml -lua/lib -lua/linenoise.so -lua/mal.lua -make/mal.mk -mal/mal.mal -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 -ps/mal.ps -python/mal.pyz -r/mal.r -ruby/mal.rb -rust/target/ -rust/Cargo.lock -rust/.cargo -r/lib -scala/mal.jar -scala/target -scala/project -tcl/mal.tcl -vb/*.exe -vb/*.dll -vimscript/mal.vim +tmp/ +.xslt_mal_history +zig-cache/ diff --git a/.travis.yml b/.travis.yml index 8ab564836f..0e27995da0 100644 --- a/.travis.yml +++ b/.travis.yml @@ -5,77 +5,15 @@ sudo: required matrix: include: - - {env: IMPL=ada, services: [docker]} - - {env: IMPL=awk, services: [docker]} - - {env: IMPL=bash, services: [docker]} - - {env: IMPL=c, services: [docker]} - - {env: IMPL=cpp, services: [docker]} - - {env: IMPL=coffee, services: [docker]} - - {env: IMPL=cs, services: [docker]} - - {env: IMPL=clojure, services: [docker]} - - {env: IMPL=crystal, services: [docker]} - - {env: IMPL=d, services: [docker]} - - {env: IMPL=elisp, services: [docker]} - - {env: IMPL=elixir, services: [docker]} - - {env: IMPL=erlang NO_PERF=1, services: [docker]} # perf runs out of memory - - {env: IMPL=es6, services: [docker]} - - {env: IMPL=factor, services: [docker]} - - {env: IMPL=forth, services: [docker]} - - {env: IMPL=fsharp, services: [docker]} - - {env: IMPL=go, services: [docker]} - - {env: IMPL=groovy, services: [docker]} - - {env: IMPL=guile, services: [docker]} - - {env: IMPL=haskell, services: [docker]} - - {env: IMPL=haxe, services: [docker]} - - {env: IMPL=io, services: [docker]} - - {env: IMPL=java, services: [docker]} - - {env: IMPL=js, services: [docker]} - - {env: IMPL=julia, services: [docker]} - - {env: IMPL=kotlin, services: [docker]} - - {env: IMPL=lua, services: [docker]} - - {env: IMPL=make, services: [docker]} - - {env: IMPL=mal BUILD_IMPL=js NO_PERF=1, services: [docker]} - - {env: IMPL=matlab, services: [docker]} # Uses Octave - - {env: IMPL=miniMAL BUILD_IMPL=js, services: [docker]} - - {env: IMPL=nim, services: [docker]} - - {env: IMPL=objpascal, services: [docker]} - {env: IMPL=objc NO_DOCKER=1, os: osx, osx_image: xcode7} - - {env: IMPL=objc, services: [docker]} - - {env: IMPL=ocaml, services: [docker]} - - {env: IMPL=perl, services: [docker]} - - {env: IMPL=perl6, services: [docker]} - - {env: IMPL=php, services: [docker]} - - {env: IMPL=plpgsql, services: [docker]} -# - {env: IMPL=plsql, services: [docker]} - - {env: IMPL=ps, services: [docker]} - - {env: IMPL=python, services: [docker]} - - {env: IMPL=r, services: [docker]} - - {env: IMPL=racket, services: [docker]} - - {env: IMPL=rpython, services: [docker]} - - {env: IMPL=ruby, services: [docker]} - - {env: IMPL=rust, services: [docker]} - - {env: IMPL=scala, services: [docker]} - - {env: IMPL=swift NO_DOCKER=1, os: osx, osx_image: xcode7} - - {env: IMPL=swift3, services: [docker]} - - {env: IMPL=swift3 NO_DOCKER=1, os: osx, osx_image: xcode7} - - {env: IMPL=tcl, services: [docker]} - - {env: IMPL=vb, services: [docker]} - - {env: IMPL=vhdl, services: [docker]} - - {env: IMPL=vimscript, services: [docker]} + - {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 - - ./.travis_build.sh - - # Regular tests - - ./.travis_test.sh test ${IMPL} - - cat test.err || true - - # NOTE: use self-host-test branch - # Self-hosted tests - #- ./.travis_test.sh test mal ${IMPL} - #- cat test.err || true; rm -f test.err - - # Performance tests - - if [ -z "${NO_PERF}" ]; then ./.travis_test.sh perf ${IMPL}; fi - - cat perf.err || true + # 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/.travis_build.sh b/.travis_build.sh deleted file mode 100755 index 308965ec24..0000000000 --- a/.travis_build.sh +++ /dev/null @@ -1,27 +0,0 @@ -#!/bin/bash - -set -ex - -BUILD_IMPL=${BUILD_IMPL:-${IMPL}} - -# If NO_DOCKER is blank then launch use a docker image, otherwise -# use the Travis image/tools directly. -if [ -z "${NO_DOCKER}" ]; then - impl=$(echo "${IMPL}" | tr '[:upper:]' '[:lower:]') - img_impl=$(echo "${BUILD_IMPL}" | tr '[:upper:]' '[:lower:]') - - docker pull kanaka/mal-test-${impl} - if [ "${impl}" != "${img_impl}" ]; then - docker pull kanaka/mal-test-${img_impl} - fi - if [ "${BUILD_IMPL}" = "rpython" ]; then - # rpython often fails on step9 in compute_vars_longevity - # so build step9, then continue wit the full build - docker run -it -u $(id -u) -v `pwd`:/mal kanaka/mal-test-${img_impl} \ - make -C ${BUILD_IMPL} step9_try || true - fi - docker run -it -u $(id -u) -v `pwd`:/mal kanaka/mal-test-${img_impl} \ - make -C ${BUILD_IMPL} -else - make -C ${BUILD_IMPL} -fi diff --git a/.travis_test.sh b/.travis_test.sh deleted file mode 100755 index af5d16c61b..0000000000 --- a/.travis_test.sh +++ /dev/null @@ -1,28 +0,0 @@ -#!/bin/bash - -set -ex - -ACTION=${1} -IMPL=${2} -MAL_IMPL=${3:-js} - -echo "ACTION: ${ACTION}" -echo "IMPL: ${IMPL}" -echo "MAL_IMPL: ${MAL_IMPL}" - -# If NO_DOCKER is blank then launch use a docker image, otherwise use -# the Travis image/tools directly. -if [ "${NO_DOCKER}" ]; then - MAKE="make" -else - impl=$(echo "${IMPL}" | tr '[:upper:]' '[:lower:]') - img_impl=$(echo "${3:-${IMPL}}" | tr '[:upper:]' '[:lower:]') - - MAKE="docker run -it -u $(id -u) -v `pwd`:/mal kanaka/mal-test-${img_impl} make" -fi - -${MAKE} TEST_OPTS="--debug-file ../${ACTION}.err" \ - MAL_IMPL=${MAL_IMPL} ${ACTION}^${IMPL} - -# no failure so remove error log -rm -f ${ACTION}.err || true 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 index 3bfdf5f61e..88b2867725 100644 --- a/LICENSE +++ b/LICENSE @@ -4,7 +4,7 @@ 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 +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. diff --git a/Makefile b/Makefile index 9272606aeb..ff1cd7a643 100644 --- a/Makefile +++ b/Makefile @@ -6,7 +6,9 @@ all help: @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' @@ -32,22 +34,26 @@ all help: @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 -USE_MATLAB = -# python, js, cpp, or neko are currently supported -HAXE_MODE = neko +# Path to loccount for counting LOC stats +LOCCOUNT = loccount # Extra options to pass to runtest.py TEST_OPTS = @@ -57,30 +63,19 @@ TEST_OPTS = # later steps. REGRESS = +HARD= DEFERRABLE=1 OPTIONAL=1 -# Extra implementation specific options to pass to runtest.py -mal_TEST_OPTS = --start-timeout 60 --test-timeout 120 -miniMAL_TEST_OPTS = --start-timeout 60 --test-timeout 120 -plpgsql_TEST_OPTS = --start-timeout 60 --test-timeout 180 -plsql_TEST_OPTS = --start-timeout 120 --test-timeout 120 -perl6_TEST_OPTS = --test-timeout=60 - -DOCKERIZE= - # Run target/rule within docker image for the implementation DOCKERIZE = + # -# Settings +# General settings and utility functions # -IMPLS = ada awk bash c d clojure coffee cpp crystal cs erlang elisp \ - elixir es6 factor forth fsharp go groovy guile haskell haxe \ - io java julia js kotlin lua make mal ocaml matlab miniMAL \ - nim objc objpascal perl perl6 php plpgsql plsql ps python r \ - racket rpython ruby rust scala swift swift3 tcl vb vhdl vimscript +EXTENSION = .mal step0 = step0_repl step1 = step1_read_print @@ -94,6 +89,9 @@ step8 = step8_macros step9 = step9_try stepA = stepA_mal +argv_STEP = step6_file + + regress_step0 = step0 regress_step1 = step1 regress_step2 = step2 @@ -106,28 +104,13 @@ regress_step8 = $(regress_step7) step8 regress_step9 = $(regress_step8) step9 regress_stepA = $(regress_step9) stepA -test_EXCLUDES += test^bash^step5 # never completes at 10,000 -test_EXCLUDES += test^make^step5 # no TCO capability (iteration or recursion) -test_EXCLUDES += test^mal^step5 # host impl dependent -test_EXCLUDES += test^matlab^step5 # never completes at 10,000 -test_EXCLUDES += test^plpgsql^step5 # too slow for 10,000 -test_EXCLUDES += test^plsql^step5 # too slow for 10,000 - -perf_EXCLUDES = mal # TODO: fix this - -dist_EXCLUDES += mal -# TODO: still need to implement dist -dist_EXCLUDES += guile io julia matlab swift - -# -# Utility functions -# - -haxe_STEP_TO_PROG_neko = haxe/$($(1)).n -haxe_STEP_TO_PROG_python = haxe/$($(1)).py -haxe_STEP_TO_PROG_cpp = haxe/cpp/$($(1)) -haxe_STEP_TO_PROG_js = haxe/$($(1)).js +# Needed some argument munging +COMMA = , +noop = +SPACE = $(noop) $(noop) +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) @@ -135,173 +118,133 @@ opt_OPTIONAL = $(if $(strip $(OPTIONAL)),$(if $(filter t true T True TRUE # test files will include step 2 tests through tests for the step # being tested. STEP_TEST_FILES = $(strip $(wildcard \ - $(foreach s,$(if $(strip $(REGRESS)),$(regress_$(2)),$(2)),\ - $(1)/tests/$($(s)).mal tests/$($(s)).mal))) - -# Map of step (e.g. "step8") to executable file for that step -ada_STEP_TO_PROG = ada/$($(1)) -awk_STEP_TO_PROG = awk/$($(1)).awk -bash_STEP_TO_PROG = bash/$($(1)).sh -c_STEP_TO_PROG = c/$($(1)) -d_STEP_TO_PROG = d/$($(1)) -clojure_STEP_TO_PROG = clojure/target/$($(1)).jar -coffee_STEP_TO_PROG = coffee/$($(1)).coffee -cpp_STEP_TO_PROG = cpp/$($(1)) -crystal_STEP_TO_PROG = crystal/$($(1)) -cs_STEP_TO_PROG = cs/$($(1)).exe -elisp_STEP_TO_PROG = elisp/$($(1)).el -elixir_STEP_TO_PROG = elixir/lib/mix/tasks/$($(1)).ex -erlang_STEP_TO_PROG = erlang/$($(1)) -es6_STEP_TO_PROG = es6/build/$($(1)).js -factor_STEP_TO_PROG = factor/$($(1))/$($(1)).factor -forth_STEP_TO_PROG = forth/$($(1)).fs -fsharp_STEP_TO_PROG = fsharp/$($(1)).exe -go_STEP_TO_PROG = go/$($(1)) -groovy_STEP_TO_PROG = groovy/$($(1)).groovy -java_STEP_TO_PROG = java/target/classes/mal/$($(1)).class -haskell_STEP_TO_PROG = haskell/$($(1)) -haxe_STEP_TO_PROG = $(haxe_STEP_TO_PROG_$(HAXE_MODE)) -io_STEP_TO_PROG = io/$($(1)).io -julia_STEP_TO_PROG = julia/$($(1)).jl -js_STEP_TO_PROG = js/$($(1)).js -kotlin_STEP_TO_PROG = kotlin/$($(1)).jar -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 -nim_STEP_TO_PROG = nim/$($(1)) -objc_STEP_TO_PROG = objc/$($(1)) -objpascal_STEP_TO_PROG = objpascal/$($(1)) -perl_STEP_TO_PROG = perl/$($(1)).pl -perl6_STEP_TO_PROG = perl6/$($(1)).pl -php_STEP_TO_PROG = php/$($(1)).php -plpgsql_STEP_TO_PROG = plpgsql/$($(1)).sql -plsql_STEP_TO_PROG = plsql/$($(1)).sql -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 -rpython_STEP_TO_PROG = rpython/$($(1)) -ruby_STEP_TO_PROG = ruby/$($(1)).rb -rust_STEP_TO_PROG = rust/target/release/$($(1)) -scala_STEP_TO_PROG = scala/target/scala-2.11/classes/$($(1)).class -swift_STEP_TO_PROG = swift/$($(1)) -swift3_STEP_TO_PROG = swift3/$($(1)) -tcl_STEP_TO_PROG = tcl/$($(1)).tcl -vb_STEP_TO_PROG = vb/$($(1)).exe -vhdl_STEP_TO_PROG = vhdl/$($(1)) -vimscript_STEP_TO_PROG = vimscript/$($(1)).vim -guile_STEP_TO_PROG = guile/$($(1)).scm - - -# Needed some argument munging -COMMA = , -noop = -SPACE = $(noop) $(noop) -export FACTOR_ROOTS := . + $(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 = kanaka/mal-test-$(call lc,$(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)),$(MAL_IMPL),$(1)) +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_prefix = $(if $(strip $(DOCKERIZE)),docker run -it --rm -u $(shell id -u) -v $(dir $(abspath $(lastword $(MAKEFILE_LIST)))):/mal -w /mal/$(1) $(if $(filter factor,$(1)),-e FACTOR_ROOTS=$(FACTOR_ROOTS),) $(call impl_to_image,$(1)) ,) - -# Takes impl and step arguments +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 $(if $(strip $(DOCKERIZE)),\ - docker run -e STEP=$($2) \ - -it --rm -u $(shell id -u) \ - -v $(dir $(abspath $(lastword $(MAKEFILE_LIST)))):/mal \ - -w /mal/$(call actual_impl,$(1)) \ - $(if $(filter haxe,$(1)),-e HAXE_MODE=$(HAXE_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) \ - $(if $(filter haxe,$(1)),HAXE_MODE=$(HAXE_MODE),) \ - $(if $(filter factor,$(1)),FACTOR_ROOTS=$(FACTOR_ROOTS),) \ - $(3))) +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 tcl vb,$(1)),RAW=1,)) \ - ../runtest.py $(opt_DEFERRABLE) $(opt_OPTIONAL) $(call $(1)_TEST_OPTS) $(TEST_OPTS) +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)) ../run_argv_test.sh - -vimscript_TEST_OPTS = --test-timeout 30 -ifeq ($(MAL_IMPL),vimscript) -mal_TEST_OPTS = --start-timeout 60 --test-timeout 180 -endif +get_argvtest_cmd = $(call get_run_prefix,$(1),$(2)) ../tests/run_argv_test.sh # Derived lists -STEPS = $(sort $(filter step%,$(.VARIABLES))) +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 $(test_EXCLUDES),\ +ALL_TESTS = $(filter-out $(foreach e,$(step5_EXCLUDES),test^$(e)^step5),\ $(strip $(sort \ $(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)) +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))))) + # # Build rules # +# Enable secondary expansion for all rules +.SECONDEXPANSION: + # 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 1,$(subst /, ,$(@))),\ + $(foreach impl,$(word 2,$(subst /, ,$(@))),\ $(if $(DOCKERIZE), \ - $(call get_build_prefix,$(impl))$(MAKE) $(patsubst $(impl)/%,%,$(@)), \ - $(MAKE) -C $(impl) $(subst $(impl)/,,$(@)))) + $(call get_build_command,$(impl)) $(patsubst impls/$(impl)/%,%,$(@)), \ + $(call get_build_command,$(impl)) $(subst impls/$(impl)/,,$(@)))) -# Allow IMPL, and IMPL^STEP -.SECONDEXPANSION: +# Allow IMPL, build^IMPL, IMPL^STEP, and build^IMPL^STEP $(DO_IMPLS): $$(foreach s,$$(STEPS),$$(call $$(@)_STEP_TO_PROG,$$(s))) -.SECONDEXPANSION: +$(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 "(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/step6_file.mal,$(test)),\ + $(if $(filter tests/$(argv_STEP)$(EXTENSION),$(test)),\ echo '----------------------------------------------' && \ echo 'Testing ARGV of $@; step file: $+' && \ echo 'Running: $(call get_argvtest_cmd,$(impl),$(step)) ../$(impl)/run ' && \ @@ -313,39 +256,32 @@ $(ALL_TESTS): $$(call $$(word 2,$$(subst ^, ,$$(@)))_STEP_TO_PROG,$$(word 3,$$(s test: $(ALL_TESTS) tests: $(ALL_TESTS) -.SECONDEXPANSION: $(IMPL_TESTS): $$(filter $$@^%,$$(ALL_TESTS)) -.SECONDEXPANSION: $(STEP_TESTS): $$(foreach step,$$(subst test^,,$$@),$$(filter %^$$(step),$$(ALL_TESTS))) # -# Dist rules +# Docker build rules # -dist: $(IMPL_DIST) +docker-build: $(DOCKER_BUILD) -.SECONDEXPANSION: -$(IMPL_DIST): +$(DOCKER_BUILD): @echo "----------------------------------------------"; \ $(foreach impl,$(word 2,$(subst ^, ,$(@))),\ - echo "Running: make -C $(impl) dist"; \ - $(MAKE) --no-print-directory -C $(impl) dist) - + echo "Running: docker build -t $(call impl_to_image,$(impl)) .:"; \ + cd impls/$(impl) && docker build -t $(call impl_to_image,$(impl)) .) # -# Docker build rules +# Docker shell rules # -docker-build: $(DOCKER_BUILD) - -.SECONDEXPANSION: -$(DOCKER_BUILD): - echo "----------------------------------------------"; \ +$(DOCKER_SHELL): + @echo "----------------------------------------------"; \ $(foreach impl,$(word 2,$(subst ^, ,$(@))),\ - echo "Running: docker build -t $(call impl_to_image,$(impl)) .:"; \ - cd $(impl) && docker build -t $(call impl_to_image,$(impl)) .) + echo "Running: $(call get_run_prefix,$(impl),stepA,,dockerize) bash"; \ + $(call get_run_prefix,$(impl),stepA,,dockerize) bash) # @@ -354,11 +290,10 @@ $(DOCKER_BUILD): 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 get_run_prefix,$(impl),stepA) ../$(impl)/run ../tests/perf1.mal'; \ $(call get_run_prefix,$(impl),stepA) ../$(impl)/run ../tests/perf1.mal; \ @@ -372,23 +307,33 @@ $(IMPL_PERF): # REPL invocation rules # -.SECONDEXPANSION: $(ALL_REPL): $$(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)); \ + cd impls/$(call actual_impl,$(impl)); \ echo 'REPL implementation $(impl), step file: $+'; \ - echo 'Running: $(call get_run_prefix,$(impl),$(step)) ../$(impl)/run'; \ - $(call get_run_prefix,$(impl),$(step)) ../$(impl)/run;)) + 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) -.SECONDEXPANSION: $(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 # -.SECONDEXPANSION: print-%: @echo "$($(*))" @@ -399,15 +344,11 @@ print-%: define recur_template .PHONY: $(1) $(1): $(2) -.SECONDEXPANSION: $(2): @echo "----------------------------------------------"; \ $$(foreach impl,$$(word 2,$$(subst ^, ,$$(@))),\ - $$(if $$(DOCKERIZE), \ - echo "Running: $$(call get_build_prefix,$$(impl))$$(MAKE) --no-print-directory $(1)"; \ - $$(call get_build_prefix,$$(impl))$$(MAKE) --no-print-directory $(1), \ - echo "Running: $$(MAKE) --no-print-directory -C $$(impl) $(1)"; \ - $$(MAKE) --no-print-directory -C $$(impl) $(1))) + 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))) @@ -415,9 +356,5 @@ recur_impls_ = $(filter-out $(foreach impl,$($(1)_EXCLUDES),$(1)^$(impl)),$(fore # recursive clean $(eval $(call recur_template,clean,$(call recur_impls_,clean))) -# recursive stats -$(eval $(call recur_template,stats,$(call recur_impls_,stats))) -$(eval $(call recur_template,stats-lisp,$(call recur_impls_,stats-lisp))) - # 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 42e084ae1a..3dca01ab2d 100644 --- a/README.md +++ b/README.md @@ -1,111 +1,173 @@ # mal - Make a Lisp -[![Build Status](https://travis-ci.org/kanaka/mal.svg?branch=master)](https://travis-ci.org/kanaka/mal) +[![Build and Test](https://github.com/kanaka/mal/actions/workflows/main.yml/badge.svg)](https://github.com/kanaka/mal/actions/workflows/main.yml) ## Description -Mal is a Clojure inspired Lisp interpreter. - -Mal is implemented in 55 languages: - -* Ada -* GNU awk -* Bash shell -* C -* C++ -* C# -* Clojure -* CoffeeScript -* Crystal -* D -* Elixir -* Emacs Lisp -* Erlang -* ES6 (ECMAScript 6 / ECMAScript 2015) -* F# -* Factor -* Forth -* Go -* Groovy -* GNU Guile -* Haskell -* Haxe -* Io -* Java -* JavaScript ([Online Demo](http://kanaka.github.io/mal)) -* Julia -* Kotlin -* Lua -* GNU Make -* mal itself -* MATLAB -* [miniMAL](https://github.com/kanaka/miniMAL) -* Nim -* Object Pascal -* Objective C -* OCaml -* Perl -* Perl 6 -* PHP -* PL/pgSQL (Postgres) -* PL/SQL (Oracle) -* Postscript -* Python -* RPython -* R -* Racket -* Ruby -* Rust -* Scala -* Swift -* Swift 3 -* Tcl -* VHDL -* Vimscript -* 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 +**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). - -The mal (make a lisp) steps are: +(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. -* [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) +**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 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". +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/). -If you are interesting in creating a mal implementation (or just -interested in using mal for something), please drop by the #mal -channel on freenode. 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. +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 convenience +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): @@ -115,10 +177,41 @@ make DOCKERIZE=1 "repl^IMPL^stepX" make DOCKERIZE=1 "repl^IMPL" ``` +## External / Alternate Implementations -### Ada +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. -*The Ada implementation was created by [Chris Moore](https://github.com/zmower)* + +## 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, @@ -126,29 +219,84 @@ GNAT and (optionally) make. There are no external dependencies (readline not implemented). ``` -cd ada +cd impls/ada make ./stepX_YYY ``` -### GNU awk +### Ada.2 + +The second Ada implementation was developed with GNAT 8 and links with +the GNU readline library. + +``` +cd impls/ada +make +./stepX_YYY +``` -*The GNU awk implementation was created by [Miutsuru kariya](https://github.com/kariya-mitsuru)* +### GNU awk The GNU awk implementation of mal has been tested with GNU awk 4.1.1. ``` -cd gawk +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 @@ -156,21 +304,31 @@ header packages): glib, libffi6, libgc, and either the libedit or GNU readline library. ``` -cd c +cd impls/c make ./stepX_YYY ``` -### C++ +### C.2 -*The C++ implementation was created by [Stephen Thirlwall (sdt)](https://github.com/sdt)* +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 cpp +cd impls/cpp make # OR make CXX=clang++-3.5 @@ -185,11 +343,19 @@ 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 @@ -197,7 +363,7 @@ 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 ``` @@ -205,18 +371,29 @@ lein with-profile +stepX trampoline run ``` sudo npm install -g coffee-script -cd coffee +cd impls/coffee coffee ./stepX_YYY ``` -### Crystal +### 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 +``` -*The Crystal implementation of mal was created by [Linda_pp](https://github.com/rhysd)* +### Crystal -The Crystal implementation of mal has been tested with Crystal 0.17.4. +The Crystal implementation of mal has been tested with Crystal 0.26.1. ``` -cd crystal +cd impls/crystal crystal run ./stepX_YYY.cr # OR make # needed to run tests @@ -225,20 +402,25 @@ make # needed to run tests ### D -*The D implementation was created by [Dov Murik](https://github.com/dubek)* - The D implementation of mal was tested with GDC 4.8. It requires the GNU readline library. ``` -cd d +cd impls/d make ./stepX_YYY ``` -### Emacs Lisp +### Dart -*The Emacs Lisp implementation was created by [Vasilij Schneidermann](https://github.com/wasamasa)* +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 (`` @@ -246,7 +428,7 @@ and `C-d` work, `C-c` cancels the process), it is recommended to use `rlwrap`. ``` -cd elisp +cd impls/elisp emacs -Q --batch --load stepX_YYY.el # with full readline support rlwrap emacs -Q --batch --load stepX_YYY.el @@ -254,40 +436,46 @@ rlwrap emacs -Q --batch --load stepX_YYY.el ### Elixir -*The Elixir implementation was created by [Martin Ek (ekmartin)](https://github.com/ekmartin)* - The Elixir implementation of mal has been tested with Elixir 1.0.5. ``` -cd elixir +cd impls/elixir mix stepX_YYY # Or with readline/line editing functionality: iex -S mix stepX_YYY ``` -### Erlang +### Elm + +The Elm implementation of mal has been tested with Elm 0.18.0 -*The Erlang implementation was created by [Nathan Fiedler (nlfiedler)](https://github.com/nlfiedler)* +``` +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 erlang +cd impls/erlang make # OR MAL_STEP=stepX_YYY rebar compile escriptize # build individual step ./stepX_YYY ``` -### ES6 (ECMAScript 6 / ECMAScript 2015) +### ES6 (ECMAScript 2015) -The ES6 implementation uses the [babel](https://babeljs.io) compiler -to generate ES5 compatible JavaScript. The generated code has been -tested with Node 0.12.4. +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 es6 +cd impls/es6 make node build/stepX_YYY.js ``` @@ -295,47 +483,77 @@ node build/stepX_YYY.js ### F# ### -*The F# implementation was created by [Peter Stephens (pstephens)](https://github.com/pstephens)* - 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 fsharp +cd impls/fsharp make mono ./stepX_YYY.exe ``` ### Factor -*The Factor implementation was created by [Jordan Lewis (jordanlewis)](https://github.com/jordanlewis)* - The Factor implementation of mal has been tested with Factor 0.97 ([factorcode.org](http://factorcode.org)). ``` -cd factor +cd impls/factor FACTOR_ROOTS=. factor -run=stepX_YYY ``` -### Forth +### 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 Forth implementation was created by [Chris Houser (chouser)](https://github.com/chouser)* +The Fennel implementation of mal has been tested with Fennel version +0.9.1 on Lua 5.4. ``` -cd forth +cd impls/fennel +fennel ./stepX_YYY.fnl +``` + +### 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 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 ``` @@ -347,41 +565,40 @@ The Groovy implementation of mal requires Groovy to run and has been tested with Groovy 1.8.6. ``` -cd groovy +cd impls/groovy make groovy ./stepX_YYY.groovy ``` -### GNU Guile 2.1+ +### Hare -*The Guile implementation was created by [Mu Lei (NalaGinrut)](https://github.com/NalaGinrut).* +The hare implementation was tested against Hare 0.25.2. ``` -cd guile -guile -L ./ stepX_YYY.scm +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 +### 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 haxe +cd impls/haxe # Neko make all-neko neko ./stepX_YYY.n @@ -396,34 +613,63 @@ make all-js node ./stepX_YYY.js ``` -### Io +### Hy + +The Hy implementation of mal has been tested with Hy 0.13.0. + +``` +cd impls/hy +./stepX_YYY.hy +``` -*The Io implementation was created by [Dov Murik](https://github.com/dubek)* +### Io The Io implementation of mal has been tested with Io version 20110905. ``` -cd io +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" ``` +### 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 ``` @@ -432,30 +678,70 @@ node stepX_YYY.js The Julia implementation of mal requires Julia 0.4. ``` -cd julia +cd impls/julia julia stepX_YYY.jl ``` -### Kotlin +### jq -*The Kotlin implementation was created by [Javier Fernandez-Ivern](https://github.com/ivern)* +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 kotlin +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 ``` @@ -466,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 ``` @@ -474,18 +760,27 @@ IMPL_STEPA_CMD ../mal/stepX_YYY.mal ### GNU Make 3.81 ``` -cd make +cd impls/make make -f stepX_YYY.mk ``` -### Nim 0.11.0 +### NASM + +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. -*The Nim implementation was created by [Dennis Felsing (def-)](https://github.com/def-)* +``` +cd impls/nasm +make +./stepX_YYY +``` + +### Nim 1.0.4 -Running the Nim implementation of mal requires Nim 0.11.0 or later. +The Nim implementation of mal has been tested with Nim 1.0.4. ``` -cd nim +cd impls/nim make # OR nimble build @@ -498,7 +793,7 @@ 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 objpascal +cd impls/objpascal make ./stepX_YYY ``` @@ -507,36 +802,35 @@ make 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. +X using Xcode 7. ``` -cd objc +cd impls/objc make ./stepX_YYY ``` ### OCaml 4.01.0 -*The OCaml implementation was created by [Chris Houser (chouser)](https://github.com/chouser)* - ``` -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;" ``` @@ -547,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 @@ -555,24 +849,24 @@ 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 created by [Hinrik Örn Sigurðsson](https://github.com/hinrik)* - The Perl 6 implementation was tested on Rakudo Perl 6 2016.04. ``` -cd perl6 +cd impls/perl6 perl6 stepX_YYY.pl ``` @@ -582,34 +876,43 @@ 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 Postscript implementation of mal requires ghostscript to run. It -has been tested with ghostscript 9.10. +The Picolisp implementation requires libreadline and Picolisp 3.1.11 +or later. ``` -cd ps -gs -q -dNODISPLAY -I./ stepX_YYY.ps +cd impls/picolisp +./run ``` -### PL/pgSQL (Postgres SQL Procedural Language) +### Pike -The PL/pgSQL implementation of mal requires a running Postgres server +The Pike implementation was tested on Pike 8.0. + +``` +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 Postgres server). The implementation connects to the Postgres server +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 Postgres 9.4. +tested with PostgreSQL 9.4. ``` -cd plpgsql +cd impls/plpgsql ./wrap.sh stepX_YYY.sql # OR PSQL_USER=myuser PGPASSWORD=mypass ./wrap.sh stepX_YYY.sql @@ -617,38 +920,83 @@ PSQL_USER=myuser PGPASSWORD=mypass ./wrap.sh stepX_YYY.sql ### PL/SQL (Oracle SQL Procedural Language) -The PL/pgSQL implementation of mal requires a running Oracle DB +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 +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 +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 plsql +cd impls/plsql ./wrap.sh stepX_YYY.sql # OR ORACLE_LOGON=myuser/mypass@ORCL ./wrap.sh stepX_YYY.sql ``` -### Python (2.X or 3.X) +### 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 +``` + +### 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 python -python stepX_YYY.py +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 rpython +cd impls/rpython make # this takes a very long time ./stepX_YYY ``` @@ -658,7 +1006,7 @@ make # this takes a very long time 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 ``` @@ -669,24 +1017,47 @@ The Racket implementation of mal requires the Racket compiler/interpreter to run. ``` -cd racket +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 ``` -### Rust (1.0.0 nightly) +### 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 (1.38+) The rust implementation of mal requires the rust compiler and build tool (cargo) to build. ``` -cd rust +cd impls/rust cargo run --release --bin stepX_YYY ``` @@ -695,72 +1066,156 @@ cargo run --release --bin stepX_YYY 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 ``` -### Swift +### Scheme (R7RS) ### -*The Swift implementation was created by [Keith Rollin](https://github.com/keith-rollin)* +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. -The Swift implementation of mal requires the Swift 2.0 compiler (XCode -7.0) to build. Older versions will not work due to changes in the -language and standard library. +``` +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 swift +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 the development version of the Swift 3 from -2016-02-08. +has been tested with Swift 3 Preview 3. ``` -cd swift3 +cd impls/swift3 make ./stepX_YYY ``` -### Tcl 8.6 +### 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 Tcl implementation was created by [Dov Murik](https://github.com/dubek)* +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 tcl +cd impls/tcl tclsh ./stepX_YYY.tcl ``` -### VHDL +### TypeScript -*The VHDL implementation was created by [Dov Murik](https://github.com/dubek)* +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 vhdl +cd impls/vhdl make ./run_vhdl.sh ./stepX_YYY ``` ### Vimscript -*The Vimscript implementation was created by [Dov Murik](https://github.com/dubek)* - -The Vimscript implementation of mal requires Vim to run. It has been tested -with Vim 7.4. +The Vimscript implementation of mal requires Vim 8.0 to run. ``` -cd vimscript +cd impls/vimscript ./run_vimscript.sh ./stepX_YYY.vim ``` @@ -771,27 +1226,115 @@ 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 over 600 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 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 simplify the process of running tests, a top level Makefile is -provided with convenient test targets. - * To run all the tests across all implementations (be prepared to wait): ``` @@ -839,7 +1382,7 @@ 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 MAL_IMPL=python3 "test^mal^step2" ``` ### Starting the REPL @@ -873,7 +1416,7 @@ 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=python "repl^mal" +make MAL_IMPL=python3 "repl^mal" ``` ### Performance tests @@ -907,15 +1450,6 @@ make "stats^IMPL" make "stats^js" ``` -* To report line and bytes statistics for general Lisp code (env, core - and stepA): -``` -make "stats-lisp^IMPL" - -# e.g. -make "stats-lisp^js" -``` - ## Dockerized testing Every implementation directory contains a Dockerfile to create @@ -940,12 +1474,12 @@ make "docker-build^IMPL" **Notes**: -* Docker images are named *"kanaka/mal-test-IMPL"* +* Docker images are named *"ghcr.io/kanaka/mal-test-IMPL"* * JVM-based language implementations (Groovy, Java, Clojure, Scala): - you will probably need to run these implementations once manually - first (make DOCKERIZE=1 "repl^IMPL")before you can run tests because + 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 download to dot-files in the /mal + out. These dependencies are downloaded to dot-files in the /mal directory so they will persist between runs. diff --git a/ada/Dockerfile b/ada/Dockerfile deleted file mode 100755 index 5eb272abe0..0000000000 --- a/ada/Dockerfile +++ /dev/null @@ -1,25 +0,0 @@ -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 -########################################################## - -# GNU Ada compiler -RUN apt-get -y install gnat-4.9 diff --git a/ada/Makefile b/ada/Makefile deleted file mode 100644 index 2610b49eff..0000000000 --- a/ada/Makefile +++ /dev/null @@ -1,34 +0,0 @@ -DIRS=obj -PROGS=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 - -STEP0_DEPS=${DIRS} -STEP1_DEPS=${STEP0_DEPS} types.ad[bs] types-vector.ad[bs] types-hash_map.ad[bs] \ - reader.ad[bs] printer.ad[bs] smart_pointers.ad[bs] -STEP2_DEPS=${STEP1_DEPS} -STEP3_DEPS=${STEP2_DEPS} envs.ad[bs] eval_callback.ads -STEP4_DEPS=${STEP3_DEPS} core.ad[bs] - -all: ${DIRS} ${PROGS} - -${DIRS}: - mkdir -p $@ - -step%: - gnatmake -O3 -gnata -o $@ -P$@ - -step0_repl: step0_repl.adb ${STEP0_DEPS} -step1_read_print: step1_read_print.adb ${STEP1_DEPS} -step2_eval: step2_eval.adb ${STEP2_DEPS} -step3_env: step3_env.adb eval_callback.ads ${STEP3_DEPS} -step4_if_fn_do: step4_if_fn_do.adb ${STEP4_DEPS} -step5_tco: step5_tco.adb ${STEP4_DEPS} -step6_file: step6_file.adb ${STEP4_DEPS} -step7_quote: step7_quote.adb ${STEP4_DEPS} -step8_macros: step8_macros.adb ${STEP4_DEPS} -step9_try: step9_try.adb ${STEP4_DEPS} -stepA_mal: stepa_mal.adb ${STEP4_DEPS} - -clean: - rm -f ${PROGS} - rm -rf obj diff --git a/ada/core.adb b/ada/core.adb deleted file mode 100644 index ff17eed428..0000000000 --- a/ada/core.adb +++ /dev/null @@ -1,1210 +0,0 @@ -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 Mal_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 Evaluation_Error 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 Mal_Exception with "Bind failed in Apply"; - - end if; - - end; - - else -- neither a Lambda or a Func - raise Mal_Exception; - 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); - - return New_Symbol_Mal_Type (':' & Deref_String (Sym_Handle).Get_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 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 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; - S : String (1..Reader.Max_Line_Len); - Last : Natural; - 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. - Ada.Text_IO.Get_Line (S, Last); - return New_String_Mal_Type (S (1 .. Last)); - 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; - Line_Str : String (1..Reader.Max_Line_Len); - File_Str : Ada.Strings.Unbounded.Unbounded_String := - Ada.Strings.Unbounded.Null_Unbounded_String; - Last : Natural; - I : Natural := 0; - begin - Ada.Text_IO.Open (Fn, In_File, Unquoted_Str); - while not End_Of_File (Fn) loop - Get_Line (Fn, Line_Str, Last); - if Last > 0 then - Ada.Strings.Unbounded.Append (File_Str, Line_Str (1 .. Last)); - Ada.Strings.Unbounded.Append (File_Str, Ada.Characters.Latin_1.LF); - end if; - 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 Mal_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 Mal_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 Mal_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, - "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, - "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/ada/reader.adb b/ada/reader.adb deleted file mode 100644 index f2c2640fac..0000000000 --- a/ada/reader.adb +++ /dev/null @@ -1,393 +0,0 @@ -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 - - -- Skip over " - J := J + 1; - while J <= Str_Len and then - (Element (Saved_Line, J) /= '"' or else - Element (Saved_Line, J-1) = '\') loop - J := J + 1; - end loop; - - -- So we either ran out of string.. - if J > Str_Len then - raise String_Error; - end if; - - -- or we reached an unescaped " - 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 & "'"); - 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 '""'"); - end Read_Str; - - -end Reader; diff --git a/ada/reader.ads b/ada/reader.ads deleted file mode 100644 index 4f5d6cc0f7..0000000000 --- a/ada/reader.ads +++ /dev/null @@ -1,16 +0,0 @@ -with Types; - -package Reader is - - Max_Line_Len : constant := 2048; - - -- 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/ada/run b/ada/run deleted file mode 100755 index 8ba68a5484..0000000000 --- a/ada/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec $(dirname $0)/${STEP:-stepA_mal} "${@}" diff --git a/ada/step0_repl.adb b/ada/step0_repl.adb deleted file mode 100644 index ea4ce9d8b5..0000000000 --- a/ada/step0_repl.adb +++ /dev/null @@ -1,43 +0,0 @@ -with Ada.Text_IO; -with Ada.IO_Exceptions; - -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; - - S : String (1..1024); - Last : Natural; - -begin - - loop - Ada.Text_IO.Put ("user> "); - Ada.Text_IO.Get_Line (S, Last); - Ada.Text_IO.Put_Line (Rep (S (1..Last))); - end loop; - -exception - when Ada.IO_Exceptions.End_Error => null; - -- i.e. exit without textual output -end Step0_Repl; diff --git a/ada/step0_repl.gpr b/ada/step0_repl.gpr deleted file mode 100644 index 0140abd4a9..0000000000 --- a/ada/step0_repl.gpr +++ /dev/null @@ -1,7 +0,0 @@ -project Step0_Repl is - - for Object_Dir use "obj"; - for Exec_Dir use "."; - for Main use ("step0_repl.adb"); - -end Step0_Repl; diff --git a/ada/step1_read_print.adb b/ada/step1_read_print.adb deleted file mode 100644 index 53cf37de8b..0000000000 --- a/ada/step1_read_print.adb +++ /dev/null @@ -1,53 +0,0 @@ -with Ada.Text_IO; -with Ada.IO_Exceptions; -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; - - S : String (1..Reader.Max_Line_Len); - Last : Natural; - -begin - - loop - Ada.Text_IO.Put ("user> "); - Ada.Text_IO.Get_Line (S, Last); - Ada.Text_IO.Put_Line (Rep (S (1..Last))); - end loop; - -exception - when Ada.IO_Exceptions.End_Error => null; - -- i.e. exit without textual output -end Step1_Read_Print; diff --git a/ada/step1_read_print.gpr b/ada/step1_read_print.gpr deleted file mode 100644 index c5bde41a40..0000000000 --- a/ada/step1_read_print.gpr +++ /dev/null @@ -1,7 +0,0 @@ -project Step1_Read_Print is - - for Object_Dir use "obj"; - for Exec_Dir use "."; - for Main use ("step1_read_print.adb"); - -end Step1_Read_Print; diff --git a/ada/step2_eval.adb b/ada/step2_eval.adb deleted file mode 100644 index dee425ad42..0000000000 --- a/ada/step2_eval.adb +++ /dev/null @@ -1,246 +0,0 @@ -with Ada.Containers.Hashed_Maps; -with Ada.Strings.Unbounded.Hash; -with Ada.Text_IO; -with Ada.IO_Exceptions; -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 - - 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 => - - return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all); - - when others => return Ast; - - end case; - - end Eval_Ast; - - - function Eval (Param : Mal_Handle; Env : String_Mal_Hash.Map) - return Mal_Handle is - First_Elem : Mal_Handle; - begin - - if Debug then - Ada.Text_IO.Put_Line ("Evaling " & Deref (Param).To_String); - end if; - - if Deref (Param).Sym_Type = List and then - Deref_List (Param).Get_List_Type = List_List then - - 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; - - else -- Not a List_List - - return Eval_Ast (Param, Env); - - end if; - - 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; - - - S : String (1..Reader.Max_Line_Len); - Last : Natural; - -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> "); - Ada.Text_IO.Get_Line (S, Last); - Ada.Text_IO.Put_Line (Rep (S (1..Last), Repl_Env)); - exception - when Ada.IO_Exceptions.End_Error => raise; - when E : others => - Ada.Text_IO.Put_Line - (Ada.Text_IO.Standard_Error, - Ada.Exceptions.Exception_Information (E)); - end; - end loop; - -exception - when Ada.IO_Exceptions.End_Error => null; - -- i.e. exit without textual output -end Step2_Eval; diff --git a/ada/step2_eval.gpr b/ada/step2_eval.gpr deleted file mode 100644 index bebfa3642e..0000000000 --- a/ada/step2_eval.gpr +++ /dev/null @@ -1,7 +0,0 @@ -project Step2_Eval is - - for Object_Dir use "obj"; - for Exec_Dir use "."; - for Main use ("step2_eval.adb"); - -end Step2_Eval; diff --git a/ada/step3_env.adb b/ada/step3_env.adb deleted file mode 100644 index 9535a51aee..0000000000 --- a/ada/step3_env.adb +++ /dev/null @@ -1,269 +0,0 @@ -with Ada.Command_Line; -with Ada.Text_IO; -with Ada.IO_Exceptions; -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; - - 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 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 - - 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 => - - return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all); - - when others => return Ast; - - end case; - - end Eval_Ast; - - - function Eval (Param : Mal_Handle; Env : Envs.Env_Handle) - return Mal_Handle is - First_Elem : Mal_Handle; - begin - - if Debug then - Ada.Text_IO.Put_Line ("Evaling " & Deref (Param).To_String); - end if; - - if Deref (Param).Sym_Type = List and then - Deref_List (Param).Get_List_Type = List_List then - - 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; - - else -- Not a List_List - - return Eval_Ast (Param, Env); - - end if; - - 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; - S : String (1..Reader.Max_Line_Len); - Last : 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; - - if Ada.Command_Line.Argument_Count > 0 then - if Ada.Command_Line.Argument (1) = "-d" then - Debug := True; - end if; - end if; - - Repl_Env := Envs.New_Env; - - Init (Repl_Env); - - loop - Ada.Text_IO.Put ("user> "); - Ada.Text_IO.Get_Line (S, Last); - Ada.Text_IO.Put_Line (Rep (S (1..Last), Repl_Env)); - end loop; - -exception - when Ada.IO_Exceptions.End_Error => null; - -- i.e. exit without textual output -end Step3_Env; diff --git a/ada/step3_env.gpr b/ada/step3_env.gpr deleted file mode 100644 index 6dd89cc95d..0000000000 --- a/ada/step3_env.gpr +++ /dev/null @@ -1,7 +0,0 @@ -project Step3_Env is - - for Object_Dir use "obj"; - for Exec_Dir use "."; - for Main use ("step3_env.adb"); - -end Step3_Env; diff --git a/ada/step4_if_fn_do.adb b/ada/step4_if_fn_do.adb deleted file mode 100644 index 27b7339b3c..0000000000 --- a/ada/step4_if_fn_do.adb +++ /dev/null @@ -1,326 +0,0 @@ -with Ada.Command_Line; -with Ada.Exceptions; -with Ada.Text_IO; -with Ada.IO_Exceptions; -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 - - 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 => - - return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all); - - when others => return Ast; - - end case; - - 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; - begin - - if Debug then - Ada.Text_IO.Put_Line ("Evaling " & Deref (Param).To_String); - end if; - - if Deref (Param).Sym_Type = List and then - Deref_List (Param).Get_List_Type = List_List then - - 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; - - else -- Not a List_List - - return Eval_Ast (Param, Env); - - end if; - - 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; - - - S : String (1..Reader.Max_Line_Len); - Last : Natural; - 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> "); - Ada.Text_IO.Get_Line (S, Last); - Ada.Text_IO.Put_Line (Rep (S (1..Last), Repl_Env)); - exception - when Ada.IO_Exceptions.End_Error => raise; - when E : others => - Ada.Text_IO.Put_Line - (Ada.Text_IO.Standard_Error, - Ada.Exceptions.Exception_Information (E)); - end; - end loop; - -exception - when Ada.IO_Exceptions.End_Error => null; - -- i.e. exit without textual output -end Step4_If_Fn_Do; diff --git a/ada/step4_if_fn_do.gpr b/ada/step4_if_fn_do.gpr deleted file mode 100644 index 54a7367d93..0000000000 --- a/ada/step4_if_fn_do.gpr +++ /dev/null @@ -1,7 +0,0 @@ -project Step4_If_Fn_Do is - - for Object_Dir use "obj"; - for Exec_Dir use "."; - for Main use ("step4_if_fn_do.adb"); - -end Step4_If_Fn_Do; diff --git a/ada/step5_tco.adb b/ada/step5_tco.adb deleted file mode 100644 index 67ffb35941..0000000000 --- a/ada/step5_tco.adb +++ /dev/null @@ -1,379 +0,0 @@ -with Ada.Command_Line; -with Ada.Exceptions; -with Ada.Text_IO; -with Ada.IO_Exceptions; -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 - - 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 => - - return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all); - - when others => return Ast; - - end case; - - 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; - begin - - Param := AParam; - Env := AnEnv; - - <> - - if Debug then - Ada.Text_IO.Put_Line ("Evaling " & Deref (Param).To_String); - end if; - - if Deref (Param).Sym_Type = List and then - Deref_List (Param).Get_List_Type = List_List then - - 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; - - else - - return Eval_Ast (Param, Env); - - end if; - - 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; - - - S : String (1..Reader.Max_Line_Len); - Last : Natural; - 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> "); - Ada.Text_IO.Get_Line (S, Last); - Ada.Text_IO.Put_Line (Rep (S (1..Last), Repl_Env)); - exception - when Ada.IO_Exceptions.End_Error => raise; - when E : others => - Ada.Text_IO.Put_Line - (Ada.Text_IO.Standard_Error, - Ada.Exceptions.Exception_Information (E)); - end; - end loop; - -exception - when Ada.IO_Exceptions.End_Error => null; - -- i.e. exit without textual output -end Step5_TCO; diff --git a/ada/step5_tco.gpr b/ada/step5_tco.gpr deleted file mode 100644 index 1602166769..0000000000 --- a/ada/step5_tco.gpr +++ /dev/null @@ -1,7 +0,0 @@ -project Step5_TCO is - - for Object_Dir use "obj"; - for Exec_Dir use "."; - for Main use ("step5_tco.adb"); - -end Step5_TCO; diff --git a/ada/step6_file.adb b/ada/step6_file.adb deleted file mode 100644 index 2e925b41b3..0000000000 --- a/ada/step6_file.adb +++ /dev/null @@ -1,414 +0,0 @@ -with Ada.Command_Line; -with Ada.Exceptions; -with Ada.Text_IO; -with Ada.IO_Exceptions; -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 - - 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 => - - return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all); - - when others => return Ast; - - end case; - - 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; - begin - - Param := AParam; - Env := AnEnv; - - <> - - if Debug then - Ada.Text_IO.Put_Line ("Evaling " & Deref (Param).To_String); - end if; - - if Deref (Param).Sym_Type = List and then - Deref_List (Param).Get_List_Type = List_List then - - 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; - - else - - return Eval_Ast (Param, Env); - - end if; - - 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; - - - S : String (1..Reader.Max_Line_Len); - Last : Natural; - 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 (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) "")"")))))"); - - -- 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> "); - Ada.Text_IO.Get_Line (S, Last); - Ada.Text_IO.Put_Line (Rep (S (1..Last), Repl_Env)); - exception - when Ada.IO_Exceptions.End_Error => raise; - when E : others => - Ada.Text_IO.Put_Line - (Ada.Text_IO.Standard_Error, - Ada.Exceptions.Exception_Information (E)); - end; - end loop; - end if; - -exception - when Ada.IO_Exceptions.End_Error => null; - -- i.e. exit without textual output -end Step6_File; diff --git a/ada/step6_file.gpr b/ada/step6_file.gpr deleted file mode 100644 index dfb2612853..0000000000 --- a/ada/step6_file.gpr +++ /dev/null @@ -1,7 +0,0 @@ -project Step6_File is - - for Object_Dir use "obj"; - for Exec_Dir use "."; - for Main use ("step6_file.adb"); - -end Step6_File; diff --git a/ada/step7_quote.adb b/ada/step7_quote.adb deleted file mode 100644 index 6eae882d26..0000000000 --- a/ada/step7_quote.adb +++ /dev/null @@ -1,504 +0,0 @@ -with Ada.Command_Line; -with Ada.Exceptions; -with Ada.Text_IO; -with Ada.IO_Exceptions; -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 - - 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 => - - return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all); - - when others => return Ast; - - end case; - - end Eval_Ast; - - - - - function Quasi_Quote_Processing (Param : Mal_Handle) return Mal_Handle is - Res, First_Elem, FE_0 : Mal_Handle; - L : List_Ptr; - D_Ptr, Ast_P : List_Class_Ptr; - begin - - if Debug then - Ada.Text_IO.Put_Line ("QuasiQt " & Deref (Param).To_String); - end if; - - -- Create a New List for the result... - Res := New_List_Mal_Type (List_List); - L := Deref_List (Res); - - -- This is the equivalent of Is_Pair - if Deref (Param).Sym_Type /= List or else - Is_Null (Deref_List_Class (Param).all) then - - -- return a new list containing: a symbol named "quote" and ast. - L.Append (New_Symbol_Mal_Type ("quote")); - L.Append (Param); - return Res; - - end if; - - -- Ast is a non-empty list at this point. - - Ast_P := Deref_List_Class (Param); - - First_Elem := Car (Ast_P.all); - - -- if the first element of ast is a symbol named "unquote": - if Deref (First_Elem).Sym_Type = Sym and then - Deref_Sym (First_Elem).Get_Sym = "unquote" then - - -- return the second element of ast.` - D_Ptr := Deref_List_Class (Cdr (Ast_P.all)); - return Car (D_Ptr.all); - - end if; - - -- if the first element of first element of `ast` (`ast[0][0]`) - -- is a symbol named "splice-unquote" - if Deref (First_Elem).Sym_Type = List and then - not Is_Null (Deref_List_Class (First_Elem).all) then - - D_Ptr := Deref_List_Class (First_Elem); - FE_0 := Car (D_Ptr.all); - - if Deref (FE_0).Sym_Type = Sym and then - Deref_Sym (FE_0).Get_Sym = "splice-unquote" then - - -- return a new list containing: a symbol named "concat", - L.Append (New_Symbol_Mal_Type ("concat")); - - -- the second element of first element of ast (ast[0][1]), - D_Ptr := Deref_List_Class (Cdr (D_Ptr.all)); - L.Append (Car (D_Ptr.all)); - - -- and the result of calling quasiquote with - -- the second through last element of ast. - L.Append (Quasi_Quote_Processing (Cdr (Ast_P.all))); - - return Res; - - end if; - - end if; - - -- otherwise: return a new list containing: a symbol named "cons", - L.Append (New_Symbol_Mal_Type ("cons")); - - -- the result of calling quasiquote on first element of ast (ast[0]), - L.Append (Quasi_Quote_Processing (Car (Ast_P.all))); - - -- and result of calling quasiquote with the second through last element of ast. - L.Append (Quasi_Quote_Processing (Cdr (Ast_P.all))); - - 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; - - <> - - if Debug then - Ada.Text_IO.Put_Line ("Evaling " & Deref (Param).To_String); - end if; - - if Deref (Param).Sym_Type = List and then - Deref_List (Param).Get_List_Type = List_List then - - 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 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; - - else - - return Eval_Ast (Param, Env); - - end if; - - 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; - - - S : String (1..Reader.Max_Line_Len); - Last : Natural; - 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) "")"")))))"); - - 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> "); - Ada.Text_IO.Get_Line (S, Last); - Ada.Text_IO.Put_Line (Rep (S (1..Last), Repl_Env)); - exception - when Ada.IO_Exceptions.End_Error => raise; - when E : others => - Ada.Text_IO.Put_Line - (Ada.Text_IO.Standard_Error, - Ada.Exceptions.Exception_Information (E)); - end; - end loop; - end if; - -exception - when Ada.IO_Exceptions.End_Error => null; - -- i.e. exit without textual output -end Step7_Quote; diff --git a/ada/step7_quote.gpr b/ada/step7_quote.gpr deleted file mode 100644 index e74a116c21..0000000000 --- a/ada/step7_quote.gpr +++ /dev/null @@ -1,7 +0,0 @@ -project Step7_Quote is - - for Object_Dir use "obj"; - for Exec_Dir use "."; - for Main use ("step7_quote.adb"); - -end Step7_Quote; diff --git a/ada/step8_macros.adb b/ada/step8_macros.adb deleted file mode 100644 index d6bd40b1b7..0000000000 --- a/ada/step8_macros.adb +++ /dev/null @@ -1,579 +0,0 @@ -with Ada.Command_Line; -with Ada.Exceptions; -with Ada.Text_IO; -with Ada.IO_Exceptions; -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); - Lambda_P.Set_Is_Macro (True); - Envs.Set (Env, Deref_Sym (Name).Get_Sym, Res); - return Res; - end Def_Macro; - - - function Macro_Expand (Ast : Mal_Handle; Env : Envs.Env_Handle) - return Mal_Handle is - Res : Mal_Handle; - E : Envs.Env_Handle; - LMT : List_Mal_Type; - LP : Lambda_Ptr; - begin - - Res := Ast; - E := Env; - - loop - - if Deref (Res).Sym_Type /= List then - exit; - end if; - - LMT := Deref_List (Res).all; - - -- Get the macro in the list from the env - -- or return null if not applicable. - LP := Get_Macro (Res, E); - - exit when LP = null or else not LP.Get_Is_Macro; - - declare - Fn_List : Mal_Handle := Cdr (LMT); - Params : List_Mal_Type; - begin - E := Envs.New_Env (E); - - Params := Deref_List (LP.Get_Params).all; - if Envs.Bind (E, Params, Deref_List (Fn_List).all) then - - Res := Eval (LP.Get_Expr, E); - - end if; - - end; - - end loop; - - return Res; - - end Macro_Expand; - - - 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 - - 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 => - - return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all); - - when others => return Ast; - - end case; - - end Eval_Ast; - - - function Quasi_Quote_Processing (Param : Mal_Handle) return Mal_Handle is - Res, First_Elem, FE_0 : Mal_Handle; - L : List_Ptr; - D_Ptr, Ast_P : List_Class_Ptr; - begin - - if Debug then - Ada.Text_IO.Put_Line ("QuasiQt " & Deref (Param).To_String); - end if; - - -- Create a New List for the result... - Res := New_List_Mal_Type (List_List); - L := Deref_List (Res); - - -- This is the equivalent of Is_Pair - if Deref (Param).Sym_Type /= List or else - Is_Null (Deref_List_Class (Param).all) then - - -- return a new list containing: a symbol named "quote" and ast. - L.Append (New_Symbol_Mal_Type ("quote")); - L.Append (Param); - return Res; - - end if; - - -- Ast is a non-empty list at this point. - - Ast_P := Deref_List_Class (Param); - - First_Elem := Car (Ast_P.all); - - -- if the first element of ast is a symbol named "unquote": - if Deref (First_Elem).Sym_Type = Sym and then - Deref_Sym (First_Elem).Get_Sym = "unquote" then - - -- return the second element of ast.` - D_Ptr := Deref_List_Class (Cdr (Ast_P.all)); - return Car (D_Ptr.all); - - end if; - - -- if the first element of first element of `ast` (`ast[0][0]`) - -- is a symbol named "splice-unquote" - if Deref (First_Elem).Sym_Type = List and then - not Is_Null (Deref_List_Class (First_Elem).all) then - - D_Ptr := Deref_List_Class (First_Elem); - FE_0 := Car (D_Ptr.all); - - if Deref (FE_0).Sym_Type = Sym and then - Deref_Sym (FE_0).Get_Sym = "splice-unquote" then - - -- return a new list containing: a symbol named "concat", - L.Append (New_Symbol_Mal_Type ("concat")); - - -- the second element of first element of ast (ast[0][1]), - D_Ptr := Deref_List_Class (Cdr (D_Ptr.all)); - L.Append (Car (D_Ptr.all)); - - -- and the result of calling quasiquote with - -- the second through last element of ast. - L.Append (Quasi_Quote_Processing (Cdr (Ast_P.all))); - - return Res; - - end if; - - end if; - - -- otherwise: return a new list containing: a symbol named "cons", - L.Append (New_Symbol_Mal_Type ("cons")); - - -- the result of calling quasiquote on first element of ast (ast[0]), - L.Append (Quasi_Quote_Processing (Car (Ast_P.all))); - - -- and result of calling quasiquote with the second through last element of ast. - L.Append (Quasi_Quote_Processing (Cdr (Ast_P.all))); - - 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; - - <> - - if Debug then - Ada.Text_IO.Put_Line ("Evaling " & Deref (Param).To_String); - end if; - - Param := Macro_Expand (Param, Env); - - if Debug then - Ada.Text_IO.Put_Line ("After expansion " & Deref (Param).To_String); - end if; - - if Deref (Param).Sym_Type = List and then - Deref_List (Param).Get_List_Type = List_List then - - 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 = "macroexpand" then - return Macro_Expand (Car (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 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; - - else - - return Eval_Ast (Param, Env); - - end if; - - 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; - - - S : String (1..Reader.Max_Line_Len); - Last : Natural; - 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) "")"")))))"); - 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))))))))"); - - 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> "); - Ada.Text_IO.Get_Line (S, Last); - Ada.Text_IO.Put_Line (Rep (S (1..Last), Repl_Env)); - exception - when Ada.IO_Exceptions.End_Error => raise; - when E : others => - Ada.Text_IO.Put_Line - (Ada.Text_IO.Standard_Error, - Ada.Exceptions.Exception_Information (E)); - end; - end loop; - end if; - -exception - when Ada.IO_Exceptions.End_Error => null; - -- i.e. exit without textual output -end Step8_Macros; diff --git a/ada/step8_macros.gpr b/ada/step8_macros.gpr deleted file mode 100644 index 3f2f0e2e35..0000000000 --- a/ada/step8_macros.gpr +++ /dev/null @@ -1,7 +0,0 @@ -project Step8_Macros is - - for Object_Dir use "obj"; - for Exec_Dir use "."; - for Main use ("step8_macros.adb"); - -end Step8_Macros; diff --git a/ada/step9_try.adb b/ada/step9_try.adb deleted file mode 100644 index 7c32f4f3b8..0000000000 --- a/ada/step9_try.adb +++ /dev/null @@ -1,629 +0,0 @@ -with Ada.Command_Line; -with Ada.Exceptions; -with Ada.Text_IO; -with Ada.IO_Exceptions; -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); - Lambda_P.Set_Is_Macro (True); - Envs.Set (Env, Deref_Sym (Name).Get_Sym, Res); - return Res; - end Def_Macro; - - - function Macro_Expand (Ast : Mal_Handle; Env : Envs.Env_Handle) - return Mal_Handle is - Res : Mal_Handle; - E : Envs.Env_Handle; - LMT : List_Mal_Type; - LP : Lambda_Ptr; - begin - - Res := Ast; - E := Env; - - loop - - if Deref (Res).Sym_Type /= List then - exit; - end if; - - LMT := Deref_List (Res).all; - - -- Get the macro in the list from the env - -- or return null if not applicable. - LP := Get_Macro (Res, E); - - exit when LP = null or else not LP.Get_Is_Macro; - - declare - Fn_List : Mal_Handle := Cdr (LMT); - Params : List_Mal_Type; - begin - E := Envs.New_Env (E); - - Params := Deref_List (LP.Get_Params).all; - if Envs.Bind (E, Params, Deref_List (Fn_List).all) then - - Res := Eval (LP.Get_Expr, E); - - end if; - - end; - - end loop; - - return Res; - - end Macro_Expand; - - - 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 - - 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 => - - return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all); - - when others => return Ast; - - end case; - - end Eval_Ast; - - - function Quasi_Quote_Processing (Param : Mal_Handle) return Mal_Handle is - Res, First_Elem, FE_0 : Mal_Handle; - L : List_Ptr; - D_Ptr, Ast_P : List_Class_Ptr; - begin - - if Debug then - Ada.Text_IO.Put_Line ("QuasiQt " & Deref (Param).To_String); - end if; - - -- Create a New List for the result... - Res := New_List_Mal_Type (List_List); - L := Deref_List (Res); - - -- This is the equivalent of Is_Pair - if Deref (Param).Sym_Type /= List or else - Is_Null (Deref_List_Class (Param).all) then - - -- return a new list containing: a symbol named "quote" and ast. - L.Append (New_Symbol_Mal_Type ("quote")); - L.Append (Param); - return Res; - - end if; - - -- Ast is a non-empty list at this point. - - Ast_P := Deref_List_Class (Param); - - First_Elem := Car (Ast_P.all); - - -- if the first element of ast is a symbol named "unquote": - if Deref (First_Elem).Sym_Type = Sym and then - Deref_Sym (First_Elem).Get_Sym = "unquote" then - - -- return the second element of ast.` - D_Ptr := Deref_List_Class (Cdr (Ast_P.all)); - return Car (D_Ptr.all); - - end if; - - -- if the first element of first element of `ast` (`ast[0][0]`) - -- is a symbol named "splice-unquote" - if Deref (First_Elem).Sym_Type = List and then - not Is_Null (Deref_List_Class (First_Elem).all) then - - D_Ptr := Deref_List_Class (First_Elem); - FE_0 := Car (D_Ptr.all); - - if Deref (FE_0).Sym_Type = Sym and then - Deref_Sym (FE_0).Get_Sym = "splice-unquote" then - - -- return a new list containing: a symbol named "concat", - L.Append (New_Symbol_Mal_Type ("concat")); - - -- the second element of first element of ast (ast[0][1]), - D_Ptr := Deref_List_Class (Cdr (D_Ptr.all)); - L.Append (Car (D_Ptr.all)); - - -- and the result of calling quasiquote with - -- the second through last element of ast. - L.Append (Quasi_Quote_Processing (Cdr (Ast_P.all))); - - return Res; - - end if; - - end if; - - -- otherwise: return a new list containing: a symbol named "cons", - L.Append (New_Symbol_Mal_Type ("cons")); - - -- the result of calling quasiquote on first element of ast (ast[0]), - L.Append (Quasi_Quote_Processing (Car (Ast_P.all))); - - -- and result of calling quasiquote with the second through last element of ast. - L.Append (Quasi_Quote_Processing (Cdr (Ast_P.all))); - - 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; - - <> - - if Debug then - Ada.Text_IO.Put_Line ("Evaling " & Deref (Param).To_String); - end if; - - Param := Macro_Expand (Param, Env); - - if Debug then - Ada.Text_IO.Put_Line ("After expansion " & Deref (Param).To_String); - end if; - - if Deref (Param).Sym_Type = List and then - Deref_List (Param).Get_List_Type = List_List then - - 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 = "macroexpand" then - return Macro_Expand (Car (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 - - 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. - 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; - - else -- not a List_List - - return Eval_Ast (Param, Env); - - end if; - - 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; - - - S : String (1..Reader.Max_Line_Len); - Last : Natural; - 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) "")"")))))"); - 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))))))))"); - - 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> "); - Ada.Text_IO.Get_Line (S, Last); - Ada.Text_IO.Put_Line (Rep (S (1..Last), Repl_Env)); - exception - when Ada.IO_Exceptions.End_Error => raise; - when E : others => - Ada.Text_IO.Put_Line - (Ada.Text_IO.Standard_Error, - Ada.Exceptions.Exception_Information (E)); - end; - end loop; - end if; - -exception - when Ada.IO_Exceptions.End_Error => null; - -- i.e. exit without textual output -end Step9_Try; diff --git a/ada/step9_try.gpr b/ada/step9_try.gpr deleted file mode 100644 index 2dac74aed4..0000000000 --- a/ada/step9_try.gpr +++ /dev/null @@ -1,7 +0,0 @@ -project Step9_Try is - - for Object_Dir use "obj"; - for Exec_Dir use "."; - for Main use ("step9_try.adb"); - -end Step9_Try; diff --git a/ada/stepA_mal.gpr b/ada/stepA_mal.gpr deleted file mode 100644 index c08b0bd49d..0000000000 --- a/ada/stepA_mal.gpr +++ /dev/null @@ -1,7 +0,0 @@ -project StepA_Mal is - - for Object_Dir use "obj"; - for Exec_Dir use "."; - for Main use ("stepa_mal.adb"); - -end StepA_Mal; diff --git a/ada/stepa_mal.adb b/ada/stepa_mal.adb deleted file mode 100644 index 53ac5ef838..0000000000 --- a/ada/stepa_mal.adb +++ /dev/null @@ -1,635 +0,0 @@ -with Ada.Command_Line; -with Ada.Exceptions; -with Ada.Text_IO; -with Ada.IO_Exceptions; -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); - Lambda_P.Set_Is_Macro (True); - Envs.Set (Env, Deref_Sym (Name).Get_Sym, Res); - return Res; - end Def_Macro; - - - function Macro_Expand (Ast : Mal_Handle; Env : Envs.Env_Handle) - return Mal_Handle is - Res : Mal_Handle; - E : Envs.Env_Handle; - LMT : List_Mal_Type; - LP : Lambda_Ptr; - begin - - Res := Ast; - E := Env; - - loop - - if Deref (Res).Sym_Type /= List then - exit; - end if; - - LMT := Deref_List (Res).all; - - -- Get the macro in the list from the env - -- or return null if not applicable. - LP := Get_Macro (Res, E); - - exit when LP = null or else not LP.Get_Is_Macro; - - declare - Fn_List : Mal_Handle := Cdr (LMT); - Params : List_Mal_Type; - begin - E := Envs.New_Env (E); - - Params := Deref_List (LP.Get_Params).all; - if Envs.Bind (E, Params, Deref_List (Fn_List).all) then - - Res := Eval (LP.Get_Expr, E); - - end if; - - end; - - end loop; - - return Res; - - end Macro_Expand; - - - 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 - - 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 => - - return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all); - - when others => return Ast; - - end case; - - end Eval_Ast; - - - function Quasi_Quote_Processing (Param : Mal_Handle) return Mal_Handle is - Res, First_Elem, FE_0 : Mal_Handle; - L : List_Ptr; - D_Ptr, Ast_P : List_Class_Ptr; - begin - - if Debug then - Ada.Text_IO.Put_Line ("QuasiQt " & Deref (Param).To_String); - end if; - - -- Create a New List for the result... - Res := New_List_Mal_Type (List_List); - L := Deref_List (Res); - - -- This is the equivalent of Is_Pair - if Deref (Param).Sym_Type /= List or else - Is_Null (Deref_List_Class (Param).all) then - - -- return a new list containing: a symbol named "quote" and ast. - L.Append (New_Symbol_Mal_Type ("quote")); - L.Append (Param); - return Res; - - end if; - - -- Ast is a non-empty list at this point. - - Ast_P := Deref_List_Class (Param); - - First_Elem := Car (Ast_P.all); - - -- if the first element of ast is a symbol named "unquote": - if Deref (First_Elem).Sym_Type = Sym and then - Deref_Sym (First_Elem).Get_Sym = "unquote" then - - -- return the second element of ast.` - D_Ptr := Deref_List_Class (Cdr (Ast_P.all)); - return Car (D_Ptr.all); - - end if; - - -- if the first element of first element of `ast` (`ast[0][0]`) - -- is a symbol named "splice-unquote" - if Deref (First_Elem).Sym_Type = List and then - not Is_Null (Deref_List_Class (First_Elem).all) then - - D_Ptr := Deref_List_Class (First_Elem); - FE_0 := Car (D_Ptr.all); - - if Deref (FE_0).Sym_Type = Sym and then - Deref_Sym (FE_0).Get_Sym = "splice-unquote" then - - -- return a new list containing: a symbol named "concat", - L.Append (New_Symbol_Mal_Type ("concat")); - - -- the second element of first element of ast (ast[0][1]), - D_Ptr := Deref_List_Class (Cdr (D_Ptr.all)); - L.Append (Car (D_Ptr.all)); - - -- and the result of calling quasiquote with - -- the second through last element of ast. - L.Append (Quasi_Quote_Processing (Cdr (Ast_P.all))); - - return Res; - - end if; - - end if; - - -- otherwise: return a new list containing: a symbol named "cons", - L.Append (New_Symbol_Mal_Type ("cons")); - - -- the result of calling quasiquote on first element of ast (ast[0]), - L.Append (Quasi_Quote_Processing (Car (Ast_P.all))); - - -- and result of calling quasiquote with the second through last element of ast. - L.Append (Quasi_Quote_Processing (Cdr (Ast_P.all))); - - 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; - - <> - - if Debug then - Ada.Text_IO.Put_Line ("Evaling " & Deref (Param).To_String); - end if; - - Param := Macro_Expand (Param, Env); - - if Debug then - Ada.Text_IO.Put_Line ("After expansion " & Deref (Param).To_String); - end if; - - if Deref (Param).Sym_Type = List and then - Deref_List (Param).Get_List_Type = List_List then - - 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 = "macroexpand" then - return Macro_Expand (Car (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 - - 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. - 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; - - else -- not a List_List - - return Eval_Ast (Param, Env); - - end if; - - 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; - - - S : String (1..Reader.Max_Line_Len); - Last : Natural; - 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) "")"")))))"); - 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 ("(def! *gensym-counter* (atom 0))"); - RE ("(def! gensym (fn* [] (symbol (str ""G__"" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))"); - RE ("(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)))))))))"); - - 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> "); - Ada.Text_IO.Get_Line (S, Last); - Ada.Text_IO.Put_Line (Rep (S (1..Last), Repl_Env)); - exception - when Ada.IO_Exceptions.End_Error => raise; - when E : others => - Ada.Text_IO.Put_Line - (Ada.Text_IO.Standard_Error, - Ada.Exceptions.Exception_Information (E)); - end; - end loop; - end if; - -exception - when Ada.IO_Exceptions.End_Error => null; - -- i.e. exit without textual output -end StepA_Mal; diff --git a/ada/types.adb b/ada/types.adb deleted file mode 100644 index 56eba7476f..0000000000 --- a/ada/types.adb +++ /dev/null @@ -1,1196 +0,0 @@ -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; - - function Is_Macro_Call (T : Mal_Type'Class; Env : Envs.Env_Handle) return Boolean is - L : List_Mal_Type; - First_Elem, Func : Mal_Handle; - begin - - if T.Sym_Type /= List then - return False; - end if; - - L := List_Mal_Type (T); - - if Is_Null (L) then - return False; - end if; - - First_Elem := Car (L); - - if Deref (First_Elem).Sym_Type /= Sym then - return False; - end if; - - Func := Envs.Get (Env, Deref_Sym (First_Elem).Get_Sym); - - if Deref (Func).Sym_Type /= Lambda then - return False; - end if; - - return Deref_Lambda (Func).Get_Is_Macro; - - exception - when Envs.Not_Found => return False; - end Is_Macro_Call; - - - -- 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 Mal_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 Mal_Exception with "Bind failed in Apply"; - - end if; - - return Res; - - end Apply; - - - function Get_Macro (T : Mal_Handle; Env : Envs.Env_Handle) return Lambda_Ptr is - L : List_Mal_Type; - First_Elem, Func : Mal_Handle; - begin - - if Deref (T).Sym_Type /= List then - return null; - end if; - - L := Deref_List (T).all; - - if Is_Null (L) then - return null; - end if; - - First_Elem := Car (L); - - if Deref (First_Elem).Sym_Type /= Sym then - return null; - end if; - - Func := Envs.Get (Env, Deref_Sym (First_Elem).Get_Sym); - - if Deref (Func).Sym_Type /= Lambda then - return null; - end if; - - return Deref_Lambda (Func); - - exception - when Envs.Not_Found => return null; - end Get_Macro; - - - 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/ada/types.ads b/ada/types.ads deleted file mode 100644 index d2a52fd7a8..0000000000 --- a/ada/types.ads +++ /dev/null @@ -1,440 +0,0 @@ --- 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; - - function Is_Macro_Call (T : Mal_Type'Class; Env : Envs.Env_Handle) return Boolean; - - 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 Get_Macro (T : Mal_Handle; Env : Envs.Env_Handle) return Lambda_Ptr; - - 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; - - 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/awk/Dockerfile b/awk/Dockerfile deleted file mode 100644 index 9d0e12cee1..0000000000 --- a/awk/Dockerfile +++ /dev/null @@ -1,25 +0,0 @@ -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 -########################################################## - -# GNU Awk -RUN apt-get -y install gawk diff --git a/awk/Makefile b/awk/Makefile deleted file mode 100644 index 1136bc0bf6..0000000000 --- a/awk/Makefile +++ /dev/null @@ -1,40 +0,0 @@ - -TESTS = - - -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 - - -.PHONY: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*#|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*#|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" - -tests: $(TESTS) - -$(TESTS): - @echo "Running $@"; \ - python $@ || exit 1; \ diff --git a/awk/run b/awk/run deleted file mode 100755 index 72be264a5c..0000000000 --- a/awk/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec awk -O -f $(dirname $0)/${STEP:-stepA_mal}.awk "${@}" diff --git a/awk/step8_macros.awk b/awk/step8_macros.awk deleted file mode 100644 index 50a7fde329..0000000000 --- a/awk/step8_macros.awk +++ /dev/null @@ -1,545 +0,0 @@ -@include "types.awk" -@include "reader.awk" -@include "printer.awk" -@include "env.awk" -@include "core.awk" - -function READ(str) -{ - return reader_read_str(str) -} - -function is_pair(ast) -{ - return ast ~ /^[([]/ && types_heap[substr(ast, 2)]["len"] != 0 -} - -function quasiquote(ast, i, len, new_idx, idx, lst_idx, first, first_idx, verb, ret) -{ - if (!is_pair(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 - } - idx = substr(ast, 2) - first = types_heap[idx][0] - if (first == "'unquote") { - if (types_heap[idx]["len"] != 2) { - len = types_heap[idx]["len"] - types_release(ast) - return "!\"Invalid argument length for 'unquote'. Expects exactly 1 argument, supplied " (len - 1) "." - } - types_addref(ret = types_heap[idx][1]) - types_release(ast) - return ret - } - - first_idx = substr(first, 2) - if (is_pair(first) && types_heap[first_idx][0] == "'splice-unquote") { - if (types_heap[first_idx]["len"] != 2) { - len = types_heap[first_idx]["len"] - types_release(ast) - return "!\"Invalid argument length for 'splice-unquote'. Expects exactly 1 argument, supplied " (len - 1) "." - } - types_addref(first = types_heap[first_idx][1]) - verb = "'concat" - } else { - types_addref(first) - first = quasiquote(first) - if (first ~ /^!/) { - types_release(ast) - return first - } - verb = "'cons" - } - lst_idx = types_allocate() - len = types_heap[idx]["len"] - for (i = 1; i < len; ++i) { - types_addref(types_heap[lst_idx][i - 1] = types_heap[idx][i]) - } - types_heap[lst_idx]["len"] = len - 1 - types_release(ast) - ret = quasiquote("(" lst_idx) - if (ret ~ /^!/) { - types_release(first) - return ret - } - - new_idx = types_allocate() - types_heap[new_idx][0] = verb - types_heap[new_idx][1] = first - types_heap[new_idx][2] = ret - types_heap[new_idx]["len"] = 3 - return "(" new_idx -} - -function is_macro_call(ast, env, sym, ret, f) -{ - if (!is_pair(ast)) { - return 0 - } - sym = types_heap[substr(ast, 2)][0] - if (sym !~ /^'/) { - return 0 - } - f = env_get(env, sym) - return f ~ /^\$/ && types_heap[substr(f, 2)]["is_macro"] -} - -function macroexpand(ast, env, idx, f_idx, new_env) -{ - while (is_macro_call(ast, env)) { - idx = substr(ast, 2) - f_idx = substr(env_get(env, types_heap[idx][0]), 2) - new_env = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], idx) - types_release(ast) - if (new_env ~ /^!/) { - return new_env - } - types_addref(ast = types_heap[f_idx]["body"]) - ast = EVAL(ast, new_env) - env_release(new_env) - if (ast ~ /^!/) { - return ast - } - } - return ast -} - -function eval_ast(ast, env, i, idx, len, new_idx, ret) -{ - switch (ast) { - case /^'/: - ret = env_get(env, ast) - if (ret !~ /^!/) { - types_addref(ret) - } - return ret - case /^[([]/: - idx = substr(ast, 2) - len = types_heap[idx]["len"] - new_idx = types_allocate() - for (i = 0; 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 - case /^\{/: - 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 - default: - return ast - } -} - -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) -{ - 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) "." - } - types_heap[substr(ret, 2)]["is_macro"] = 1 - 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_env) -{ - env_addref(env) - for (;;) { - if (ast !~ /^\(/) { - ret = eval_ast(ast, env) - types_release(ast) - env_release(env) - return ret - } - if (types_heap[substr(ast, 2)]["len"] == 0) { - env_release(env) - return ast - } - ast = macroexpand(ast, env) - if (ast ~ /^!/) { - env_release(env) - return ast - } - if (ast !~ /^\(/) { - ret = eval_ast(ast, env) - types_release(ast) - env_release(env) - return ret - } - idx = substr(ast, 2) - len = types_heap[idx]["len"] - 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 "'macroexpand": - if (len != 2) { - types_release(ast) - env_release(env) - return "!\"Invalid argument length for 'macroexpand'. Expects exactly 1 argument, supplied " (len - 1) "." - } - types_addref(body = types_heap[idx][1]) - types_release(ast) - ret = macroexpand(body, env) - env_release(env) - return ret - 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: - new_ast = eval_ast(ast, env) - types_release(ast) - env_release(env) - if (new_ast ~ /^!/) { - return new_ast - } - idx = substr(new_ast, 2) - f = types_heap[idx][0] - 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) - continue - 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 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) \")\")))))") - 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))))))))") - - 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/bash/Dockerfile b/bash/Dockerfile deleted file mode 100644 index 71720eb5e5..0000000000 --- a/bash/Dockerfile +++ /dev/null @@ -1,24 +0,0 @@ -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 -########################################################## - -# Nothing additional needed for bash diff --git a/bash/Makefile b/bash/Makefile deleted file mode 100644 index 488a4ffe4e..0000000000 --- a/bash/Makefile +++ /dev/null @@ -1,28 +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: - 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 - -.PHONY: stats - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*#|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*#|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" diff --git a/bash/run b/bash/run deleted file mode 100755 index 536c542f13..0000000000 --- a/bash/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec bash $(dirname $0)/${STEP:-stepA_mal}.sh "${@}" diff --git a/bash/step7_quote.sh b/bash/step7_quote.sh deleted file mode 100755 index dc7401c028..0000000000 --- a/bash/step7_quote.sh +++ /dev/null @@ -1,220 +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="" 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}" ;; - *) - 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 - _empty? "${ast}" && r="${ast}" && return - - # 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 3675684c25..0000000000 --- a/bash/step8_macros.sh +++ /dev/null @@ -1,265 +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="" 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}" ;; - *) - 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 - EVAL_AST "${ast}" "${env}" - return - fi - _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*) 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 01efd85801..0000000000 --- a/bash/step9_try.sh +++ /dev/null @@ -1,278 +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="" 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}" ;; - *) - 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 - EVAL_AST "${ast}" "${env}" - return - fi - _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*) 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 fecaef61c2..0000000000 --- a/bash/stepA_mal.sh +++ /dev/null @@ -1,290 +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="" 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}" ;; - *) - 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 - EVAL_AST "${ast}" "${env}" - return - fi - _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*) 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 "(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)))))))))" - -# 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 7aa44449b3..0000000000 --- a/c/Makefile +++ /dev/null @@ -1,83 +0,0 @@ -USE_READLINE ?= -USE_GC ?= 1 -CFLAGS += -g -O2 -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 ($(shell uname -s),Darwin) -CFLAGS +=-DOSX=1 -endif - -ifeq (,$(USE_READLINE)) -RL_LIBRARY ?= edit -else -RL_LIBRARY ?= readline -CFLAGS += -DUSE_READLINE=1 -endif - -ifeq (,$(USE_GC)) -else -CFLAGS += -DUSE_GC=1 -LDFLAGS += -lgc -endif - -CFLAGS += $(GLIB_CFLAGS) -LDFLAGS += -l$(RL_LIBRARY) $(GLIB_LDFLAGS) -ldl -lffi - -##################### - -all: $(BINS) - -dist: 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 $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" - -tests: $(TESTS) - -$(TESTS): - @echo "Running $@"; \ - ./$@ || exit 1; \ diff --git a/c/core.c b/c/core.c deleted file mode 100644 index 55e048ee8b..0000000000 --- a/c/core.c +++ /dev/null @@ -1,559 +0,0 @@ -#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; } -} - - -// 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; } -MalVal *string_Q(MalVal *seq) { - if ((seq->type & MAL_STRING) && (seq->val.string[0] != '\x7f')) { - return &mal_true; - } else { - return &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 *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[58] = { - {"=", (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}, - - {"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}, - {"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/c/core.h b/c/core.h deleted file mode 100644 index 9d612a66f0..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[58]; - -#endif diff --git a/c/env.c b/c/env.c deleted file mode 100644 index c3128f97af..0000000000 --- a/c/env.c +++ /dev/null @@ -1,57 +0,0 @@ -#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), _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/reader.c b/c/reader.c deleted file mode 100644 index c50e5e97a4..0000000000 --- a/c/reader.c +++ /dev/null @@ -1,269 +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*)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; - } -} - - -char *replace_str(const char *str, const char *old, const char *new) -{ - GRegex *reg = g_regex_new (old, 0, 0, NULL); - char *str_tmp = g_regex_replace_literal(reg, str, -1, 0, new, 0, NULL); - MAL_GC_FREE(reg); - return str_tmp; -} - -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), "\\\\\"", "\""); - char *str_tmp2 = replace_str(str_tmp, "\\\\n", "\n"); - MAL_GC_FREE(str_tmp); - char *str_tmp3 = replace_str(str_tmp2, "\\\\\\\\", "\\"); - MAL_GC_FREE(str_tmp2); - atom = malval_new_string(str_tmp3); - } else if (g_match_info_fetch_pos(matchInfo, 7, &pos, NULL) && pos != -1) { - //g_print("read_atom keyword\n"); - atom = malval_new_keyword(MAL_GC_STRDUP(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(MAL_GC_STRDUP(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/run b/c/run deleted file mode 100755 index 8ba68a5484..0000000000 --- a/c/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec $(dirname $0)/${STEP:-stepA_mal} "${@}" diff --git a/c/step0_repl.c b/c/step0_repl.c deleted file mode 100644 index af69bd6ea9..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); - puts(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 215624e422..0000000000 --- a/c/step1_read_print.c +++ /dev/null @@ -1,85 +0,0 @@ -#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) { - 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]; - - 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 (output) { - puts(output); - MAL_GC_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 3417e32747..0000000000 --- a/c/step2_eval.c +++ /dev/null @@ -1,154 +0,0 @@ -#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_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; - -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 (output) { - puts(output); - MAL_GC_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 8c5abfa6d7..0000000000 --- a/c/step3_env.c +++ /dev/null @@ -1,180 +0,0 @@ -#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_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; - -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_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]; - - 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 (output) { - puts(output); - MAL_GC_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 efe45e2c82..0000000000 --- a/c/step4_if_fn_do.c +++ /dev/null @@ -1,219 +0,0 @@ -#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_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]; - - 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 (output) { - puts(output); - MAL_GC_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 094e87e976..0000000000 --- a/c/step5_tco.c +++ /dev/null @@ -1,232 +0,0 @@ -#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_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]; - - 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 (output) { - puts(output); - MAL_GC_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 588e2c932c..0000000000 --- a/c/step6_file.c +++ /dev/null @@ -1,252 +0,0 @@ -#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_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; - -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, - malval_new_symbol(core_ns[i].name), - malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); - } - 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]; - - 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 (output) { - puts(output); - MAL_GC_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 ac8d825621..0000000000 --- a/c/step7_quote.c +++ /dev/null @@ -1,289 +0,0 @@ -#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 -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; - -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, - malval_new_symbol(core_ns[i].name), - malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); - } - 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]; - - 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 (output) { - puts(output); - MAL_GC_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 01aac07447..0000000000 --- a/c/step8_macros.c +++ /dev/null @@ -1,333 +0,0 @@ -#include -#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) { MAL_GC_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 || _count(ast) == 0) { 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 eval_ast(ast, env); - } - 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; - -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, - malval_new_symbol(core_ns[i].name), - malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); - } - 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]; - - 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 (output) { - puts(output); - MAL_GC_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 4f40fa50a3..0000000000 --- a/c/step9_try.c +++ /dev/null @@ -1,355 +0,0 @@ -#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 *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) { MAL_GC_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 || _count(ast) == 0) { 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 eval_ast(ast, env); - } - 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; - -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, - malval_new_symbol(core_ns[i].name), - malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); - } - 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]; - - 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 (output) { - puts(output); - MAL_GC_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 c9237f3895..0000000000 --- a/c/stepA_mal.c +++ /dev/null @@ -1,363 +0,0 @@ -#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 *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) { MAL_GC_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 || _count(ast) == 0) { 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 eval_ast(ast, env); - } - 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; -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, - malval_new_symbol(core_ns[i].name), - malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); - } - 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, "", "(def! *gensym-counter* (atom 0))"); - RE(repl_env, "", "(def! gensym (fn* [] (symbol (str \"G__\" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))"); - RE(repl_env, "", "(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)))))))))"); -} - -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 (output) { - puts(output); - MAL_GC_FREE(output); // Free output string - } - - //malval_free(exp); // Free evaluated expression - } -} diff --git a/c/types.h b/c/types.h deleted file mode 100644 index 83ce3943ea..0000000000 --- a/c/types.h +++ /dev/null @@ -1,195 +0,0 @@ -#ifndef __MAL_TYPES__ -#define __MAL_TYPES__ - -#include - -#ifdef USE_GC - -#include -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); -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); -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/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/Dockerfile b/clojure/Dockerfile deleted file mode 100644 index 1701219c7b..0000000000 --- a/clojure/Dockerfile +++ /dev/null @@ -1,34 +0,0 @@ -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 -########################################################## - -# Java and maven -RUN apt-get -y install openjdk-7-jdk -#maven2 -#ENV MAVEN_OPTS -Duser.home=/mal - -ADD https://raw.githubusercontent.com/technomancy/leiningen/stable/bin/lein \ - /usr/local/bin/lein -RUN chmod 0755 /usr/local/bin/lein -ENV LEIN_HOME /mal/.lein -ENV LEIN_JVM_OPTS -Duser.home=/mal - diff --git a/clojure/Makefile b/clojure/Makefile deleted file mode 100644 index 17fcc593e6..0000000000 --- a/clojure/Makefile +++ /dev/null @@ -1,35 +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 -SRCS = $(SOURCES_BASE) src/env.clj src/core.clj -SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) - -all: deps - -dist: mal.jar mal - -deps: - lein deps - -mal.jar: $(SOURCES) - lein with-profile stepA uberjar - cp target/mal-0.0.1-SNAPSHOT-standalone.jar $@ - -SHELL := bash -mal: mal.jar - cat <(echo -e '#!/bin/sh\nexec java -jar "$$0" "$$@"') mal.jar > $@ - chmod +x mal - -target/%.jar: src/%.clj $(SRCS) - lein with-profile $(word 1,$(subst _, ,$*)) uberjar - -clean: - rm -rf target/ mal.jar mal - -.PHONY: stats - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*;|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*;|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" diff --git a/clojure/project.clj b/clojure/project.clj deleted file mode 100644 index acfe822661..0000000000 --- a/clojure/project.clj +++ /dev/null @@ -1,45 +0,0 @@ -(defproject mal "0.0.1-SNAPSHOT" - :description "Make-A-Lisp" - - :dependencies [[org.clojure/clojure "1.8.0-RC4"] - [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 generate a executable uberjar (in target/) for a step: - ;; lein with-profile stepX repl - :profiles {:step0 {:main step0-repl - :uberjar-name "step0_repl.jar" - :aot [step0-repl]} - :step1 {:main step1-read-print - :uberjar-name "step1_read_print.jar" - :aot [step1-read-print]} - :step2 {:main step2-eval - :uberjar-name "step2_eval.jar" - :aot [step2-eval]} - :step3 {:main step3-env - :uberjar-name "step3_env.jar" - :aot [step3-env]} - :step4 {:main step4-if-fn-do - :uberjar-name "step4_if_fn_do.jar" - :aot [step4-if-fn-do]} - :step5 {:main step5-tco - :uberjar-name "step5_tco.jar" - :aot [step5-tco]} - :step6 {:main step6-file - :uberjar-name "step6_file.jar" - :aot [step6-file]} - :step7 {:main step7-quote - :uberjar-name "step7_quote.jar" - :aot [step7-quote]} - :step8 {:main step8-macros - :uberjar-name "step8_macros.jar" - :aot [step8-macros]} - :step9 {:main step9-try - :uberjar-name "step9_try.jar" - :aot [step9-try]} - :stepA {:main stepA-mal - :uberjar-name "stepA_mal.jar" - :aot [stepA-mal]}}) - diff --git a/clojure/run b/clojure/run deleted file mode 100755 index 94325d438c..0000000000 --- a/clojure/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec java -jar $(dirname $0)/target/${STEP:-stepA_mal}.jar "${@}" diff --git a/clojure/src/core.clj b/clojure/src/core.clj deleted file mode 100644 index 763ae8644b..0000000000 --- a/clojure/src/core.clj +++ /dev/null @@ -1,81 +0,0 @@ -(ns core - (:require [readline] - [printer])) - -;; 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?] - ['string? string?] - ['symbol symbol] - ['symbol? symbol?] - ['keyword keyword] - ['keyword? keyword?] - - ['pr-str pr-str] - ['str printer/_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] - ['apply apply] - ['map #(doall (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? (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 b430be3498..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) (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 (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 d030164408..0000000000 --- a/clojure/src/printer.clj +++ /dev/null @@ -1,36 +0,0 @@ -(ns printer) - -(import '(java.io Writer)) - -;; Override atom printer -(defmethod clojure.core/print-method clojure.lang.Atom [a writer] - (.write writer "(atom ") - (.write writer (pr-str @a)) - (.write writer ")")) - - -;; Override hash-map printer to remove comma separators -(defmethod print-method clojure.lang.IPersistentMap [hm, ^Writer w] - (.write w "{") - (when-let [xs (seq hm)] - (loop [[[k v] & xs] xs] - (print-method k w) (.append w \space) (print-method v w) - (when xs (.write w " ") (recur xs)))) - (.write w "}")) - - -;; Add a version of str that is the same all the way down (no -;; print-readably and nil printing all the way down) -(defn- pr- - ([] nil) - ([x] - (print-method x *out*)) - ([x & more] - (pr- x) - (if-let [nmore (next more)] - (recur (first more) nmore) - (apply pr- more)))) - -(defn _str [& xs] - (binding [*print-readably* nil] - (with-out-str (apply pr- xs)))) 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 284db3903e..0000000000 --- a/clojure/src/step0_repl.clj +++ /dev/null @@ -1,28 +0,0 @@ -(ns step0-repl - (:require [readline]) - (: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 - (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 9fe1ae978c..0000000000 --- a/clojure/src/step1_read_print.clj +++ /dev/null @@ -1,37 +0,0 @@ -(ns step1-read-print - (:require [clojure.repl] - [readline] - [reader] - [printer]) - (:gen-class)) - -;; 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 e1c02e948a..0000000000 --- a/clojure/src/step2_eval.clj +++ /dev/null @@ -1,68 +0,0 @@ -(ns step2-eval - (:require [clojure.repl] - [readline] - [reader] - [printer]) - (:gen-class)) - -;; 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] - ;; indented to match later steps - ;;(prn "EVAL" ast (keys @env)) (flush) - (if (not (seq? ast)) - (eval-ast ast env) - - ;; apply list - ;; indented to match later steps - (if (empty? ast) - ast - (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 64f9b09dee..0000000000 --- a/clojure/src/step3_env.clj +++ /dev/null @@ -1,83 +0,0 @@ -(ns step3-env - (:require [clojure.repl] - [readline] - [reader] - [printer] - [env]) - (:gen-class)) - -;; 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] - ;; indented to match later steps - ;;(prn "EVAL" ast (keys @env)) (flush) - (if (not (seq? ast)) - (eval-ast ast env) - - ;; 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 (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 71a5718fbc..0000000000 --- a/clojure/src/step4_if_fn_do.clj +++ /dev/null @@ -1,100 +0,0 @@ -(ns step4-if-fn-do - (:require [clojure.repl] - [readline] - [reader] - [printer] - [env] - [core]) - (:gen-class)) - -;; 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] - ;; indented to match later steps - ;;(prn "EVAL" ast (keys @env)) (flush) - (if (not (seq? ast)) - (eval-ast ast env) - - ;; 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 (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 (or 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 3de1fbd12e..0000000000 --- a/clojure/src/step5_tco.clj +++ /dev/null @@ -1,109 +0,0 @@ -(ns step5-tco - (:require [clojure.repl] - [readline] - [reader] - [printer] - [env] - [core]) - (:gen-class)) - -;; 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 - ;; 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 (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 (or 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 7add5ce8b3..0000000000 --- a/clojure/src/step6_file.clj +++ /dev/null @@ -1,115 +0,0 @@ -(ns step6-file - (:require [clojure.repl] - [readline] - [reader] - [printer] - [env] - [core]) - (:gen-class)) - -;; 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 - ;; 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 (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 (or 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 79b4588dfe..0000000000 --- a/clojure/src/step7_quote.clj +++ /dev/null @@ -1,138 +0,0 @@ -(ns step7-quote - (:require [clojure.repl] - [readline] - [reader] - [printer] - [env] - [core]) - (:gen-class)) - -;; 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 - ;; 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 (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 (or 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 86b6dac43f..0000000000 --- a/clojure/src/step8_macros.clj +++ /dev/null @@ -1,165 +0,0 @@ -(ns step8-macros - (:refer-clojure :exclude [macroexpand]) - (:require [clojure.repl] - [readline] - [reader] - [printer] - [env] - [core]) - (:gen-class)) - -;; 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)) - (eval-ast ast env) - - (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 (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 (or 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 cf3c227ac5..0000000000 --- a/clojure/src/step9_try.clj +++ /dev/null @@ -1,179 +0,0 @@ -(ns step9-try - (:refer-clojure :exclude [macroexpand]) - (:require [clojure.repl] - [readline] - [reader] - [printer] - [env] - [core]) - (:gen-class)) - -;; 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)) - (eval-ast ast env) - - (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 (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 (or 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/stepA_mal.clj b/clojure/src/stepA_mal.clj deleted file mode 100644 index 8212ee8401..0000000000 --- a/clojure/src/stepA_mal.clj +++ /dev/null @@ -1,187 +0,0 @@ -(ns stepA-mal - (:refer-clojure :exclude [macroexpand]) - (:require [clojure.repl] - [readline] - [reader] - [printer] - [env] - [core]) - (:gen-class)) - -;; 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)) - (eval-ast ast env) - - (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 (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 (or 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 "(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)))))))))") - -;; 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/Dockerfile b/coffee/Dockerfile deleted file mode 100644 index 895a5634bc..0000000000 --- a/coffee/Dockerfile +++ /dev/null @@ -1,41 +0,0 @@ -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 node modules -RUN apt-get -y install g++ - -# Add nodesource apt repo config for 0.12 stable -RUN curl -sL https://deb.nodesource.com/setup_0.12 | bash - - -# Install nodejs -RUN apt-get -y install nodejs - -# Link common name -RUN ln -sf nodejs /usr/bin/node - -ENV NPM_CONFIG_CACHE /mal/.npm - -# CoffeeScript specific -RUN npm install -g coffee-script -RUN touch /.coffee_history && chmod go+w /.coffee_history - diff --git a/coffee/Makefile b/coffee/Makefile deleted file mode 100644 index 0c2b36737a..0000000000 --- a/coffee/Makefile +++ /dev/null @@ -1,34 +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: node_modules dist - -node_modules: - npm install - -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 - - -.PHONY: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `egrep "^\w*#|^\w*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `egrep "^\w*#|^\w*$$" $^ | wc` "[comments/blanks]" diff --git a/coffee/env.coffee b/coffee/env.coffee deleted file mode 100644 index 097933a3ad..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 87c8d3765a..0000000000 --- a/coffee/node_readline.coffee +++ /dev/null @@ -1,39 +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 - try - fs.appendFileSync HISTORY_FILE, line + "\n" - catch exc - true - - line - -# vim: ts=2:sw=2 diff --git a/coffee/package.json b/coffee/package.json deleted file mode 100644 index d28b74bdd0..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.3.x", - "coffee-script": "~1.8" - } -} diff --git a/coffee/run b/coffee/run deleted file mode 100755 index b7841f7779..0000000000 --- a/coffee/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec coffee $(dirname $0)/${STEP:-stepA_mal}.coffee "${@}" diff --git a/coffee/step2_eval.coffee b/coffee/step2_eval.coffee deleted file mode 100644 index a6fe840a1e..0000000000 --- a/coffee/step2_eval.coffee +++ /dev/null @@ -1,55 +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 - if ast.length == 0 then return ast - - # 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? 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 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 254c2bee95..0000000000 --- a/coffee/step3_env.coffee +++ /dev/null @@ -1,66 +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 - 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...] = 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? 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 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 f4e0c45662..0000000000 --- a/coffee/step4_if_fn_do.coffee +++ /dev/null @@ -1,79 +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 - 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 = 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? 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 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 1541d468ef..0000000000 --- a/coffee/step5_tco.coffee +++ /dev/null @@ -1,85 +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 - 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" - 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? 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 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 1304c8fde4..0000000000 --- a/coffee/step7_quote.coffee +++ /dev/null @@ -1,109 +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] != null && 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 - 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" - 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? 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 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 fe4d06bb7e..0000000000 --- a/coffee/step8_macros.coffee +++ /dev/null @@ -1,129 +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] != null && 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 eval_ast ast, env - 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.__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? 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 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 a73f5d40ff..0000000000 --- a/coffee/step9_try.coffee +++ /dev/null @@ -1,137 +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] != null && 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 eval_ast ast, env - 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.__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? 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 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 3aeb455810..0000000000 --- a/coffee/stepA_mal.coffee +++ /dev/null @@ -1,147 +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] != null && 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 eval_ast ast, env - 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.__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("(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)))))))))") - -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 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 ae9ec63afa..0000000000 --- a/core.mal +++ /dev/null @@ -1,86 +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* (condvar (gensym)) - `(let* (~condvar ~(first xs)) - (if ~condvar (and ~@(rest xs)) ~condvar))))))) - -(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))))))))) - -(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/cpp/Dockerfile b/cpp/Dockerfile deleted file mode 100644 index 8d01389900..0000000000 --- a/cpp/Dockerfile +++ /dev/null @@ -1,25 +0,0 @@ -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++ diff --git a/cpp/Makefile b/cpp/Makefile deleted file mode 100644 index 5e464d51e8..0000000000 --- a/cpp/Makefile +++ /dev/null @@ -1,67 +0,0 @@ -uname_S := $(shell sh -c 'uname -s 2>/dev/null || echo not') - -ifeq ($(uname_S),Darwin) - # Native build on yosemite. Requires: brew install readline - CXX=g++ - READLINE=/usr/local/Cellar/readline/6.3.8 - INCPATHS=-I$(READLINE)/include - LIBPATHS=-L$(READLINE)/lib -else - # Ubuntu 14.10 / docker - CXX=g++-4.9 -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 - - -### Stats - -.PHONY: stats stats-lisp - -stats: $(LIBSOURCES) stepA_mal.cpp - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" - -stats-lisp: Core.cpp Environment.cpp stepA_mal.cpp - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" diff --git a/cpp/README.md b/cpp/README.md deleted file mode 100644 index d62db64742..0000000000 --- a/cpp/README.md +++ /dev/null @@ -1,39 +0,0 @@ -# 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 implemenations: - - ./docker run ./stepA_mal - - * open a shell inside the docker container: - - ./docker run diff --git a/cpp/run b/cpp/run deleted file mode 100755 index 8ba68a5484..0000000000 --- a/cpp/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec $(dirname $0)/${STEP:-stepA_mal} "${@}" diff --git a/cpp/step8_macros.cpp b/cpp/step8_macros.cpp deleted file mode 100644 index 82c759ed70..0000000000 --- a/cpp/step8_macros.cpp +++ /dev/null @@ -1,319 +0,0 @@ -#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 malValuePtr macroExpand(malValuePtr obj, malEnvPtr env); -static void installMacros(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); - installMacros(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 malList* list = DYNAMIC_CAST(malList, ast); - if (!list || (list->count() == 0)) { - return ast->eval(env); - } - - ast = macroExpand(ast, env); - 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 == "macroexpand") { - checkArgsIs("macroexpand", 1, argCount); - return macroExpand(list->item(1), env); - } - - 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); -} - -static const malSequence* isPair(malValuePtr obj) -{ - const malSequence* list = DYNAMIC_CAST(malSequence, obj); - return list && !list->isEmpty() ? list : NULL; -} - -static malValuePtr quasiquote(malValuePtr obj) -{ - const malSequence* seq = isPair(obj); - if (!seq) { - return mal::list(mal::symbol("quote"), obj); - } - - if (isSymbol(seq->item(0), "unquote")) { - // (qq (uq form)) -> form - checkArgsIs("unquote", 1, seq->count() - 1); - return seq->item(1); - } - - const malSequence* innerSeq = isPair(seq->item(0)); - if (innerSeq && isSymbol(innerSeq->item(0), "splice-unquote")) { - checkArgsIs("splice-unquote", 1, innerSeq->count() - 1); - // (qq (sq '(a b c))) -> a b c - return mal::list( - mal::symbol("concat"), - innerSeq->item(1), - quasiquote(seq->rest()) - ); - } - else { - // (qq (a b c)) -> (list (qq a) (qq b) (qq c)) - // (qq xs ) -> (cons (qq (car xs)) (qq (cdr xs))) - return mal::list( - mal::symbol("cons"), - quasiquote(seq->first()), - quasiquote(seq->rest()) - ); - } -} - -static const malLambda* isMacroApplication(malValuePtr obj, malEnvPtr env) -{ - if (const malSequence* seq = isPair(obj)) { - if (malSymbol* sym = DYNAMIC_CAST(malSymbol, seq->first())) { - if (malEnvPtr symEnv = env->find(sym->value())) { - malValuePtr value = sym->eval(symEnv); - if (malLambda* lambda = DYNAMIC_CAST(malLambda, value)) { - return lambda->isMacro() ? lambda : NULL; - } - } - } - } - return NULL; -} - -static malValuePtr macroExpand(malValuePtr obj, malEnvPtr env) -{ - while (const malLambda* macro = isMacroApplication(obj, env)) { - const malSequence* seq = STATIC_CAST(malSequence, obj); - obj = macro->apply(seq->begin() + 1, seq->end()); - } - return obj; -} - -static const char* macroTable[] = { - "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", - "(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))))))))", -}; - -static void installMacros(malEnvPtr env) -{ - for (auto ¯o : macroTable) { - rep(macro, env); - } -} - -static const char* malFunctionTable[] = { - "(def! list (fn* (& items) items))", - "(def! not (fn* (cond) (if cond false true)))", - "(def! >= (fn* (a b) (<= b a)))", - "(def! < (fn* (a b) (not (<= b a))))", - "(def! > (fn* (a b) (not (<= a b))))", - "(def! load-file (fn* (filename) \ - (eval (read-string (str \"(do \" (slurp filename) \")\")))))", -}; - -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/cpp/step9_try.cpp b/cpp/step9_try.cpp deleted file mode 100644 index 17cf178cc0..0000000000 --- a/cpp/step9_try.cpp +++ /dev/null @@ -1,362 +0,0 @@ -#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 malValuePtr macroExpand(malValuePtr obj, malEnvPtr env); -static void installMacros(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); - installMacros(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 malList* list = DYNAMIC_CAST(malList, ast); - if (!list || (list->count() == 0)) { - return ast->eval(env); - } - - ast = macroExpand(ast, env); - 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 == "macroexpand") { - checkArgsIs("macroexpand", 1, argCount); - return macroExpand(list->item(1), env); - } - - 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*") { - checkArgsIs("try*", 2, argCount); - malValuePtr tryBody = list->item(1); - 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 { - ast = 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. - 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); -} - -static const malSequence* isPair(malValuePtr obj) -{ - const malSequence* list = DYNAMIC_CAST(malSequence, obj); - return list && !list->isEmpty() ? list : NULL; -} - -static malValuePtr quasiquote(malValuePtr obj) -{ - const malSequence* seq = isPair(obj); - if (!seq) { - return mal::list(mal::symbol("quote"), obj); - } - - if (isSymbol(seq->item(0), "unquote")) { - // (qq (uq form)) -> form - checkArgsIs("unquote", 1, seq->count() - 1); - return seq->item(1); - } - - const malSequence* innerSeq = isPair(seq->item(0)); - if (innerSeq && isSymbol(innerSeq->item(0), "splice-unquote")) { - checkArgsIs("splice-unquote", 1, innerSeq->count() - 1); - // (qq (sq '(a b c))) -> a b c - return mal::list( - mal::symbol("concat"), - innerSeq->item(1), - quasiquote(seq->rest()) - ); - } - else { - // (qq (a b c)) -> (list (qq a) (qq b) (qq c)) - // (qq xs ) -> (cons (qq (car xs)) (qq (cdr xs))) - return mal::list( - mal::symbol("cons"), - quasiquote(seq->first()), - quasiquote(seq->rest()) - ); - } -} - -static const malLambda* isMacroApplication(malValuePtr obj, malEnvPtr env) -{ - if (const malSequence* seq = isPair(obj)) { - if (malSymbol* sym = DYNAMIC_CAST(malSymbol, seq->first())) { - if (malEnvPtr symEnv = env->find(sym->value())) { - malValuePtr value = sym->eval(symEnv); - if (malLambda* lambda = DYNAMIC_CAST(malLambda, value)) { - return lambda->isMacro() ? lambda : NULL; - } - } - } - } - return NULL; -} - -static malValuePtr macroExpand(malValuePtr obj, malEnvPtr env) -{ - while (const malLambda* macro = isMacroApplication(obj, env)) { - const malSequence* seq = STATIC_CAST(malSequence, obj); - obj = macro->apply(seq->begin() + 1, seq->end()); - } - return obj; -} - -static const char* macroTable[] = { - "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", - "(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))))))))", -}; - -static void installMacros(malEnvPtr env) -{ - for (auto ¯o : macroTable) { - rep(macro, env); - } -} - -static const char* malFunctionTable[] = { - "(def! list (fn* (& items) items))", - "(def! not (fn* (cond) (if cond false true)))", - "(def! >= (fn* (a b) (<= b a)))", - "(def! < (fn* (a b) (not (<= b a))))", - "(def! > (fn* (a b) (not (<= a b))))", - "(def! load-file (fn* (filename) \ - (eval (read-string (str \"(do \" (slurp filename) \")\")))))", - "(def! map (fn* (f xs) (if (empty? xs) xs \ - (cons (f (first xs)) (map f (rest xs))))))", -}; - -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/cpp/stepA_mal.cpp b/cpp/stepA_mal.cpp deleted file mode 100644 index 70ed6ac9a3..0000000000 --- a/cpp/stepA_mal.cpp +++ /dev/null @@ -1,364 +0,0 @@ -#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 malValuePtr macroExpand(malValuePtr obj, malEnvPtr env); -static void installMacros(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); - installMacros(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 (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 malList* list = DYNAMIC_CAST(malList, ast); - if (!list || (list->count() == 0)) { - return ast->eval(env); - } - - ast = macroExpand(ast, env); - 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 == "macroexpand") { - checkArgsIs("macroexpand", 1, argCount); - return macroExpand(list->item(1), env); - } - - 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*") { - checkArgsIs("try*", 2, argCount); - malValuePtr tryBody = list->item(1); - 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 { - ast = 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. - 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); -} - -static const malSequence* isPair(malValuePtr obj) -{ - const malSequence* list = DYNAMIC_CAST(malSequence, obj); - return list && !list->isEmpty() ? list : NULL; -} - -static malValuePtr quasiquote(malValuePtr obj) -{ - const malSequence* seq = isPair(obj); - if (!seq) { - return mal::list(mal::symbol("quote"), obj); - } - - if (isSymbol(seq->item(0), "unquote")) { - // (qq (uq form)) -> form - checkArgsIs("unquote", 1, seq->count() - 1); - return seq->item(1); - } - - const malSequence* innerSeq = isPair(seq->item(0)); - if (innerSeq && isSymbol(innerSeq->item(0), "splice-unquote")) { - checkArgsIs("splice-unquote", 1, innerSeq->count() - 1); - // (qq (sq '(a b c))) -> a b c - return mal::list( - mal::symbol("concat"), - innerSeq->item(1), - quasiquote(seq->rest()) - ); - } - else { - // (qq (a b c)) -> (list (qq a) (qq b) (qq c)) - // (qq xs ) -> (cons (qq (car xs)) (qq (cdr xs))) - return mal::list( - mal::symbol("cons"), - quasiquote(seq->first()), - quasiquote(seq->rest()) - ); - } -} - -static const malLambda* isMacroApplication(malValuePtr obj, malEnvPtr env) -{ - if (const malSequence* seq = isPair(obj)) { - if (malSymbol* sym = DYNAMIC_CAST(malSymbol, seq->first())) { - if (malEnvPtr symEnv = env->find(sym->value())) { - malValuePtr value = sym->eval(symEnv); - if (malLambda* lambda = DYNAMIC_CAST(malLambda, value)) { - return lambda->isMacro() ? lambda : NULL; - } - } - } - } - return NULL; -} - -static malValuePtr macroExpand(malValuePtr obj, malEnvPtr env) -{ - while (const malLambda* macro = isMacroApplication(obj, env)) { - const malSequence* seq = STATIC_CAST(malSequence, obj); - obj = macro->apply(seq->begin() + 1, seq->end()); - } - return obj; -} - -static const char* macroTable[] = { - "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", - "(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)))))))))", -}; - -static void installMacros(malEnvPtr env) -{ - for (auto ¯o : macroTable) { - rep(macro, env); - } -} - -malValuePtr readline(const String& prompt) -{ - String input; - if (s_readLine.get(prompt, input)) { - return mal::string(input); - } - return mal::nilValue(); -} - -static const char* malFunctionTable[] = { - "(def! list (fn* (& items) items))", - "(def! not (fn* (cond) (if cond false true)))", - "(def! >= (fn* (a b) (<= b a)))", - "(def! < (fn* (a b) (not (<= b a))))", - "(def! > (fn* (a b) (not (<= a b))))", - "(def! load-file (fn* (filename) \ - (eval (read-string (str \"(do \" (slurp filename) \")\")))))", - "(def! map (fn* (f xs) (if (empty? xs) xs \ - (cons (f (first xs)) (map f (rest xs))))))", - "(def! *gensym-counter* (atom 0))", - "(def! gensym (fn* [] (symbol (str \"G__\" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))", - "(def! *host-language* \"C++\")", -}; - -static void installFunctions(malEnvPtr env) { - for (auto &function : malFunctionTable) { - rep(function, env); - } -} diff --git a/crystal/Dockerfile b/crystal/Dockerfile deleted file mode 100644 index 367804ebd1..0000000000 --- a/crystal/Dockerfile +++ /dev/null @@ -1,29 +0,0 @@ -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++ - -# Crystal -RUN curl http://dist.crystal-lang.org/apt/setup.sh | bash -RUN apt-get -y install crystal diff --git a/crystal/Makefile b/crystal/Makefile deleted file mode 100644 index ba96eadb6a..0000000000 --- a/crystal/Makefile +++ /dev/null @@ -1,29 +0,0 @@ -STEPS = step0_repl.cr step1_read_print.cr step2_eval.cr step3_env.cr \ - step4_if_fn_do.cr step5_tco.cr step6_file.cr step7_quote.cr \ - step8_macros.cr step9_try.cr stepA_mal.cr - -STEP_BINS = $(STEPS:%.cr=%) -LAST_STEP_BIN = $(word $(words $(STEP_BINS)),$(STEP_BINS)) - -all: $(STEP_BINS) - -dist: mal - -mal: $(LAST_STEP_BIN) - cp $< $@ - -$(STEP_BINS): %: %.cr $(MAL_LIB) - crystal build --release $< - -clean: - rm -rf $(STEP_BINS) mal .crystal - -stats: types.cr error.cr readline.cr reader.cr printer.cr env.cr core.cr stepA_mal.cr - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*#|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: env.cr core.cr stepA_mal.cr - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*#|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" - -.PHONY: all clean stats stats-lisp - diff --git a/crystal/core.cr b/crystal/core.cr deleted file mode 100644 index ce5ad3a39d..0000000000 --- a/crystal/core.cr +++ /dev/null @@ -1,439 +0,0 @@ -require "time" - -require "./types" -require "./error" -require "./printer" -require "./reader" -require "./readline" - -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?(Int32) && y.is_a?(Int32) - 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 as Int32 - when Nil - 0 - 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 e : Errno - eval_error "no such file" - 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.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? Int32 - 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 - "\u029e" + head -end - -def self.keyword?(args) - head = args.first.unwrap - head.is_a?(String) && !head.empty? && head[0] == '\u029e' -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 - my_readline head -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.now.epoch_ms.to_i32 -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), - "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?), - "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/crystal/printer.cr b/crystal/printer.cr deleted file mode 100644 index 7444cb272a..0000000000 --- a/crystal/printer.cr +++ /dev/null @@ -1,34 +0,0 @@ -require "./types" - -def pr_str(value, print_readably = true) - case value - when Nil then "nil" - when Bool then value.to_s - when Int32 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/crystal/readline.cr b/crystal/readline.cr deleted file mode 100644 index e57099a954..0000000000 --- a/crystal/readline.cr +++ /dev/null @@ -1,21 +0,0 @@ -# Note: -# Crystal already has "readline" library. -# I implemented a subset of it again for practice. - -@[Link("readline")] -lib LibReadline - fun readline(prompt : UInt8*) : UInt8* - fun add_history(line : UInt8*) -end - -def my_readline(prompt = "") - line = LibReadline.readline(prompt) - if line - LibReadline.add_history(line) - String.new(line) - else - nil - end -ensure - LibC.free(line as Void*) if line -end diff --git a/crystal/run b/crystal/run deleted file mode 100755 index 8ba68a5484..0000000000 --- a/crystal/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec $(dirname $0)/${STEP:-stepA_mal} "${@}" diff --git a/crystal/step0_repl.cr b/crystal/step0_repl.cr deleted file mode 100755 index e1fe58a398..0000000000 --- a/crystal/step0_repl.cr +++ /dev/null @@ -1,26 +0,0 @@ -#! /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 = my_readline("user> ") - puts rep(line) -end diff --git a/crystal/step1_read_print.cr b/crystal/step1_read_print.cr deleted file mode 100755 index 9da58c35fc..0000000000 --- a/crystal/step1_read_print.cr +++ /dev/null @@ -1,36 +0,0 @@ -#! /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 = my_readline("user> ") - begin - puts Mal.rep(line) - rescue e - STDERR.puts e - end -end diff --git a/crystal/step2_eval.cr b/crystal/step2_eval.cr deleted file mode 100755 index c41f50388a..0000000000 --- a/crystal/step2_eval.cr +++ /dev/null @@ -1,94 +0,0 @@ -#! /usr/bin/env crystal run - -require "./readline" -require "./reader" -require "./printer" -require "./types" - -# Note: -# Employed downcase names because Crystal prohibits uppercase names for methods - -module Mal - extend self - - 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?(Int32) && y.is_a?(Int32) - Mal::Type.new func.call(x, y) - } - end - - def eval_ast(a, env) - return a.map{|n| eval(n, env) as Mal::Type} if a.is_a? Mal::List - return a unless a - - ast = a.unwrap - case ast - when Mal::Symbol - if env.has_key? ast.str - env[ast.str] - else - eval_error "'#{ast.str}' not found" - end - when Mal::List - ast.each_with_object(Mal::List.new){|n, l| l << eval(n, env)} - when Mal::Vector - ast.each_with_object(Mal::Vector.new){|n, l| l << eval(n, env)} - when Mal::HashMap - ast.each{|k, v| ast[k] = eval(v, env)} - else - ast - end - end - - def read(str) - read_str str - end - - def eval(t, env) - Mal::Type.new case ast = t.unwrap - when Mal::List - return gen_type Mal::List if ast.empty? - - f = eval_ast(ast.first, env) - ast.shift(1) - args = eval_ast(ast, env) - - if f.is_a?(Mal::Func) - f.call(args) - else - eval_error "expected function symbol as the first symbol of list" - end - else - eval_ast(t, env) - end - end - - def print(result) - pr_str(result, true) - end - - def rep(str) - print(eval(read(str), $repl_env)) - end -end - -$repl_env = { - "+" => Mal.num_func(->(x : Int32, y : Int32){ x + y }), - "-" => Mal.num_func(->(x : Int32, y : Int32){ x - y }), - "*" => Mal.num_func(->(x : Int32, y : Int32){ x * y }), - "/" => Mal.num_func(->(x : Int32, y : Int32){ x / y }), -} of String => Mal::Func - -while line = my_readline("user> ") - begin - puts Mal.rep(line) - rescue e - STDERR.puts e - end -end diff --git a/crystal/step3_env.cr b/crystal/step3_env.cr deleted file mode 100755 index dd41af5a66..0000000000 --- a/crystal/step3_env.cr +++ /dev/null @@ -1,118 +0,0 @@ -#! /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?(Int32) && y.is_a?(Int32) - Mal::Type.new func.call(x, y) - } -end - -$repl_env = Mal::Env.new nil -$repl_env.set("+", Mal::Type.new num_func(->(x : Int32, y : Int32){ x + y })) -$repl_env.set("-", Mal::Type.new num_func(->(x : Int32, y : Int32){ x - y })) -$repl_env.set("*", Mal::Type.new num_func(->(x : Int32, y : Int32){ x * y })) -$repl_env.set("/", Mal::Type.new num_func(->(x : Int32, y : Int32){ x / y })) - -module Mal - extend self - - def eval_ast(a, env) - return a.map{|n| eval(n, env) } if a.is_a? Array - - Mal::Type.new case ast = a.unwrap - when Mal::Symbol - if e = env.get(ast.str) - e - else - eval_error "'#{ast.str}' not found" - end - when Mal::List - ast.each_with_object(Mal::List.new){|n, l| l << eval(n, env)} - when Mal::Vector - ast.each_with_object(Mal::Vector.new){|n, l| l << eval(n, env)} - when Mal::HashMap - new_map = Mal::HashMap.new - ast.each{|k, v| new_map[k] = eval(v, env)} - new_map - else - ast - end - end - - def read(str) - read_str str - end - - def eval(t, env) - ast = t.unwrap - - return eval_ast(t, env) unless ast.is_a?(Mal::List) - return gen_type Mal::List if ast.empty? - - sym = ast.first.unwrap - eval_error "first element of list must be a symbol" unless sym.is_a?(Mal::Symbol) - - Mal::Type.new case sym.str - when "def!" - eval_error "wrong number of argument for 'def!'" unless ast.size == 3 - a1 = ast[1].unwrap - eval_error "1st argument of 'def!' must be symbol" unless a1.is_a?(Mal::Symbol) - env.set(a1.str, eval(ast[2], env) as Mal::Type) - when "let*" - eval_error "wrong number of argument for 'def!'" unless ast.size == 3 - - bindings = ast[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| - name, value = binding[0].unwrap, binding[1] - eval_error "name of binding must be specified as symbol" unless name.is_a?(Mal::Symbol) - new_env.set(name.str, eval(value, new_env)) - end - - eval(ast[2], new_env) - else - f = eval_ast(ast.first, env) - ast.shift(1) - args = eval_ast(ast, env) - - if f.is_a?(Mal::Type) && (f2 = f.unwrap).is_a?(Mal::Func) - f2.call(args as Array(Mal::Type)) - else - eval_error "expected function symbol as the first symbol of list" - end - end - end - - def print(result) - pr_str(result, true) - end - - def rep(str) - print(eval(read(str), $repl_env)) - end -end - -while line = my_readline("user> ") - begin - puts Mal.rep(line) - rescue e - STDERR.puts e - end -end diff --git a/crystal/step4_if_fn_do.cr b/crystal/step4_if_fn_do.cr deleted file mode 100755 index de3e65bbd6..0000000000 --- a/crystal/step4_if_fn_do.cr +++ /dev/null @@ -1,134 +0,0 @@ -#! /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 eval_ast(ast, env) - return ast.map{|n| eval(n, env) as Mal::Type} if ast.is_a? Mal::List - - val = ast.unwrap - - Mal::Type.new case val - when Mal::Symbol - if e = env.get(val.str) - e - else - eval_error "'#{val.str}' not found" - end - when Mal::List - val.each_with_object(Mal::List.new){|n, l| l << eval(n, env)} - when Mal::Vector - val.each_with_object(Mal::Vector.new){|n, l| l << eval(n, env)} - when Mal::HashMap - val.each{|k, v| val[k] = eval(v, env)} - val - else - val - end - end - - def eval_invocation(list, env) - f = eval(list.first, env).unwrap - eval_error "expected function symbol as the first symbol of list" unless f.is_a? Mal::Func - f.call eval_ast(list[1..-1].each_with_object(Mal::List.new){|i, l| l << i}, env) - end - - def read(str) - read_str str - end - - def eval(ast, env) - list = ast.unwrap - - return eval_ast(ast, env) unless list.is_a? Mal::List - return gen_type Mal::List if list.empty? - - head = list.first.unwrap - - Mal::Type.new case head - when Mal::Symbol - case head.str - 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" unless a1.is_a? Mal::Symbol - 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" unless name.is_a? Mal::Symbol - new_env.set(name.str, eval(value, new_env)) - end - - eval(list[2], new_env) - when "do" - list.shift 1 - eval_ast(list, env).last - when "if" - cond = eval(list[1], env).unwrap - case cond - when Nil - list.size >= 4 ? eval(list[3], env) : nil - when false - list.size >= 4 ? eval(list[3], env) : nil - else - eval(list[2], env) - end - when "fn*" - # Note: - # If writing lambda expression here directly, compiler will fail to infer type of 'list'. (Error 'Nil for empty?') - func_of(env, list[1].unwrap, list[2]) - else - eval_invocation(list, env) - end - else - eval_invocation(list, env) - 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 = my_readline("user> ") - begin - puts Mal.rep(line) - rescue e - STDERR.puts e - end -end diff --git a/crystal/step5_tco.cr b/crystal/step5_tco.cr deleted file mode 100755 index 061293fc3f..0000000000 --- a/crystal/step5_tco.cr +++ /dev/null @@ -1,168 +0,0 @@ -#! /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 eval_ast(ast, env) - return ast.map{|n| eval(n, env) as Mal::Type} if ast.is_a? Mal::List - - val = ast.unwrap - - Mal::Type.new case val - when Mal::Symbol - if e = env.get(val.str) - e - else - eval_error "'#{val.str}' not found" - end - when Mal::List - val.each_with_object(Mal::List.new){|n, l| l << eval(n, env)} - when Mal::Vector - val.each_with_object(Mal::Vector.new){|n, l| l << eval(n, env)} - when Array(Mal::Type) - val.map{|n| eval(n, env)} - when Mal::HashMap - val.each{|k, v| val[k] = eval(v, env)} - val - else - val - end - end - - def eval_invocation(list, env) - f = eval(list.first, env).unwrap - case f - when Mal::Closure - f.fn.call eval_ast(list[1..-1].each_with_object(Mal::List.new){|i, l| l << i}, env) - when Mal::Func - f.call eval_ast(list[1..-1].each_with_object(Mal::List.new){|i, l| l << i}, env) - else - eval_error "expected function as the first argument" - end - end - - def read(str) - read_str str - end - - macro invoke_list(l) - f = eval({{l}}.first, env).unwrap - args = eval_ast({{l}}[1..-1].each_with_object(Mal::List.new){|i, l| l << i}, env) - case f - when Mal::Closure - ast = f.ast - env = Mal::Env.new(f.env, f.params, args) - next # TCO - when Mal::Func - return f.call args - else - eval_error "expected function as the first argument" - end - end - - def eval(ast, env) - # 'next' in 'do...end' has a bug in crystal 0.7.1 - # https://github.com/manastech/crystal/issues/659 - while true - list = ast.unwrap - - return eval_ast(ast, env) unless list.is_a? Mal::List - return gen_type Mal::List if list.empty? - - head = list.first.unwrap - - unless head.is_a? Mal::Symbol - invoke_list list - end - - return Mal::Type.new case head.str - 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" unless a1.is_a? Mal::Symbol - 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" 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 - - eval_ast(list[1..-2].each_with_object(Mal::List.new){|i,l| l << i}, 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*" - # Note: - # If writing lambda expression here directly, compiler will fail to infer type of 'list'. (Error 'Nil for empty?') - params = list[1].unwrap - unless params.is_a? Array - eval_error "'fn*' parameters must be list" - end - Mal::Closure.new(list[2], params, env, func_of(env, list[1].unwrap, list[2])) - else - invoke_list list - 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 = my_readline("user> ") - begin - puts Mal.rep(line) - rescue e - STDERR.puts e - end -end diff --git a/crystal/step6_file.cr b/crystal/step6_file.cr deleted file mode 100755 index 594ed9279c..0000000000 --- a/crystal/step6_file.cr +++ /dev/null @@ -1,181 +0,0 @@ -#! /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 eval_ast(ast, env) - return ast.map{|n| eval(n, env) as Mal::Type} if ast.is_a? Mal::List - - val = ast.unwrap - - Mal::Type.new case val - when Mal::Symbol - if e = env.get(val.str) - e - else - eval_error "'#{val.str}' not found" - end - when Mal::List - val.each_with_object(Mal::List.new){|n, l| l << eval(n, env)} - when Mal::Vector - val.each_with_object(Mal::Vector.new){|n, l| l << eval(n, env)} - when Array(Mal::Type) - val.map{|n| eval(n, env)} - when Mal::HashMap - val.each{|k, v| val[k] = eval(v, env)} - val - else - val - end - end - - def eval_invocation(list, env) - f = eval(list.first, env).unwrap - case f - when Mal::Closure - f.fn.call eval_ast(list[1..-1].each_with_object(Mal::List.new){|i, l| l << i}, env) - when Mal::Func - f.call eval_ast(list[1..-1].each_with_object(Mal::List.new){|i, l| l << i}, env) - else - eval_error "expected function as the first argument" - end - end - - def read(str) - read_str str - end - - macro invoke_list(l, env) - f = eval({{l}}.first, {{env}}).unwrap - args = eval_ast({{l}}[1..-1].each_with_object(Mal::List.new){|i, l| l << i}, {{env}}) - case f - when Mal::Closure - ast = f.ast - {{env}} = Mal::Env.new(f.env, f.params, args) - next # TCO - when Mal::Func - return f.call args - else - eval_error "expected function as the first argument" - end - end - - def eval(ast, env) - # 'next' in 'do...end' has a bug in crystal 0.7.1 - # https://github.com/manastech/crystal/issues/659 - while true - list = ast.unwrap - - return eval_ast(ast, env) unless list.is_a? Mal::List - return gen_type Mal::List if list.empty? - - head = list.first.unwrap - - unless head.is_a? Mal::Symbol - invoke_list(list, env) - end - - return Mal::Type.new case head.str - 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" unless a1.is_a? Mal::Symbol - 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" 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 - - eval_ast(list[1..-2].each_with_object(Mal::List.new){|i,l| l << i}, 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" - end - Mal::Closure.new(list[2], params, env, func_of(env, params, list[2])) - else - invoke_list(list, env) - 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) \")\")))))" -$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 - - Mal.rep "(load-file \"#{ARGV[0]}\")" - exit -end - -while line = my_readline("user> ") - begin - puts Mal.rep(line) - rescue e - STDERR.puts e - end -end diff --git a/crystal/step7_quote.cr b/crystal/step7_quote.cr deleted file mode 100755 index a1d5708ff3..0000000000 --- a/crystal/step7_quote.cr +++ /dev/null @@ -1,211 +0,0 @@ -#! /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 eval_ast(ast, env) - return ast.map{|n| eval(n, env) as Mal::Type} if ast.is_a? Mal::List - - val = ast.unwrap - - Mal::Type.new case val - when Mal::Symbol - if e = env.get(val.str) - e - else - eval_error "'#{val.str}' not found" - end - when Mal::List - val.each_with_object(Mal::List.new){|n, l| l << eval(n, env)} - when Mal::Vector - val.each_with_object(Mal::Vector.new){|n, l| l << eval(n, env)} - when Array(Mal::Type) - val.map{|n| eval(n, env)} - when Mal::HashMap - val.each{|k, v| val[k] = eval(v, env)} - val - else - val - end - end - - def read(str) - read_str str - end - - macro is_pair(list) - {{list}}.is_a?(Array) && !{{list}}.empty? - end - - def quasiquote(ast) - list = ast.unwrap - - unless is_pair(list) - return Mal::Type.new( - Mal::List.new << gen_type(Mal::Symbol, "quote") << ast - ) - end - - head = list.first.unwrap - - case - # ("unquote" ...) - when head.is_a?(Mal::Symbol) && head.str == "unquote" - list[1] - # (("splice-unquote" ...) ...) - when is_pair(head) && (arg0 = head.first.unwrap).is_a?(Mal::Symbol) && arg0.str == "splice-unquote" - tail = Mal::Type.new list[1..-1].each_with_object(Mal::List.new){|e,l| l << e} - Mal::Type.new( - Mal::List.new << gen_type(Mal::Symbol, "concat") << head[1] << quasiquote(tail) - ) - else - tail = Mal::Type.new list[1..-1].each_with_object(Mal::List.new){|e,l| l << e} - Mal::Type.new( - Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(list.first) << quasiquote(tail) - ) - end - end - - macro invoke_list(l, env) - f = eval({{l}}.first, {{env}}).unwrap - args = eval_ast({{l}}[1..-1].each_with_object(Mal::List.new){|i, l| l << i}, {{env}}) - case f - when Mal::Closure - ast = f.ast - {{env}} = Mal::Env.new(f.env, f.params, args) - next # TCO - when Mal::Func - return f.call args - else - eval_error "expected function as the first argument" - end - end - - def eval(ast, env) - # 'next' in 'do...end' has a bug in crystal 0.7.1 - # https://github.com/manastech/crystal/issues/659 - while true - list = ast.unwrap - - return eval_ast(ast, env) unless list.is_a? Mal::List - return gen_type Mal::List if list.empty? - - head = list.first.unwrap - - unless head.is_a? Mal::Symbol - return invoke_list(list, env) - end - - return Mal::Type.new case head.str - 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" unless a1.is_a? Mal::Symbol - 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" 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 - - eval_ast(list[1..-2].each_with_object(Mal::List.new){|i,l| l << i}, 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" - end - Mal::Closure.new(list[2], params, env, func_of(env, params, list[2])) - when "quote" - list[1] - when "quasiquote" - ast = quasiquote list[1] - next # TCO - else - invoke_list(list, env) - 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) \")\")))))" -$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 = my_readline("user> ") - begin - puts Mal.rep(line) - rescue e - STDERR.puts e - end -end diff --git a/crystal/step8_macros.cr b/crystal/step8_macros.cr deleted file mode 100755 index 5f1c63af7f..0000000000 --- a/crystal/step8_macros.cr +++ /dev/null @@ -1,257 +0,0 @@ -#! /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 eval_ast(ast, env) - return ast.map{|n| eval(n, env) as Mal::Type} if ast.is_a? Mal::List - - val = ast.unwrap - - Mal::Type.new case val - when Mal::Symbol - if e = env.get(val.str) - e - else - eval_error "'#{val.str}' not found" - end - when Mal::List - val.each_with_object(Mal::List.new){|n, l| l << eval(n, env)} - when Mal::Vector - val.each_with_object(Mal::Vector.new){|n, l| l << eval(n, env)} - when Array(Mal::Type) - val.map{|n| eval(n, env)} - when Mal::HashMap - val.each{|k, v| val[k] = eval(v, env)} - val - else - val - end - end - - def read(str) - read_str str - end - - macro pair?(list) - {{list}}.is_a?(Array) && !{{list}}.empty? - end - - def quasiquote(ast) - list = ast.unwrap - - unless pair?(list) - return Mal::Type.new( - Mal::List.new << gen_type(Mal::Symbol, "quote") << ast - ) - end - - head = list.first.unwrap - - case - # ("unquote" ...) - when head.is_a?(Mal::Symbol) && head.str == "unquote" - list[1] - # (("splice-unquote" ...) ...) - when pair?(head) && (arg0 = head.first.unwrap).is_a?(Mal::Symbol) && arg0.str == "splice-unquote" - tail = Mal::Type.new list[1..-1].each_with_object(Mal::List.new){|e,l| l << e} - Mal::Type.new( - Mal::List.new << gen_type(Mal::Symbol, "concat") << head[1] << quasiquote(tail) - ) - else - tail = Mal::Type.new list[1..-1].each_with_object(Mal::List.new){|e,l| l << e} - Mal::Type.new( - Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(list.first) << quasiquote(tail) - ) - end - end - - def macro_call?(ast, env) - list = ast.unwrap - return false unless list.is_a? Mal::List - - sym = list.first.unwrap - return false unless sym.is_a? Mal::Symbol - - func = env.find(sym.str).try(&.data[sym.str]) - return false unless func && func.macro? - - true - end - - def macroexpand(ast, env) - while macro_call?(ast, env) - - # Already checked in macro_call? - list = ast.unwrap as Mal::List - func_sym = list[0].unwrap as Mal::Symbol - func = env.get(func_sym.str).unwrap - - case func - when Mal::Func - ast = func.call(list[1..-1]) - when Mal::Closure - ast = func.fn.call(list[1..-1]) - else - eval_error "macro '#{func_sym.str}' must be function: #{ast}" - end - end - - ast - end - - macro invoke_list(l, env) - f = eval({{l}}.first, {{env}}).unwrap - args = eval_ast({{l}}[1..-1].each_with_object(Mal::List.new){|i, l| l << i}, {{env}}) - case f - when Mal::Closure - ast = f.ast - {{env}} = Mal::Env.new(f.env, f.params, args) - next # TCO - when Mal::Func - return f.call args - else - eval_error "expected function as the first argument: #{f}" - end - end - - def eval(ast, env) - # 'next' in 'do...end' has a bug in crystal 0.7.1 - # https://github.com/manastech/crystal/issues/659 - while true - return eval_ast(ast, env) unless ast.unwrap.is_a? Mal::List - - ast = macroexpand(ast, env) - - list = ast.unwrap - - return eval_ast(ast, env) unless list.is_a? Mal::List - return ast if list.empty? - - head = list.first.unwrap - - return invoke_list(list, env) unless head.is_a? Mal::Symbol - - return Mal::Type.new case head.str - 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 - 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 - - eval_ast(list[1..-2].each_with_object(Mal::List.new){|i,l| l << i}, 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 - Mal::Closure.new(list[2], params, env, func_of(env, params, list[2])) - when "quote" - 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 - env.set(a1.str, eval(list[2], env).tap{|n| n.is_macro = true}) - when "macroexpand" - macroexpand(list[1], env) - else - invoke_list(list, env) - 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) \")\")))))" -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 "(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))))))))" - -$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 = my_readline("user> ") - begin - puts Mal.rep(line) - rescue e - STDERR.puts e - end -end diff --git a/crystal/step9_try.cr b/crystal/step9_try.cr deleted file mode 100755 index 74685d4ae5..0000000000 --- a/crystal/step9_try.cr +++ /dev/null @@ -1,274 +0,0 @@ -#! /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 eval_ast(ast, env) - return ast.map{|n| eval(n, env) as Mal::Type} if ast.is_a? Mal::List - - val = ast.unwrap - - Mal::Type.new case val - when Mal::Symbol - if e = env.get(val.str) - e - else - eval_error "'#{val.str}' not found" - end - when Mal::List - val.each_with_object(Mal::List.new){|n, l| l << eval(n, env)} - when Mal::Vector - val.each_with_object(Mal::Vector.new){|n, l| l << eval(n, env)} - when Array(Mal::Type) - val.map{|n| eval(n, env)} - when Mal::HashMap - val.each{|k, v| val[k] = eval(v, env)} - val - else - val - end - end - - def read(str) - read_str str - end - - macro pair?(list) - {{list}}.is_a?(Array) && !{{list}}.empty? - end - - def quasiquote(ast) - list = ast.unwrap - - unless pair?(list) - return Mal::Type.new( - Mal::List.new << gen_type(Mal::Symbol, "quote") << ast - ) - end - - head = list.first.unwrap - - case - # ("unquote" ...) - when head.is_a?(Mal::Symbol) && head.str == "unquote" - list[1] - # (("splice-unquote" ...) ...) - when pair?(head) && (arg0 = head.first.unwrap).is_a?(Mal::Symbol) && arg0.str == "splice-unquote" - tail = Mal::Type.new list[1..-1].to_mal - Mal::Type.new( - Mal::List.new << gen_type(Mal::Symbol, "concat") << head[1] << quasiquote(tail) - ) - else - tail = Mal::Type.new list[1..-1].to_mal - Mal::Type.new( - Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(list.first) << quasiquote(tail) - ) - end - end - - def macro_call?(ast, env) - list = ast.unwrap - return false unless list.is_a? Mal::List - - sym = list.first.unwrap - return false unless sym.is_a? Mal::Symbol - - func = env.find(sym.str).try(&.data[sym.str]) - return false unless func && func.macro? - - true - end - - def macroexpand(ast, env) - while macro_call?(ast, env) - - # Already checked in macro_call? - list = ast.unwrap as Mal::List - func_sym = list[0].unwrap as Mal::Symbol - func = env.get(func_sym.str).unwrap - - case func - when Mal::Func - ast = func.call(list[1..-1]) - when Mal::Closure - ast = func.fn.call(list[1..-1]) - else - eval_error "macro '#{func_sym.str}' must be function: #{ast}" - end - end - - ast - end - - macro invoke_list(l, env) - f = eval({{l}}.first, {{env}}).unwrap - args = eval_ast({{l}}[1..-1].to_mal, {{env}}) - case f - when Mal::Closure - ast = f.ast - {{env}} = Mal::Env.new(f.env, f.params, args) - next # TCO - when Mal::Func - return f.call args - else - eval_error "expected function as the first argument: #{f}" - end - end - - def eval(ast, env) - # 'next' in 'do...end' has a bug in crystal 0.7.1 - # https://github.com/manastech/crystal/issues/659 - while true - return eval_ast(ast, env) unless ast.unwrap.is_a? Mal::List - - ast = macroexpand(ast, env) - - list = ast.unwrap - - return eval_ast(ast, env) unless list.is_a? Mal::List - return ast if list.empty? - - head = list.first.unwrap - - return invoke_list(list, env) unless head.is_a? Mal::Symbol - - return Mal::Type.new case head.str - 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 - 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 - - eval_ast(list[1..-2].to_mal, 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 - Mal::Closure.new(list[2], params, env, func_of(env, params, list[2])) - when "quote" - 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 - env.set(a1.str, eval(list[2], env).tap{|n| n.is_macro = true}) - when "macroexpand" - macroexpand(list[1], env) - when "try*" - catch_list = list[2].unwrap - 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 - eval(list[1], env) - rescue e : Mal::RuntimeException - new_env = Mal::Env.new(env, [catch_list[1]], [e.thrown]) - eval(catch_list[2], new_env) - rescue e - new_env = Mal::Env.new(env, [catch_list[1]], [Mal::Type.new e.message]) - eval(catch_list[2], new_env) - end - else - invoke_list(list, env) - 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) \")\")))))" -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 "(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))))))))" - -$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 = my_readline("user> ") - begin - puts Mal.rep(line) - rescue e - STDERR.puts e - end -end diff --git a/crystal/stepA_mal.cr b/crystal/stepA_mal.cr deleted file mode 100755 index baaa8a6c9c..0000000000 --- a/crystal/stepA_mal.cr +++ /dev/null @@ -1,286 +0,0 @@ -#! /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 eval_ast(ast, env) - return ast.map{|n| eval(n, env) as Mal::Type} if ast.is_a? Array - - val = ast.unwrap - - Mal::Type.new case val - when Mal::Symbol - if e = env.get(val.str) - e - else - eval_error "'#{val.str}' not found" - end - when Mal::List - val.each_with_object(Mal::List.new){|n, l| l << eval(n, env)} - when Mal::Vector - val.each_with_object(Mal::Vector.new){|n, l| l << eval(n, env)} - when Mal::HashMap - new_map = Mal::HashMap.new - val.each{|k, v| new_map[k] = eval(v, env)} - new_map - else - val - end - end - - def read(str) - read_str str - end - - macro pair?(list) - {{list}}.is_a?(Array) && !{{list}}.empty? - end - - def quasiquote(ast) - list = ast.unwrap - - unless pair?(list) - return Mal::Type.new( - Mal::List.new << gen_type(Mal::Symbol, "quote") << ast - ) - end - - head = list.first.unwrap - - case - # ("unquote" ...) - when head.is_a?(Mal::Symbol) && head.str == "unquote" - list[1] - # (("splice-unquote" ...) ...) - when pair?(head) && (arg0 = head.first.unwrap).is_a?(Mal::Symbol) && arg0.str == "splice-unquote" - tail = Mal::Type.new list[1..-1].to_mal - Mal::Type.new( - Mal::List.new << gen_type(Mal::Symbol, "concat") << head[1] << quasiquote(tail) - ) - else - tail = Mal::Type.new list[1..-1].to_mal - Mal::Type.new( - Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(list.first) << quasiquote(tail) - ) - end - end - - def macro_call?(ast, env) - list = ast.unwrap - return false unless list.is_a? Mal::List - return false if list.empty? - - sym = list.first.unwrap - return false unless sym.is_a? Mal::Symbol - - func = env.find(sym.str).try(&.data[sym.str]) - return false unless func && func.macro? - - true - end - - def macroexpand(ast, env) - while macro_call?(ast, env) - - # Already checked in macro_call? - list = ast.unwrap as Mal::List - func_sym = list[0].unwrap as Mal::Symbol - func = env.get(func_sym.str).unwrap - - case func - when Mal::Func - ast = func.call(list[1..-1]) - when Mal::Closure - ast = func.fn.call(list[1..-1]) - else - eval_error "macro '#{func_sym.str}' must be function: #{ast}" - end - end - - ast - end - - macro invoke_list(l, env) - f = eval({{l}}.first, {{env}}).unwrap - args = eval_ast({{l}}[1..-1], {{env}}) as Array - - case f - when Mal::Closure - ast = f.ast - {{env}} = Mal::Env.new(f.env, f.params, args) - next # TCO - when Mal::Func - return f.call args - else - eval_error "expected function as the first argument: #{f}" - end - end - - def debug(ast) - puts print(ast).colorize.red - end - - def eval(ast, env) - # 'next' in 'do...end' has a bug in crystal 0.7.1 - # https://github.com/manastech/crystal/issues/659 - while true - return eval_ast(ast, env) unless ast.unwrap.is_a? Mal::List - - ast = macroexpand(ast, env) - - list = ast.unwrap - - return eval_ast(ast, env) unless list.is_a? Mal::List - return ast if list.empty? - - head = list.first.unwrap - - return invoke_list(list, env) unless head.is_a? Mal::Symbol - - return Mal::Type.new case head.str - 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 - 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 - - eval_ast(list[1..-2].to_mal, 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 - Mal::Closure.new(list[2], params, env, func_of(env, params, list[2])) - when "quote" - 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 - env.set(a1.str, eval(list[2], env).tap{|n| n.is_macro = true}) - when "macroexpand" - macroexpand(list[1], env) - when "try*" - catch_list = list[2].unwrap - 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 - eval(list[1], env) - rescue e : Mal::RuntimeException - new_env = Mal::Env.new(env, [catch_list[1]], [e.thrown]) - eval(catch_list[2], new_env) - rescue e - new_env = Mal::Env.new(env, [catch_list[1]], [Mal::Type.new e.message]) - eval(catch_list[2], new_env) - end - else - invoke_list(list, env) - 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) \")\")))))" -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! *gensym-counter* (atom 0))" -Mal.rep "(def! gensym (fn* [] (symbol (str \"G__\" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))" -Mal.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)))))))))" -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 = my_readline("user> ") - begin - puts Mal.rep(line) - rescue e - STDERR.puts e - end -end diff --git a/cs/Dockerfile b/cs/Dockerfile deleted file mode 100644 index f5f133484d..0000000000 --- a/cs/Dockerfile +++ /dev/null @@ -1,25 +0,0 @@ -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 -########################################################## - -# Deps for Mono-based languages (C#, VB.Net) -RUN apt-get -y install mono-runtime mono-mcs mono-vbnc mono-devel diff --git a/cs/Makefile b/cs/Makefile deleted file mode 100644 index 8431f704c1..0000000000 --- a/cs/Makefile +++ /dev/null @@ -1,60 +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: $(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 - -.PHONY: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" - -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 0940ae8930..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 = 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) \")\")))))"); - - 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 3ec240a3cf..0000000000 --- a/cs/step8_macros.cs +++ /dev/null @@ -1,260 +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 eval_ast(expanded, env); - } - 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 = 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) \")\")))))"); - 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 ea72427c7c..0000000000 --- a/cs/step9_try.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 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 eval_ast(expanded, env); - } - 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+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("(defmacro! cond (fn* (& xs) (if (> (count xs) 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 aea98e1f28..0000000000 --- a/cs/stepA_mal.cs +++ /dev/null @@ -1,289 +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 eval_ast(expanded, env); - } - 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+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) \")\")))))"); - 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("(def! *gensym-counter* (atom 0))"); - RE("(def! gensym (fn* [] (symbol (str \"G__\" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))"); - RE("(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 (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/d/Dockerfile b/d/Dockerfile deleted file mode 100644 index a11d7abfdc..0000000000 --- a/d/Dockerfile +++ /dev/null @@ -1,26 +0,0 @@ -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 -########################################################## - -RUN apt-get -y install gdc - -ENV HOME /mal diff --git a/d/Makefile b/d/Makefile deleted file mode 100644 index 57d4803f3a..0000000000 --- a/d/Makefile +++ /dev/null @@ -1,59 +0,0 @@ -CFLAGS += -g -O2 -Wall -LDFLAGS += -lreadline - -##################### - -TESTS = - -SOURCES_BASE = readline.d types.d reader.d printer.d -SOURCES_LISP = env.d mal_core.d stepA_mal.d -SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) - -##################### - -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 - gdc $(CFLAGS) -c $(@:%.o=%.d) -o $@ - -$(EARLY_STEPS_BINS): $(EARLY_OBJS) -$(LATE_STEPS_BINS): $(OTHER_OBJS) - -$(BINS): %: %.o - gdc $+ -o $@ $(LDFLAGS) - -clean: - rm -f $(OBJS) $(BINS) $(OTHER_OBJS) mal - -.PHONY: stats stats-lisp tests $(TESTS) - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" - -tests: $(TESTS) - -$(TESTS): - @echo "Running $@"; \ - ./$@ || exit 1; \ diff --git a/d/env.d b/d/env.d deleted file mode 100644 index d2e341b2ce..0000000000 --- a/d/env.d +++ /dev/null @@ -1,53 +0,0 @@ -import types; - -class Env { - Env outer; - MalType[MalSymbol] data; - - this(Env outer_v, MalType[] binds = [], MalType[] exprs = []) - { - outer = outer_v; - foreach (int 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, rest_exprs); - break; - } - else - { - set(arg_name, exprs[i]); - } - } - } - - MalType set(MalSymbol key, MalType val) - { - data[key] = val; - return val; - } - - Env find(MalSymbol key) - { - auto val = (key in data); - if (val !is null) { - return this; - } else if (outer is null) { - return null; - } else { - return outer.find(key); - } - } - - MalType get(MalSymbol key) - { - auto found = find(key); - if (found is null) { - throw new Exception("'" ~ key.print(true) ~ "' not found"); - } - return found.data[key]; - } -} diff --git a/d/run b/d/run deleted file mode 100755 index 8ba68a5484..0000000000 --- a/d/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec $(dirname $0)/${STEP:-stepA_mal} "${@}" diff --git a/d/step2_eval.d b/d/step2_eval.d deleted file mode 100644 index da3a28253a..0000000000 --- a/d/step2_eval.d +++ /dev/null @@ -1,136 +0,0 @@ -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_ast(MalType ast, Env env) -{ - if (typeid(ast) == typeid(MalSymbol)) - { - MalSymbol sym = verify_cast!MalSymbol(ast); - auto v = (sym.name in env); - if (v is null) throw new Exception("'" ~ sym.name ~ "' not found"); - return *v; - } - else if (typeid(ast) == typeid(MalList)) - { - auto lst = verify_cast!MalList(ast); - auto el = array(lst.elements.map!(e => EVAL(e, env))); - return new MalList(el); - } - else if (typeid(ast) == typeid(MalVector)) - { - auto lst = verify_cast!MalVector(ast); - auto el = array(lst.elements.map!(e => EVAL(e, env))); - return new MalVector(el); - } - else if (typeid(ast) == typeid(MalHashmap)) - { - auto hm = verify_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 - { - return ast; - } -} - -MalType EVAL(MalType ast, Env env) -{ - if (typeid(ast) != typeid(MalList)) - { - return eval_ast(ast, env); - } - if ((cast(MalList) ast).elements.length == 0) - { - return ast; - } - - auto el = verify_cast!MalList(eval_ast(ast, env)); - auto fobj = verify_cast!MalBuiltinFunc(el.elements[0]); - auto args = el.elements[1..$]; - return fobj.fn(args); -} - -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/d/step3_env.d b/d/step3_env.d deleted file mode 100644 index f1daf83c91..0000000000 --- a/d/step3_env.d +++ /dev/null @@ -1,157 +0,0 @@ -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_ast(MalType ast, Env env) -{ - if (typeid(ast) == typeid(MalSymbol)) - { - auto sym = verify_cast!MalSymbol(ast); - return env.get(sym); - } - else if (typeid(ast) == typeid(MalList)) - { - auto lst = verify_cast!MalList(ast); - auto el = array(lst.elements.map!(e => EVAL(e, env))); - return new MalList(el); - } - else if (typeid(ast) == typeid(MalVector)) - { - auto lst = verify_cast!MalVector(ast); - auto el = array(lst.elements.map!(e => EVAL(e, env))); - return new MalVector(el); - } - else if (typeid(ast) == typeid(MalHashmap)) - { - auto hm = verify_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 - { - return ast; - } -} - -MalType EVAL(MalType ast, Env env) -{ - MalList ast_list = cast(MalList) ast; - if (ast_list is null) - { - return eval_ast(ast, env); - } - 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, 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, EVAL(kv[1], let_env)); - } - return EVAL(ast_list.elements[2], let_env); - - default: - auto el = verify_cast!MalList(eval_ast(ast_list, env)); - auto fobj = verify_cast!MalBuiltinFunc(el.elements[0]); - auto args = el.elements[1..$]; - return fobj.fn(args); - } -} - -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 MalSymbol("+"), new MalBuiltinFunc(&mal_add, "+")); - repl_env.set(new MalSymbol("-"), new MalBuiltinFunc(&mal_sub, "-")); - repl_env.set(new MalSymbol("*"), new MalBuiltinFunc(&mal_mul, "*")); - repl_env.set(new MalSymbol("/"), 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/d/step4_if_fn_do.d b/d/step4_if_fn_do.d deleted file mode 100644 index 7a638b8447..0000000000 --- a/d/step4_if_fn_do.d +++ /dev/null @@ -1,173 +0,0 @@ -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_ast(MalType ast, Env env) -{ - if (typeid(ast) == typeid(MalSymbol)) - { - auto sym = verify_cast!MalSymbol(ast); - return env.get(sym); - } - else if (typeid(ast) == typeid(MalList)) - { - auto lst = verify_cast!MalList(ast); - auto el = array(lst.elements.map!(e => EVAL(e, env))); - return new MalList(el); - } - else if (typeid(ast) == typeid(MalVector)) - { - auto lst = verify_cast!MalVector(ast); - auto el = array(lst.elements.map!(e => EVAL(e, env))); - return new MalVector(el); - } - else if (typeid(ast) == typeid(MalHashmap)) - { - auto hm = verify_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 - { - return ast; - } -} - -MalType EVAL(MalType ast, Env env) -{ - MalList ast_list = cast(MalList) ast; - if (ast_list is null) - { - return eval_ast(ast, env); - } - - 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, 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, EVAL(kv[1], let_env)); - } - return EVAL(aste[2], let_env); - - case "do": - auto rest = new MalList(aste[1..$]); - auto el = verify_cast!MalList(eval_ast(rest, env)); - return el.elements[$-1]; - - 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 el = verify_cast!MalList(eval_ast(ast, env)); - if (el.elements.length == 0) - { - throw new Exception("Expected a non-empty list"); - } - auto first = el.elements[0]; - auto rest = el.elements[1..$]; - if (typeid(first) == typeid(MalFunc)) - { - auto funcobj = verify_cast!MalFunc(first); - auto callenv = new Env(funcobj.def_env, funcobj.arg_names, rest); - return EVAL(funcobj.func_body, callenv); - } - else if (typeid(first) == typeid(MalBuiltinFunc)) - { - auto builtinfuncobj = verify_cast!MalBuiltinFunc(first); - return builtinfuncobj.fn(rest); - } - else - { - throw new Exception("Expected a function"); - } - } -} - -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(new MalSymbol(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/d/step5_tco.d b/d/step5_tco.d deleted file mode 100644 index cc39594fe5..0000000000 --- a/d/step5_tco.d +++ /dev/null @@ -1,189 +0,0 @@ -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_ast(MalType ast, Env env) -{ - if (typeid(ast) == typeid(MalSymbol)) - { - auto sym = verify_cast!MalSymbol(ast); - return env.get(sym); - } - else if (typeid(ast) == typeid(MalList)) - { - auto lst = verify_cast!MalList(ast); - auto el = array(lst.elements.map!(e => EVAL(e, env))); - return new MalList(el); - } - else if (typeid(ast) == typeid(MalVector)) - { - auto lst = verify_cast!MalVector(ast); - auto el = array(lst.elements.map!(e => EVAL(e, env))); - return new MalVector(el); - } - else if (typeid(ast) == typeid(MalHashmap)) - { - auto hm = verify_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 - { - return ast; - } -} - -MalType EVAL(MalType ast, Env env) -{ - for (;;) - { - MalList ast_list = cast(MalList) ast; - if (ast_list is null) - { - return eval_ast(ast, env); - } - - 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, 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, EVAL(kv[1], let_env)); - } - ast = aste[2]; - env = let_env; - continue; // TCO - - case "do": - auto all_but_last = new MalList(aste[1..$-1]); - eval_ast(all_but_last, 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 el = verify_cast!MalList(eval_ast(ast, env)); - if (el.elements.length == 0) - { - throw new Exception("Expected a non-empty list"); - } - auto first = el.elements[0]; - auto rest = el.elements[1..$]; - if (typeid(first) == typeid(MalFunc)) - { - auto funcobj = verify_cast!MalFunc(first); - auto callenv = new Env(funcobj.def_env, funcobj.arg_names, rest); - ast = funcobj.func_body; - env = callenv; - continue; // TCO - } - else if (typeid(first) == typeid(MalBuiltinFunc)) - { - auto builtinfuncobj = verify_cast!MalBuiltinFunc(first); - return builtinfuncobj.fn(rest); - } - else - { - throw new Exception("Expected a function"); - } - } - } -} - -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(new MalSymbol(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/d/step6_file.d b/d/step6_file.d deleted file mode 100644 index 8111526f9d..0000000000 --- a/d/step6_file.d +++ /dev/null @@ -1,218 +0,0 @@ -module main; - -import std.algorithm; -import std.array; -import std.range; -import std.stdio; -import std.string; -import std.c.process; -import env; -import mal_core; -import readline; -import reader; -import printer; -import types; - -MalType READ(string str) -{ - return read_str(str); -} - -MalType eval_ast(MalType ast, Env env) -{ - if (typeid(ast) == typeid(MalSymbol)) - { - auto sym = verify_cast!MalSymbol(ast); - return env.get(sym); - } - else if (typeid(ast) == typeid(MalList)) - { - auto lst = verify_cast!MalList(ast); - auto el = array(lst.elements.map!(e => EVAL(e, env))); - return new MalList(el); - } - else if (typeid(ast) == typeid(MalVector)) - { - auto lst = verify_cast!MalVector(ast); - auto el = array(lst.elements.map!(e => EVAL(e, env))); - return new MalVector(el); - } - else if (typeid(ast) == typeid(MalHashmap)) - { - auto hm = verify_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 - { - return ast; - } -} - -MalType EVAL(MalType ast, Env env) -{ - for (;;) - { - MalList ast_list = cast(MalList) ast; - if (ast_list is null) - { - return eval_ast(ast, env); - } - - 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, 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, EVAL(kv[1], let_env)); - } - ast = aste[2]; - env = let_env; - continue; // TCO - - case "do": - auto all_but_last = new MalList(aste[1..$-1]); - eval_ast(all_but_last, 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 el = verify_cast!MalList(eval_ast(ast, env)); - if (el.elements.length == 0) - { - throw new Exception("Expected a non-empty list"); - } - auto first = el.elements[0]; - auto rest = el.elements[1..$]; - if (typeid(first) == typeid(MalFunc)) - { - auto funcobj = verify_cast!MalFunc(first); - auto callenv = new Env(funcobj.def_env, funcobj.arg_names, rest); - ast = funcobj.func_body; - env = callenv; - continue; // TCO - } - else if (typeid(first) == typeid(MalBuiltinFunc)) - { - auto builtinfuncobj = verify_cast!MalBuiltinFunc(first); - return builtinfuncobj.fn(rest); - } - else - { - throw new Exception("Expected a function"); - } - } - } -} - -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(new MalSymbol(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(new MalSymbol("eval"), new MalBuiltinFunc(eval_func, "eval")); - repl_env.set(new MalSymbol("*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) \")\")))))", repl_env); - - if (args.length > 1) - { - try - { - rep("(load-file \"" ~ args[1] ~ "\")", repl_env); - return; - } - catch (Exception e) - { - writeln("Error: ", e.msg); - std.c.process.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/d/step7_quote.d b/d/step7_quote.d deleted file mode 100644 index 0209ef943f..0000000000 --- a/d/step7_quote.d +++ /dev/null @@ -1,257 +0,0 @@ -module main; - -import std.algorithm; -import std.array; -import std.range; -import std.stdio; -import std.string; -import std.c.process; -import env; -import mal_core; -import readline; -import reader; -import printer; -import types; - -bool is_pair(MalType ast) -{ - auto lst = cast(MalSequential) ast; - if (lst is null) return false; - return lst.elements.length > 0; -} - -MalType quasiquote(MalType ast) -{ - if (!is_pair(ast)) - { - return new MalList([sym_quote, ast]); - } - auto ast_seq = verify_cast!MalSequential(ast); - auto aste = ast_seq.elements; - if (aste[0] == sym_unquote) - { - return aste[1]; - } - - if (is_pair(aste[0])) - { - auto ast0_seq = verify_cast!MalSequential(aste[0]); - if (ast0_seq.elements[0] == sym_splice_unquote) - { - return new MalList([new MalSymbol("concat"), ast0_seq.elements[1], quasiquote(new MalList(aste[1..$]))]); - } - } - - return new MalList([new MalSymbol("cons"), quasiquote(aste[0]), quasiquote(new MalList(aste[1..$]))]); -} - -MalType READ(string str) -{ - return read_str(str); -} - -MalType eval_ast(MalType ast, Env env) -{ - if (typeid(ast) == typeid(MalSymbol)) - { - auto sym = verify_cast!MalSymbol(ast); - return env.get(sym); - } - else if (typeid(ast) == typeid(MalList)) - { - auto lst = verify_cast!MalList(ast); - auto el = array(lst.elements.map!(e => EVAL(e, env))); - return new MalList(el); - } - else if (typeid(ast) == typeid(MalVector)) - { - auto lst = verify_cast!MalVector(ast); - auto el = array(lst.elements.map!(e => EVAL(e, env))); - return new MalVector(el); - } - else if (typeid(ast) == typeid(MalHashmap)) - { - auto hm = verify_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 - { - return ast; - } -} - -MalType EVAL(MalType ast, Env env) -{ - for (;;) - { - MalList ast_list = cast(MalList) ast; - if (ast_list is null) - { - return eval_ast(ast, env); - } - - 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, 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, 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": - auto all_but_last = new MalList(aste[1..$-1]); - eval_ast(all_but_last, 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 el = verify_cast!MalList(eval_ast(ast, env)); - if (el.elements.length == 0) - { - throw new Exception("Expected a non-empty list"); - } - auto first = el.elements[0]; - auto rest = el.elements[1..$]; - if (typeid(first) == typeid(MalFunc)) - { - auto funcobj = verify_cast!MalFunc(first); - auto callenv = new Env(funcobj.def_env, funcobj.arg_names, rest); - ast = funcobj.func_body; - env = callenv; - continue; // TCO - } - else if (typeid(first) == typeid(MalBuiltinFunc)) - { - auto builtinfuncobj = verify_cast!MalBuiltinFunc(first); - return builtinfuncobj.fn(rest); - } - else - { - throw new Exception("Expected a function"); - } - } - } -} - -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(new MalSymbol(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(new MalSymbol("eval"), new MalBuiltinFunc(eval_func, "eval")); - repl_env.set(new MalSymbol("*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) \")\")))))", repl_env); - - if (args.length > 1) - { - try - { - rep("(load-file \"" ~ args[1] ~ "\")", repl_env); - return; - } - catch (Exception e) - { - writeln("Error: ", e.msg); - std.c.process.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/d/step8_macros.d b/d/step8_macros.d deleted file mode 100644 index 75ba56fee0..0000000000 --- a/d/step8_macros.d +++ /dev/null @@ -1,303 +0,0 @@ -module main; - -import std.algorithm; -import std.array; -import std.range; -import std.stdio; -import std.string; -import std.c.process; -import env; -import mal_core; -import readline; -import reader; -import printer; -import types; - -bool is_pair(MalType ast) -{ - auto lst = cast(MalSequential) ast; - if (lst is null) return false; - return lst.elements.length > 0; -} - -MalType quasiquote(MalType ast) -{ - if (!is_pair(ast)) - { - return new MalList([sym_quote, ast]); - } - auto ast_seq = verify_cast!MalSequential(ast); - auto aste = ast_seq.elements; - if (aste[0] == sym_unquote) - { - return aste[1]; - } - - if (is_pair(aste[0])) - { - auto ast0_seq = verify_cast!MalSequential(aste[0]); - if (ast0_seq.elements[0] == sym_splice_unquote) - { - return new MalList([new MalSymbol("concat"), ast0_seq.elements[1], quasiquote(new MalList(aste[1..$]))]); - } - } - - return new MalList([new MalSymbol("cons"), quasiquote(aste[0]), quasiquote(new MalList(aste[1..$]))]); -} - -bool is_macro_call(MalType ast, Env env) -{ - auto lst = cast(MalList) ast; - if (lst is null) return false; - if (lst.elements.length == 0) return false; - auto sym0 = cast(MalSymbol) lst.elements[0]; - if (sym0 is null) return false; - if (env.find(sym0) is null) return false; - auto val = env.get(sym0); - auto val_func = cast(MalFunc) val; - if (val_func is null) return false; - return val_func.is_macro; -} - -MalType macroexpand(MalType ast, Env env) -{ - while (is_macro_call(ast, env)) - { - auto ast_list = verify_cast!MalList(ast); - auto sym0 = verify_cast!MalSymbol(ast_list.elements[0]); - auto macrofunc = verify_cast!MalFunc(env.get(sym0)); - auto rest = ast_list.elements[1..$]; - auto callenv = new Env(macrofunc.def_env, macrofunc.arg_names, rest); - ast = EVAL(macrofunc.func_body, callenv); - } - return ast; -} - -MalType READ(string str) -{ - return read_str(str); -} - -MalType eval_ast(MalType ast, Env env) -{ - if (typeid(ast) == typeid(MalSymbol)) - { - auto sym = verify_cast!MalSymbol(ast); - return env.get(sym); - } - else if (typeid(ast) == typeid(MalList)) - { - auto lst = verify_cast!MalList(ast); - auto el = array(lst.elements.map!(e => EVAL(e, env))); - return new MalList(el); - } - else if (typeid(ast) == typeid(MalVector)) - { - auto lst = verify_cast!MalVector(ast); - auto el = array(lst.elements.map!(e => EVAL(e, env))); - return new MalVector(el); - } - else if (typeid(ast) == typeid(MalHashmap)) - { - auto hm = verify_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 - { - return ast; - } -} - -MalType EVAL(MalType ast, Env env) -{ - for (;;) - { - MalList ast_list = cast(MalList) ast; - if (ast_list is null) - { - return eval_ast(ast, env); - } - - ast = macroexpand(ast, env); - ast_list = cast(MalList) ast; - if (ast_list is null) - { - return eval_ast(ast, env); - } - - 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, 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, 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.is_macro = true; - return env.set(a1, mac); - - case "macroexpand": - return macroexpand(aste[1], env); - - case "do": - auto all_but_last = new MalList(aste[1..$-1]); - eval_ast(all_but_last, 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 el = verify_cast!MalList(eval_ast(ast, env)); - if (el.elements.length == 0) - { - throw new Exception("Expected a non-empty list"); - } - auto first = el.elements[0]; - auto rest = el.elements[1..$]; - if (typeid(first) == typeid(MalFunc)) - { - auto funcobj = verify_cast!MalFunc(first); - auto callenv = new Env(funcobj.def_env, funcobj.arg_names, rest); - ast = funcobj.func_body; - env = callenv; - continue; // TCO - } - else if (typeid(first) == typeid(MalBuiltinFunc)) - { - auto builtinfuncobj = verify_cast!MalBuiltinFunc(first); - return builtinfuncobj.fn(rest); - } - else - { - throw new Exception("Expected a function"); - } - } - } -} - -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(new MalSymbol(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(new MalSymbol("eval"), new MalBuiltinFunc(eval_func, "eval")); - repl_env.set(new MalSymbol("*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) \")\")))))", 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); - 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))))))))", repl_env); - - if (args.length > 1) - { - try - { - rep("(load-file \"" ~ args[1] ~ "\")", repl_env); - return; - } - catch (Exception e) - { - writeln("Error: ", e.msg); - std.c.process.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/d/step9_try.d b/d/step9_try.d deleted file mode 100644 index 554831ffeb..0000000000 --- a/d/step9_try.d +++ /dev/null @@ -1,322 +0,0 @@ -module main; - -import std.algorithm; -import std.array; -import std.range; -import std.stdio; -import std.string; -import std.c.process; -import env; -import mal_core; -import readline; -import reader; -import printer; -import types; - -bool is_pair(MalType ast) -{ - auto lst = cast(MalSequential) ast; - if (lst is null) return false; - return lst.elements.length > 0; -} - -MalType quasiquote(MalType ast) -{ - if (!is_pair(ast)) - { - return new MalList([sym_quote, ast]); - } - auto ast_seq = verify_cast!MalSequential(ast); - auto aste = ast_seq.elements; - if (aste[0] == sym_unquote) - { - return aste[1]; - } - - if (is_pair(aste[0])) - { - auto ast0_seq = verify_cast!MalSequential(aste[0]); - if (ast0_seq.elements[0] == sym_splice_unquote) - { - return new MalList([new MalSymbol("concat"), ast0_seq.elements[1], quasiquote(new MalList(aste[1..$]))]); - } - } - - return new MalList([new MalSymbol("cons"), quasiquote(aste[0]), quasiquote(new MalList(aste[1..$]))]); -} - -bool is_macro_call(MalType ast, Env env) -{ - auto lst = cast(MalList) ast; - if (lst is null) return false; - if (lst.elements.length == 0) return false; - auto sym0 = cast(MalSymbol) lst.elements[0]; - if (sym0 is null) return false; - if (env.find(sym0) is null) return false; - auto val = env.get(sym0); - auto val_func = cast(MalFunc) val; - if (val_func is null) return false; - return val_func.is_macro; -} - -MalType macroexpand(MalType ast, Env env) -{ - while (is_macro_call(ast, env)) - { - auto ast_list = verify_cast!MalList(ast); - auto sym0 = verify_cast!MalSymbol(ast_list.elements[0]); - auto macrofunc = verify_cast!MalFunc(env.get(sym0)); - auto rest = ast_list.elements[1..$]; - auto callenv = new Env(macrofunc.def_env, macrofunc.arg_names, rest); - ast = EVAL(macrofunc.func_body, callenv); - } - return ast; -} - -MalType READ(string str) -{ - return read_str(str); -} - -MalType eval_ast(MalType ast, Env env) -{ - if (typeid(ast) == typeid(MalSymbol)) - { - auto sym = verify_cast!MalSymbol(ast); - return env.get(sym); - } - else if (typeid(ast) == typeid(MalList)) - { - auto lst = verify_cast!MalList(ast); - auto el = array(lst.elements.map!(e => EVAL(e, env))); - return new MalList(el); - } - else if (typeid(ast) == typeid(MalVector)) - { - auto lst = verify_cast!MalVector(ast); - auto el = array(lst.elements.map!(e => EVAL(e, env))); - return new MalVector(el); - } - else if (typeid(ast) == typeid(MalHashmap)) - { - auto hm = verify_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 - { - return ast; - } -} - -MalType EVAL(MalType ast, Env env) -{ - for (;;) - { - MalList ast_list = cast(MalList) ast; - if (ast_list is null) - { - return eval_ast(ast, env); - } - - ast = macroexpand(ast, env); - ast_list = cast(MalList) ast; - if (ast_list is null) - { - return eval_ast(ast, env); - } - - 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, 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, 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.is_macro = true; - return env.set(a1, mac); - - case "macroexpand": - return macroexpand(aste[1], env); - - case "try*": - MalType exc; - try - { - return EVAL(aste[1], env); - } - catch (MalException e) - { - exc = e.data; - } - catch (Exception e) - { - exc = new MalString(e.msg); - } - if (aste.length < 3) return mal_nil; - auto catch_clause = verify_cast!MalList(aste[2]); - auto catch_env = new Env(env, [catch_clause.elements[1]], [exc]); - return EVAL(catch_clause.elements[2], catch_env); - - case "do": - auto all_but_last = new MalList(aste[1..$-1]); - eval_ast(all_but_last, 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 el = verify_cast!MalList(eval_ast(ast, env)); - if (el.elements.length == 0) - { - throw new Exception("Expected a non-empty list"); - } - auto first = el.elements[0]; - auto rest = el.elements[1..$]; - if (typeid(first) == typeid(MalFunc)) - { - auto funcobj = verify_cast!MalFunc(first); - auto callenv = new Env(funcobj.def_env, funcobj.arg_names, rest); - ast = funcobj.func_body; - env = callenv; - continue; // TCO - } - else if (typeid(first) == typeid(MalBuiltinFunc)) - { - auto builtinfuncobj = verify_cast!MalBuiltinFunc(first); - return builtinfuncobj.fn(rest); - } - else - { - throw new Exception("Expected a function"); - } - } - } -} - -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(new MalSymbol(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(new MalSymbol("eval"), new MalBuiltinFunc(eval_func, "eval")); - repl_env.set(new MalSymbol("*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) \")\")))))", 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); - 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))))))))", repl_env); - - if (args.length > 1) - { - try - { - rep("(load-file \"" ~ args[1] ~ "\")", repl_env); - return; - } - catch (Exception e) - { - writeln("Error: ", e.msg); - std.c.process.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/d/stepA_mal.d b/d/stepA_mal.d deleted file mode 100644 index f1b42f12a4..0000000000 --- a/d/stepA_mal.d +++ /dev/null @@ -1,326 +0,0 @@ -module main; - -import std.algorithm; -import std.array; -import std.range; -import std.stdio; -import std.string; -import std.c.process; -import env; -import mal_core; -import readline; -import reader; -import printer; -import types; - -bool is_pair(MalType ast) -{ - auto lst = cast(MalSequential) ast; - if (lst is null) return false; - return lst.elements.length > 0; -} - -MalType quasiquote(MalType ast) -{ - if (!is_pair(ast)) - { - return new MalList([sym_quote, ast]); - } - auto ast_seq = verify_cast!MalSequential(ast); - auto aste = ast_seq.elements; - if (aste[0] == sym_unquote) - { - return aste[1]; - } - - if (is_pair(aste[0])) - { - auto ast0_seq = verify_cast!MalSequential(aste[0]); - if (ast0_seq.elements[0] == sym_splice_unquote) - { - return new MalList([new MalSymbol("concat"), ast0_seq.elements[1], quasiquote(new MalList(aste[1..$]))]); - } - } - - return new MalList([new MalSymbol("cons"), quasiquote(aste[0]), quasiquote(new MalList(aste[1..$]))]); -} - -bool is_macro_call(MalType ast, Env env) -{ - auto lst = cast(MalList) ast; - if (lst is null) return false; - if (lst.elements.length == 0) return false; - auto sym0 = cast(MalSymbol) lst.elements[0]; - if (sym0 is null) return false; - if (env.find(sym0) is null) return false; - auto val = env.get(sym0); - auto val_func = cast(MalFunc) val; - if (val_func is null) return false; - return val_func.is_macro; -} - -MalType macroexpand(MalType ast, Env env) -{ - while (is_macro_call(ast, env)) - { - auto ast_list = verify_cast!MalList(ast); - auto sym0 = verify_cast!MalSymbol(ast_list.elements[0]); - auto macrofunc = verify_cast!MalFunc(env.get(sym0)); - auto rest = ast_list.elements[1..$]; - auto callenv = new Env(macrofunc.def_env, macrofunc.arg_names, rest); - ast = EVAL(macrofunc.func_body, callenv); - } - return ast; -} - -MalType READ(string str) -{ - return read_str(str); -} - -MalType eval_ast(MalType ast, Env env) -{ - if (typeid(ast) == typeid(MalSymbol)) - { - auto sym = verify_cast!MalSymbol(ast); - return env.get(sym); - } - else if (typeid(ast) == typeid(MalList)) - { - auto lst = verify_cast!MalList(ast); - auto el = array(lst.elements.map!(e => EVAL(e, env))); - return new MalList(el); - } - else if (typeid(ast) == typeid(MalVector)) - { - auto lst = verify_cast!MalVector(ast); - auto el = array(lst.elements.map!(e => EVAL(e, env))); - return new MalVector(el); - } - else if (typeid(ast) == typeid(MalHashmap)) - { - auto hm = verify_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 - { - return ast; - } -} - -MalType EVAL(MalType ast, Env env) -{ - for (;;) - { - MalList ast_list = cast(MalList) ast; - if (ast_list is null) - { - return eval_ast(ast, env); - } - - ast = macroexpand(ast, env); - ast_list = cast(MalList) ast; - if (ast_list is null) - { - return eval_ast(ast, env); - } - - 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, 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, 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.is_macro = true; - return env.set(a1, mac); - - case "macroexpand": - return macroexpand(aste[1], env); - - case "try*": - MalType exc; - try - { - return EVAL(aste[1], env); - } - catch (MalException e) - { - exc = e.data; - } - catch (Exception e) - { - exc = new MalString(e.msg); - } - if (aste.length < 3) return mal_nil; - auto catch_clause = verify_cast!MalList(aste[2]); - auto catch_env = new Env(env, [catch_clause.elements[1]], [exc]); - return EVAL(catch_clause.elements[2], catch_env); - - case "do": - auto all_but_last = new MalList(aste[1..$-1]); - eval_ast(all_but_last, 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 el = verify_cast!MalList(eval_ast(ast, env)); - if (el.elements.length == 0) - { - throw new Exception("Expected a non-empty list"); - } - auto first = el.elements[0]; - auto rest = el.elements[1..$]; - if (typeid(first) == typeid(MalFunc)) - { - auto funcobj = verify_cast!MalFunc(first); - auto callenv = new Env(funcobj.def_env, funcobj.arg_names, rest); - ast = funcobj.func_body; - env = callenv; - continue; // TCO - } - else if (typeid(first) == typeid(MalBuiltinFunc)) - { - auto builtinfuncobj = verify_cast!MalBuiltinFunc(first); - return builtinfuncobj.fn(rest); - } - else - { - throw new Exception("Expected a function"); - } - } - } -} - -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(new MalSymbol(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(new MalSymbol("eval"), new MalBuiltinFunc(eval_func, "eval")); - repl_env.set(new MalSymbol("*ARGV*"), create_argv_list(args)); - - // core.mal: defined using the language itself - re("(def! *host-language* \"d\")", 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) \")\")))))", 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); - re("(def! *gensym-counter* (atom 0))", repl_env); - re("(def! gensym (fn* [] (symbol (str \"G__\" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))", repl_env); - re("(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)))))))))", repl_env); - - if (args.length > 1) - { - try - { - rep("(load-file \"" ~ args[1] ~ "\")", repl_env); - return; - } - catch (Exception e) - { - writeln("Error: ", e.msg); - std.c.process.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 (Exception e) - { - writeln("Error: ", e.msg); - } - } - writeln(""); -} diff --git a/docs/FAQ.md b/docs/FAQ.md index f292b1bf2c..4cfd83029c 100644 --- a/docs/FAQ.md +++ b/docs/FAQ.md @@ -44,9 +44,8 @@ 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 fairly trivial - reader and printer files (just to modify the Clojure reader/writer - slightly) and a fairly trivial core file +* 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. @@ -101,7 +100,7 @@ functionality goes into which step: 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 implementor and, + 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 @@ -121,18 +120,33 @@ deferrable until later. But I am always open to suggestions. Absolutely! I want mal to have a idiomatic implementation in every programming language. -Here are a few guidelines for getting your implementation accepted -into the main repository: - -* 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" +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 ``` - You do not need to pass the final optional tests for stepA that are - marked as optional and not needed for self-hosting. + 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, @@ -152,20 +166,96 @@ into the main repository: 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 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. In that case - I will add your github username as a suffix to the language - implementation directory. 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. + 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 @@ -173,8 +263,17 @@ into the main repository: 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)? -**Good questions that either don't have answer or need more detail** +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 -### Why do some mal forms end in "\*" or "!" (swap!, def!, let\*, etc)? diff --git a/docs/Hints.md b/docs/Hints.md index d9d44c3519..3686cc833d 100644 --- a/docs/Hints.md +++ b/docs/Hints.md @@ -1,4 +1,4 @@ -# Mal/Make-a-Lisp Implmentation Hints +# Mal/Make-a-Lisp Implementation Hints @@ -81,7 +81,7 @@ 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 arguement to the `main` function (like `argc` and +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 diff --git a/docs/TODO b/docs/TODO index 63df3d1fa5..a9a09d210d 100644 --- a/docs/TODO +++ b/docs/TODO @@ -1,25 +1,45 @@ ---------------------------------------------- - General: - - add chat bot for #mal - - move tokenizer.mal and reader.mal from malc along with - ./examples/{equality,memoize,pprint,protocols}.mal and - ./core.mal to ./lib directory + * 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 - - Finish guide.md + - Fix wasm modes wax and wace_libc -All Implementations: - - regular expression matching in runtest - - add re (use in rep) everywhere and use that (to avoid printing) - - per impl tests for step5_tco, or at least a better way of - enabling/disabling/tweaking per implementation - - fix stepA soft failures: lua matlab miniMAL perl racket + - 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: - - propagate/print errors when self-hosted - - redefine (defmacro!) as (def! (macro*)) + - 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. @@ -37,9 +57,9 @@ Other ideas for All: the namespace environment. Need protocols first probably. - multi-line REPL read - - loop/recur ? + - explicit recur in loops (for error checking) - gensym reader inside quasiquote - - standalone executable + - standalone executables --------------------------------------------- @@ -47,18 +67,15 @@ Other ideas for All: 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/ C#: - accumulates line breaks with mal/clojurewest2014.mal - interop: http://www.ckode.dk/programming/eval-in-c-yes-its-possible/ -Clojure: - - fix "\/" exception in mal/clojurewest2014.mal - CoffeeScript: - make target to compile to JS @@ -72,9 +89,9 @@ Haskell: - 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 @@ -82,19 +99,13 @@ Javascript: 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 - step5_tco -MATLAB: - - Port to support both GNU Octave and MATLAB - miniMAL: - figure out why {} literals are "static"/persistent @@ -102,6 +113,9 @@ 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 - fix extra line breaks at REPL @@ -111,6 +125,14 @@ Postscript: - fix blank line after comments - fix command line arg processing (doesn't run file specified) +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 @@ -124,3 +146,9 @@ Rust: Scala - readline - fix exception when finished running something on command line + +VHDL: + - combine run_vhdl.sh and run + +vimscript: + - combine run_vimscript.sh and run diff --git a/process/cheatsheet.html b/docs/cheatsheet.html similarity index 97% rename from process/cheatsheet.html rename to docs/cheatsheet.html index 6bd042f809..28719052b3 100644 --- a/process/cheatsheet.html +++ b/docs/cheatsheet.html @@ -247,9 +247,6 @@

Make-A-Lisp Cheatsheet

step9_try.EXT: EVAL(ast, env): - set *host-language* in repl_env to host language name - - *gensym-count*: define (using rep()) an atom type containing an integer - - gensym: define using rep(), increment *gensym-count*, return unique symbol - - or: use gensym to fix or macro 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

+ + + +
+
+
+
+ +

 

+
+ + +
+ +
+

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/elisp/Dockerfile b/elisp/Dockerfile deleted file mode 100644 index 1eefd6c0c8..0000000000 --- a/elisp/Dockerfile +++ /dev/null @@ -1,26 +0,0 @@ -FROM ubuntu:wily -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 -########################################################## - -# Emacs 24 -RUN apt-get -y install emacs24-nox - diff --git a/elisp/Makefile b/elisp/Makefile deleted file mode 100644 index 21b02aaded..0000000000 --- a/elisp/Makefile +++ /dev/null @@ -1,17 +0,0 @@ -SOURCES_BASE = reader.el printer.el types.el -SOURCES_LISP = env.el func.el core.el stepA_mal.el -SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) - -all: - -clean: - -.PHONY: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*;|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*;|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" - diff --git a/elisp/core.el b/elisp/core.el deleted file mode 100644 index 28b8e85d12..0000000000 --- a/elisp/core.el +++ /dev/null @@ -1,251 +0,0 @@ -(defun mal-seq-p (mal-object) - (let ((type (mal-type mal-object))) - (if (or (eq type 'list) (eq type 'vector)) - mal-true - mal-false))) - -(defun mal-listify (mal-object) - (let ((type (mal-type mal-object))) - (if (eq type 'vector) - (append (mal-value mal-object) nil) - (mal-value mal-object)))) - -(defun mal-= (a b) - (let ((a-type (mal-type a)) - (b-type (mal-type b))) - (cond - ((and (and (not (eq a-type 'map)) - (not (eq a-type 'list)) - (not (eq a-type 'vector))) - (and (not (eq b-type 'map)) - (not (eq b-type 'list)) - (not (eq b-type 'vector)))) - (mal-atom-= a b)) - ((and (or (eq a-type 'list) (eq a-type 'vector)) - (or (eq b-type 'list) (eq b-type 'vector))) - (mal-seq-= a b)) - ((and (eq a-type 'map) (eq b-type 'map)) - (mal-map-= a b)) - (t - ;; incompatible types - nil)))) - -(defun mal-atom-= (a b) - (equal (mal-value a) (mal-value b))) - -(defun mal-seq-= (a b) - (when (= (length (mal-value a)) - (length (mal-value b))) - (when (everyp 'mal-= (mal-listify a) (mal-listify b)) - t))) - -(defun everyp (predicate list-a list-b) - (let ((everyp t)) - (while (and everyp list-a list-b) - (let ((item-a (pop list-a)) - (item-b (pop list-b))) - (when (not (funcall predicate item-a item-b)) - (setq everyp nil)))) - everyp)) - -(defun mal-map-= (a b) - (catch 'return - (let ((a* (mal-value a)) - (b* (mal-value b))) - (when (= (hash-table-count a*) - (hash-table-count b*)) - (maphash (lambda (key a-value) - (let ((b-value (gethash key b*))) - (if b-value - (when (not (mal-= a-value b-value)) - (throw 'return nil)) - (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 ((type (mal-type seq)) - (value (mal-value seq))) - (if (eq type 'vector) - (mal-vector (vconcat (append (append value nil) args))) - (while args - (push (pop args) value)) - (mal-list value)))) - -(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 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))))) - -(defvar core-ns - `((+ . ,(mal-fn (lambda (a b) (mal-number (+ (mal-value a) (mal-value b)))))) - (- . ,(mal-fn (lambda (a b) (mal-number (- (mal-value a) (mal-value b)))))) - (* . ,(mal-fn (lambda (a b) (mal-number (* (mal-value a) (mal-value b)))))) - (/ . ,(mal-fn (lambda (a b) (mal-number (/ (mal-value a) (mal-value b)))))) - - (< . ,(mal-fn (lambda (a b) (if (< (mal-value a) (mal-value b)) mal-true mal-false)))) - (<= . ,(mal-fn (lambda (a b) (if (<= (mal-value a) (mal-value b)) mal-true mal-false)))) - (> . ,(mal-fn (lambda (a b) (if (> (mal-value a) (mal-value b)) mal-true mal-false)))) - (>= . ,(mal-fn (lambda (a b) (if (>= (mal-value a) (mal-value b)) mal-true mal-false)))) - - (= . ,(mal-fn (lambda (a b) (if (mal-= a b) mal-true mal-false)))) - - (list . ,(mal-fn (lambda (&rest args) (mal-list args)))) - (list? . ,(mal-fn (lambda (mal-object) (if (mal-list-p mal-object) mal-true mal-false)))) - (empty? . ,(mal-fn (lambda (seq) (if (zerop (length (mal-value seq))) mal-true mal-false)))) - (count . ,(mal-fn (lambda (seq) (mal-number (if (mal-seq-p seq) (length (mal-value seq)) 0))))) - - (pr-str . ,(mal-fn (lambda (&rest args) (mal-string (mapconcat (lambda (item) (pr-str item t)) args " "))))) - (str . ,(mal-fn (lambda (&rest args) (mal-string (mapconcat 'pr-str args ""))))) - (prn . ,(mal-fn (lambda (&rest args) (println (mapconcat (lambda (item) (pr-str item t)) args " ")) mal-nil))) - (println . ,(mal-fn (lambda (&rest args) (println (mapconcat 'pr-str args " ")) mal-nil))) - - (read-string . ,(mal-fn (lambda (input) (read-str (mal-value input))))) - (slurp . ,(mal-fn (lambda (file) - (with-temp-buffer - (insert-file-contents-literally (mal-value file)) - (mal-string (buffer-string)))))) - - (atom . ,(mal-fn (lambda (arg) (mal-atom arg)))) - (atom? . ,(mal-fn (lambda (mal-object) (if (mal-atom-p mal-object) mal-true mal-false)))) - (deref . ,(mal-fn (lambda (atom) (mal-value atom)))) - (reset! . ,(mal-fn (lambda (atom value) (setf (aref atom 1) value)))) - (swap! . ,(mal-fn (lambda (atom fn &rest args) - (let* ((fn* (if (mal-func-p fn) (mal-func-fn fn) fn)) - (args* (cons (mal-value atom) args)) - (value (apply (mal-value fn*) args*))) - (setf (aref atom 1) value))))) - - (cons . ,(mal-fn (lambda (arg list) (mal-list (cons arg (mal-listify list)))))) - (concat . ,(mal-fn (lambda (&rest lists) - (let ((lists* (mapcar (lambda (item) (mal-listify item)) lists))) - (mal-list (apply 'append lists*)))))) - - (nth . ,(mal-fn (lambda (seq index) - (let ((i (mal-value index)) - (list (mal-listify seq))) - (or (nth i list) - (error "Args out of range: %s, %d" (pr-str seq) i)))))) - (first . ,(mal-fn (lambda (seq) - (if (mal-nil-p seq) - mal-nil - (let* ((list (mal-listify seq)) - (value (car list))) - (or value mal-nil)))))) - (rest . ,(mal-fn (lambda (seq) (mal-list (cdr (mal-listify seq)))))) - - (throw . ,(mal-fn (lambda (mal-object) (signal 'mal-custom (list mal-object))))) - - (apply . ,(mal-fn (lambda (fn &rest args) - (let* ((butlast (butlast args)) - (last (mal-listify (car (last args)))) - (fn* (if (mal-func-p fn) (mal-func-fn fn) fn)) - (args* (append butlast last))) - (apply (mal-value fn*) args*))))) - (map . ,(mal-fn (lambda (fn seq) - (let ((fn* (if (mal-func-p fn) (mal-func-fn fn) fn))) - (mal-list (mapcar (mal-value fn*) (mal-value seq))))))) - - (nil? . ,(mal-fn (lambda (arg) (if (mal-nil-p arg) mal-true mal-false)))) - (true? . ,(mal-fn (lambda (arg) (if (mal-true-p arg) mal-true mal-false)))) - (false? . ,(mal-fn (lambda (arg) (if (mal-false-p arg) mal-true mal-false)))) - - (symbol? . ,(mal-fn (lambda (arg) (if (mal-symbol-p arg) mal-true mal-false)))) - (keyword? . ,(mal-fn (lambda (arg) (if (mal-keyword-p arg) mal-true mal-false)))) - (string? . ,(mal-fn (lambda (arg) (if (mal-string-p arg) mal-true mal-false)))) - (vector? . ,(mal-fn (lambda (arg) (if (mal-vector-p arg) mal-true mal-false)))) - (map? . ,(mal-fn (lambda (arg) (if (mal-map-p arg) mal-true mal-false)))) - - (symbol . ,(mal-fn (lambda (string) (mal-symbol (intern (mal-value string)))))) - (keyword . ,(mal-fn (lambda (string) (mal-keyword (intern (concat ":" (mal-value string))))))) - (vector . ,(mal-fn (lambda (&rest args) (mal-vector (vconcat args))))) - (hash-map . ,(mal-fn (lambda (&rest args) - (let ((map (make-hash-table :test 'mal-=))) - (while args - (puthash (pop args) (pop args) map)) - (mal-map map))))) - - (sequential? . ,(mal-fn 'mal-seq-p)) - - (get . ,(mal-fn (lambda (map key) (if (mal-map-p map) (or (gethash key (mal-value map)) mal-nil) mal-nil)))) - (contains? . ,(mal-fn (lambda (map key) (if (gethash key (mal-value map)) mal-true mal-false)))) - (assoc . ,(mal-fn (lambda (map &rest args) - (let ((map* (copy-hash-table (mal-value map)))) - (while args - (puthash (pop args) (pop args) map*)) - (mal-map map*))))) - (dissoc . ,(mal-fn (lambda (map &rest args) - (let ((map* (copy-hash-table (mal-value map)))) - (while args - (remhash (pop args) map*)) - (mal-map map*))))) - (keys . ,(mal-fn (lambda (map) (let (keys) - (maphash (lambda (key value) (push key keys)) - (mal-value map)) - (mal-list keys))))) - (vals . ,(mal-fn (lambda (map) (let (vals) - (maphash (lambda (key value) (push value vals)) - (mal-value map)) - (mal-list vals))))) - - (readline . ,(mal-fn (lambda (prompt) - (let ((ret (readln (mal-value prompt)))) - (if ret - (mal-string ret) - mal-nil))))) - - (meta . ,(mal-fn (lambda (mal-object) (or (mal-meta mal-object) mal-nil)))) - (with-meta . ,(mal-fn (lambda (mal-object meta) - ;; TODO: doesn't work on hashtables - (let ((mal-object* (copy-tree mal-object t))) - (setf (aref mal-object* 2) meta) - mal-object*)))) - - (time-ms . ,(mal-fn (lambda () (mal-number (floor (* (float-time) 1000)))))) - - (conj . ,(mal-fn 'mal-conj)) - (seq . ,(mal-fn (lambda (mal-object) - (let ((type (mal-type mal-object)) - (value (mal-value mal-object))) - (cond - ((or (eq type 'list) (eq type 'vector)) - (if (and value (not (zerop (length value)))) - (mal-list (mal-listify mal-object)) - mal-nil)) - ((eq type 'string) - (if (not (zerop (length value))) - (mal-list (mapcar (lambda (item) (mal-string (char-to-string item))) - (append value nil))) - mal-nil)) - (t - mal-nil)))))) - - (elisp-eval . ,(mal-fn (lambda (string) (elisp-to-mal (eval (read (mal-value string))))))) - )) diff --git a/elisp/env.el b/elisp/env.el deleted file mode 100644 index 2712dbccf6..0000000000 --- a/elisp/env.el +++ /dev/null @@ -1,32 +0,0 @@ -(defun mal-env (&optional outer binds exprs) - (let ((env (vector 'env (vector (make-hash-table :test 'eq) outer)))) - (while binds - (let ((key (pop binds))) - (if (eq key '&) - (let ((key (pop binds)) - (value (mal-list exprs))) - (mal-env-set env key value) - (setq binds nil - exprs nil)) - (let ((value (pop exprs))) - (mal-env-set env key value))))) - env)) - -(defun mal-env-set (env key value) - (let ((data (aref (aref env 1) 0))) - (puthash key value data))) - -(defun mal-env-find (env key) - (let* ((data (aref (aref env 1) 0)) - (value (gethash key data))) - (if (not value) - (let ((outer (aref (aref env 1) 1))) - (when outer - (mal-env-find outer key))) - value))) - -(defun mal-env-get (env key) - (let ((value (mal-env-find env key))) - (if (not value) - (error "'%s' not found" key) - value))) diff --git a/elisp/func.el b/elisp/func.el deleted file mode 100644 index a7bc2207f0..0000000000 --- a/elisp/func.el +++ /dev/null @@ -1,17 +0,0 @@ -(defun mal-func (ast params env fn &optional macrop meta) - (vector 'func (vector ast params env fn macrop) meta)) - -(defun mal-func-ast (mal-func) - (aref (aref mal-func 1) 0)) - -(defun mal-func-params (mal-func) - (aref (aref mal-func 1) 1)) - -(defun mal-func-env (mal-func) - (aref (aref mal-func 1) 2)) - -(defun mal-func-fn (mal-func) - (aref (aref mal-func 1) 3)) - -(defun mal-func-macro-p (mal-func) - (aref (aref mal-func 1) 4)) diff --git a/elisp/printer.el b/elisp/printer.el deleted file mode 100644 index f00efa799c..0000000000 --- a/elisp/printer.el +++ /dev/null @@ -1,56 +0,0 @@ -(defun pr-str (form &optional print-readably) - (let ((type (mal-type form)) - (value (mal-value form))) - (cond - ((eq type 'nil) - "nil") - ((eq type 'true) - "true") - ((eq type 'false) - "false") - ((eq type 'number) - (number-to-string (mal-value form))) - ((eq type 'string) - (if print-readably - ;; HACK prin1-to-string does only quotes and backslashes - (replace-regexp-in-string "\n" "\\\\n" (prin1-to-string value)) - value)) - ((or (eq type 'symbol) (eq type 'keyword)) - (symbol-name value)) - ((eq type 'list) - (pr-list value print-readably)) - ((eq type 'vector) - (pr-vector value print-readably)) - ((eq type 'map) - (pr-map value print-readably)) - ((eq type 'fn) - "#") - ((eq type 'func) - "#") - ((eq type 'atom) - (format "(atom %s)" (mal-value value)))))) - -(defun pr-list (form print-readably) - (let ((items (mapconcat - (lambda (item) (pr-str item print-readably)) - form " "))) - (concat "(" items ")"))) - -(defun pr-vector (form print-readably) - (let ((items (mapconcat - (lambda (item) (pr-str item print-readably)) - (append form nil) " "))) - (concat "[" items "]"))) - -(defun pr-map (form print-readably) - (let (pairs) - (maphash - (lambda (key value) - (push (cons (pr-str key print-readably) - (pr-str value print-readably)) - pairs)) - form) - (let ((items (mapconcat - (lambda (item) (concat (car item) " " (cdr item))) - (nreverse pairs) " "))) - (concat "{" items "}")))) diff --git a/elisp/run b/elisp/run deleted file mode 100755 index 84a936e50c..0000000000 --- a/elisp/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec emacs -Q --batch --load $(dirname $0)/${STEP:-stepA_mal}.el "${@}" diff --git a/elisp/step0_repl.el b/elisp/step0_repl.el deleted file mode 100644 index 49bc0a78d9..0000000000 --- a/elisp/step0_repl.el +++ /dev/null @@ -1,30 +0,0 @@ -(defun READ (input) - input) - -(defun EVAL (input) - input) - -(defun PRINT (input) - input) - -(defun readln (prompt) - ;; C-d throws an error - (ignore-errors (read-from-minibuffer prompt))) - -(defun println (format-string &rest args) - (if (not args) - (princ format-string) - (princ (apply 'format format-string args))) - (terpri)) - -(defun main () - (let (eof) - (while (not eof) - (let ((input (readln "user> "))) - (if input - (println input) - (setq eof t) - ;; print final newline - (terpri)))))) - -(main) diff --git a/elisp/step1_read_print.el b/elisp/step1_read_print.el deleted file mode 100644 index af3ff7b09c..0000000000 --- a/elisp/step1_read_print.el +++ /dev/null @@ -1,58 +0,0 @@ -(defun load-relative (file) - (let* ((current-file (or load-file-name buffer-file-name)) - (current-file-directory (file-name-directory current-file))) - (load (expand-file-name file current-file-directory) nil t))) - -(load-relative "types.el") -(load-relative "reader.el") -(load-relative "printer.el") - -(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) - (if (not args) - (princ format-string) - (princ (apply 'format format-string args))) - (terpri)) - -(defun main () - (let (eof) - (while (not eof) - (let ((input (readln "user> "))) - (if input - (condition-case err - (println (rep input)) - (end-of-token-stream - ;; empty input, carry on - ) - (unterminated-sequence - (let* ((type (cadr err)) - (end - (cond - ((eq type 'string) ?\") - ((eq type 'list) ?\)) - ((eq type 'vector) ?\]) - ((eq type 'map) ?})))) - (princ (format "Expected '%c', got EOF\n" end)))) - (error ; catch-all - (println (error-message-string err)) - (backtrace))) - (setq eof t) - ;; print final newline - (terpri)))))) - -(main) diff --git a/elisp/step2_eval.el b/elisp/step2_eval.el deleted file mode 100644 index b5f07234cc..0000000000 --- a/elisp/step2_eval.el +++ /dev/null @@ -1,90 +0,0 @@ -(defun load-relative (file) - (let* ((current-file (or load-file-name buffer-file-name)) - (current-file-directory (file-name-directory current-file))) - (load (expand-file-name file current-file-directory) nil t))) - -(load-relative "types.el") -(load-relative "reader.el") -(load-relative "printer.el") - -(defvar repl-env (make-hash-table :test 'eq)) -(puthash '+ (lambda (a b) (mal-number (+ (mal-value a) (mal-value b)))) repl-env) -(puthash '- (lambda (a b) (mal-number (- (mal-value a) (mal-value b)))) repl-env) -(puthash '* (lambda (a b) (mal-number (* (mal-value a) (mal-value b)))) repl-env) -(puthash '/ (lambda (a b) (mal-number (/ (mal-value a) (mal-value b)))) repl-env) - -(defun READ (input) - (read-str input)) - -(defun EVAL (ast env) - (if (and (mal-list-p ast) (mal-value ast)) - (let* ((ast* (mal-value (eval-ast ast env))) - (fn (car ast*)) - (args (cdr ast*))) - (apply fn args)) - (eval-ast ast env))) - -(defun eval-ast (ast env) - (let ((type (mal-type ast)) - (value (mal-value ast))) - (cond - ((eq type 'symbol) - (let ((definition (gethash value env))) - (or definition (error "Definition not found")))) - ((eq type 'list) - (mal-list (mapcar (lambda (item) (EVAL item env)) value))) - ((eq type 'vector) - (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) - ((eq type 'map) - (let ((map (copy-hash-table value))) - (maphash (lambda (key value) - (puthash key (EVAL value env) map)) - map) - (mal-map map))) - (t - ;; return as is - ast)))) - -(defun PRINT (input) - (pr-str input t)) - -(defun rep (input) - (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) - (if (not args) - (princ format-string) - (princ (apply 'format format-string args))) - (terpri)) - -(defun main () - (let (eof) - (while (not eof) - (let ((input (readln "user> "))) - (if input - (condition-case err - (println (rep input)) - (end-of-token-stream - ;; empty input, carry on - ) - (unterminated-sequence - (let* ((type (cadr err)) - (end - (cond - ((eq type 'string) ?\") - ((eq type 'list) ?\)) - ((eq type 'vector) ?\]) - ((eq type 'map) ?})))) - (princ (format "Expected '%c', got EOF\n" end)))) - (error ; catch-all - (println (error-message-string err)) - (backtrace))) - (setq eof t) - ;; print final newline - (terpri)))))) - -(main) diff --git a/elisp/step3_env.el b/elisp/step3_env.el deleted file mode 100644 index 1544b1fbfb..0000000000 --- a/elisp/step3_env.el +++ /dev/null @@ -1,112 +0,0 @@ -(defun load-relative (file) - (let* ((current-file (or load-file-name buffer-file-name)) - (current-file-directory (file-name-directory current-file))) - (load (expand-file-name file current-file-directory) nil t))) - -(load-relative "types.el") -(load-relative "env.el") -(load-relative "reader.el") -(load-relative "printer.el") - -(defvar repl-env (mal-env)) -(mal-env-set repl-env '+ (lambda (a b) (mal-number (+ (mal-value a) (mal-value b))))) -(mal-env-set repl-env '- (lambda (a b) (mal-number (- (mal-value a) (mal-value b))))) -(mal-env-set repl-env '* (lambda (a b) (mal-number (* (mal-value a) (mal-value b))))) -(mal-env-set repl-env '/ (lambda (a b) (mal-number (/ (mal-value a) (mal-value b))))) - -(defun READ (input) - (read-str input)) - -(defun EVAL (ast env) - (if (and (mal-list-p ast) (mal-value ast)) - (let* ((a (mal-value ast)) - (a0 (car a)) - (a0* (mal-value a0)) - (a1 (cadr a)) - (a1* (mal-value a1)) - (a2 (nth 2 a))) - (cond - ((eq a0* 'def!) - (let ((identifier a1*) - (value (EVAL a2 env))) - (mal-env-set env identifier value))) - ((eq a0* 'let*) - (let ((env* (mal-env env)) - (bindings (if (vectorp a1*) (append a1* nil) a1*)) - (form a2)) - (while bindings - (let ((key (mal-value (pop bindings))) - (value (EVAL (pop bindings) env*))) - (mal-env-set env* key value))) - (EVAL form env*))) - (t - ;; not a special form - (let* ((ast* (mal-value (eval-ast ast env))) - (fn (car ast*)) - (args (cdr ast*))) - (apply fn args))))) - (eval-ast ast env))) - -(defun eval-ast (ast env) - (let ((type (mal-type ast)) - (value (mal-value ast))) - (cond - ((eq type 'symbol) - (let ((definition (mal-env-get env value))) - (or definition (error "Definition not found")))) - ((eq type 'list) - (mal-list (mapcar (lambda (item) (EVAL item env)) value))) - ((eq type 'vector) - (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) - ((eq type 'map) - (let ((map (copy-hash-table value))) - (maphash (lambda (key value) - (puthash key (EVAL value env) map)) - map) - (mal-map map))) - (t - ;; return as is - ast)))) - -(defun PRINT (input) - (pr-str input t)) - -(defun rep (input) - (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) - (if (not args) - (princ format-string) - (princ (apply 'format format-string args))) - (terpri)) - -(defun main () - (let (eof) - (while (not eof) - (let ((input (readln "user> "))) - (if input - (condition-case err - (println (rep input)) - (end-of-token-stream - ;; empty input, carry on - ) - (unterminated-sequence - (let* ((type (cadr err)) - (end - (cond - ((eq type 'string) ?\") - ((eq type 'list) ?\)) - ((eq type 'vector) ?\]) - ((eq type 'map) ?})))) - (princ (format "Expected '%c', got EOF\n" end)))) - (error ; catch-all - (println (error-message-string err)))) - (setq eof t) - ;; print final newline - (terpri)))))) - -(main) diff --git a/elisp/step4_if_fn_do.el b/elisp/step4_if_fn_do.el deleted file mode 100644 index 4eb141b2fe..0000000000 --- a/elisp/step4_if_fn_do.el +++ /dev/null @@ -1,144 +0,0 @@ -;; -*- lexical-binding: t; -*- - -(defun load-relative (file) - (let* ((current-file (or load-file-name buffer-file-name)) - (current-file-directory (file-name-directory current-file))) - (load (expand-file-name file current-file-directory) nil t))) - -(load-relative "types.el") -(load-relative "env.el") -(load-relative "reader.el") -(load-relative "printer.el") -(load-relative "core.el") - -(defvar repl-env (mal-env)) - -(dolist (binding core-ns) - (let ((symbol (car binding)) - (fn (cdr binding))) - (mal-env-set repl-env symbol fn))) - -(defun READ (input) - (read-str input)) - -(defun EVAL (ast env) - (if (and (mal-list-p ast) (mal-value ast)) - (let* ((a (mal-value ast)) - (a0 (car a)) - (a0* (mal-value a0)) - (a1 (cadr a)) - (a2 (nth 2 a)) - (a3 (nth 3 a))) - (cond - ((eq a0* 'def!) - (let ((identifier (mal-value a1)) - (value (EVAL a2 env))) - (mal-env-set env identifier value))) - ((eq a0* 'let*) - (let* ((env* (mal-env env)) - (a1* (mal-value a1)) - (bindings (if (vectorp a1*) (append a1* nil) a1*)) - (form a2)) - (while bindings - (let ((key (mal-value (pop bindings))) - (value (EVAL (pop bindings) env*))) - (mal-env-set env* key value))) - (EVAL form env*))) - ((eq a0* 'do) - (car (last (mal-value (eval-ast (mal-list (cdr a)) env))))) - ((eq a0* 'if) - (let* ((condition (EVAL a1 env)) - (condition-type (mal-type condition)) - (then a2) - (else a3)) - (if (and (not (eq condition-type 'false)) - (not (eq condition-type 'nil))) - (EVAL then env) - (if else - (EVAL else env) - mal-nil)))) - ((eq a0* 'fn*) - (let ((binds (mapcar 'mal-value (mal-value a1))) - (body a2)) - (mal-fn - (lambda (&rest args) - (let ((env* (mal-env env binds args))) - (EVAL body env*)))))) - (t - ;; not a special form - (let* ((ast* (mal-value (eval-ast ast env))) - (fn (car ast*)) - (fn* (cond - ((functionp fn) - fn) - ((mal-fn-p fn) - (mal-value fn)))) - (args (cdr ast*))) - (apply fn* args))))) - (eval-ast ast env))) - -(defun eval-ast (ast env) - (let ((type (mal-type ast)) - (value (mal-value ast))) - (cond - ((eq type 'symbol) - (let ((definition (mal-env-get env value))) - (or definition (error "Definition not found")))) - ((eq type 'list) - (mal-list (mapcar (lambda (item) (EVAL item env)) value))) - ((eq type 'vector) - (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) - ((eq type 'map) - (let ((map (copy-hash-table value))) - (maphash (lambda (key value) - (puthash key (EVAL value env) map)) - map) - (mal-map map))) - (t - ;; return as is - ast)))) - -(defun PRINT (input) - (pr-str input t)) - -(defun rep (input) - (PRINT (EVAL (READ input) repl-env))) - -(rep "(def! not (fn* (a) (if a false true)))") - -(defun readln (prompt) - ;; C-d throws an error - (ignore-errors (read-from-minibuffer prompt))) - -(defun println (format-string &rest args) - (if (not args) - (princ format-string) - (princ (apply 'format format-string args))) - (terpri)) - -(defun main () - (let (eof) - (while (not eof) - (let ((input (readln "user> "))) - (if input - (condition-case err - (println (rep input)) - (end-of-token-stream - ;; empty input, carry on - ) - (unterminated-sequence - (let* ((type (cadr err)) - (end - (cond - ((eq type 'string) ?\") - ((eq type 'list) ?\)) - ((eq type 'vector) ?\]) - ((eq type 'map) ?})))) - (princ (format "Expected '%c', got EOF\n" end)))) - (error ; catch-all - (println (error-message-string err)))) - (setq eof t) - ;; print final newline - (terpri)))))) - -(main) diff --git a/elisp/step5_tco.el b/elisp/step5_tco.el deleted file mode 100644 index 86babe8df8..0000000000 --- a/elisp/step5_tco.el +++ /dev/null @@ -1,161 +0,0 @@ -;; -*- lexical-binding: t; -*- - -(defun load-relative (file) - (let* ((current-file (or load-file-name buffer-file-name)) - (current-file-directory (file-name-directory current-file))) - (load (expand-file-name file current-file-directory) nil t))) - -(load-relative "types.el") -(load-relative "env.el") -(load-relative "func.el") -(load-relative "reader.el") -(load-relative "printer.el") -(load-relative "core.el") - -(defvar repl-env (mal-env)) - -(dolist (binding core-ns) - (let ((symbol (car binding)) - (fn (cdr binding))) - (mal-env-set repl-env symbol fn))) - -(defun READ (input) - (read-str input)) - -(defun EVAL (ast env) - (catch 'return - (while t - (if (and (mal-list-p ast) (mal-value ast)) - (let* ((a (mal-value ast)) - (a0 (car a)) - (a0* (mal-value a0)) - (a1 (cadr a)) - (a2 (nth 2 a)) - (a3 (nth 3 a))) - (cond - ((eq a0* 'def!) - (let ((identifier (mal-value a1)) - (value (EVAL a2 env))) - (throw 'return (mal-env-set env identifier value)))) - ((eq a0* 'let*) - (let* ((env* (mal-env env)) - (bindings (mal-value a1)) - (form a2)) - (when (vectorp bindings) - (setq bindings (append bindings nil))) - (while bindings - (let ((key (mal-value (pop bindings))) - (value (EVAL (pop bindings) env*))) - (mal-env-set env* key value))) - (setq env env* - ast form))) ; TCO - ((eq a0* 'do) - (let* ((a0... (cdr a)) - (butlast (butlast a0...)) - (last (car (last a0...)))) - (when butlast - (eval-ast (mal-list butlast) env)) - (setq ast last))) ; TCO - ((eq a0* 'if) - (let* ((condition (EVAL a1 env)) - (condition-type (mal-type condition)) - (then a2) - (else a3)) - (if (and (not (eq condition-type 'false)) - (not (eq condition-type 'nil))) - (setq ast then) ; TCO - (if else - (setq ast else) ; TCO - (throw 'return mal-nil))))) - ((eq a0* 'fn*) - (let* ((binds (mapcar 'mal-value (mal-value a1))) - (body a2) - (fn (mal-fn - (lambda (&rest args) - (let ((env* (mal-env env binds args))) - (EVAL body env*)))))) - (throw 'return (mal-func body binds env fn)))) - (t - ;; not a special form - (let* ((ast* (mal-value (eval-ast ast env))) - (fn (car ast*)) - (args (cdr ast*))) - (if (mal-func-p fn) - (let ((env* (mal-env (mal-func-env fn) - (mal-func-params fn) - args))) - (setq env env* - ast (mal-func-ast fn))) ; TCO - (let ((fn* (if (mal-fn-p fn) - ;; unbox user-defined function - (mal-value fn) - ;; use built-in function - fn))) - (throw 'return (apply fn* args)))))))) - (throw 'return (eval-ast ast env)))))) - -(defun eval-ast (ast env) - (let ((type (mal-type ast)) - (value (mal-value ast))) - (cond - ((eq type 'symbol) - (let ((definition (mal-env-get env value))) - (or definition (error "Definition not found")))) - ((eq type 'list) - (mal-list (mapcar (lambda (item) (EVAL item env)) value))) - ((eq type 'vector) - (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) - ((eq type 'map) - (let ((map (copy-hash-table value))) - (maphash (lambda (key value) - (puthash key (EVAL value env) map)) - map) - (mal-map map))) - (t - ;; return as is - ast)))) - -(defun PRINT (input) - (pr-str input t)) - -(defun rep (input) - (PRINT (EVAL (READ input) repl-env))) - -(rep "(def! not (fn* (a) (if a false true)))") - -(defun readln (prompt) - ;; C-d throws an error - (ignore-errors (read-from-minibuffer prompt))) - -(defun println (format-string &rest args) - (if (not args) - (princ format-string) - (princ (apply 'format format-string args))) - (terpri)) - -(defun main () - (let (eof) - (while (not eof) - (let ((input (readln "user> "))) - (if input - (condition-case err - (println (rep input)) - (end-of-token-stream - ;; empty input, carry on - ) - (unterminated-sequence - (let* ((type (cadr err)) - (end - (cond - ((eq type 'string) ?\") - ((eq type 'list) ?\)) - ((eq type 'vector) ?\]) - ((eq type 'map) ?})))) - (princ (format "Expected '%c', got EOF\n" end)))) - (error ; catch-all - (println (error-message-string err)))) - (setq eof t) - ;; print final newline - (terpri)))))) - -(main) diff --git a/elisp/step6_file.el b/elisp/step6_file.el deleted file mode 100644 index ba363d4846..0000000000 --- a/elisp/step6_file.el +++ /dev/null @@ -1,169 +0,0 @@ -;; -*- lexical-binding: t; -*- - -(defun load-relative (file) - (let* ((current-file (or load-file-name buffer-file-name)) - (current-file-directory (file-name-directory current-file))) - (load (expand-file-name file current-file-directory) nil t))) - -(load-relative "types.el") -(load-relative "env.el") -(load-relative "func.el") -(load-relative "reader.el") -(load-relative "printer.el") -(load-relative "core.el") - -(defvar repl-env (mal-env)) - -(dolist (binding core-ns) - (let ((symbol (car binding)) - (fn (cdr binding))) - (mal-env-set repl-env symbol fn))) - -(defun READ (input) - (read-str input)) - -(defun EVAL (ast env) - (catch 'return - (while t - (if (and (mal-list-p ast) (mal-value ast)) - (let* ((a (mal-value ast)) - (a0 (car a)) - (a0* (mal-value a0)) - (a1 (cadr a)) - (a2 (nth 2 a)) - (a3 (nth 3 a))) - (cond - ((eq a0* 'def!) - (let ((identifier (mal-value a1)) - (value (EVAL a2 env))) - (throw 'return (mal-env-set env identifier value)))) - ((eq a0* 'let*) - (let* ((env* (mal-env env)) - (bindings (mal-value a1)) - (form a2)) - (when (vectorp bindings) - (setq bindings (append bindings nil))) - (while bindings - (let ((key (mal-value (pop bindings))) - (value (EVAL (pop bindings) env*))) - (mal-env-set env* key value))) - (setq env env* - ast form))) ; TCO - ((eq a0* 'do) - (let* ((a0... (cdr a)) - (butlast (butlast a0...)) - (last (car (last a0...)))) - (when butlast - (eval-ast (mal-list butlast) env)) - (setq ast last))) ; TCO - ((eq a0* 'if) - (let* ((condition (EVAL a1 env)) - (condition-type (mal-type condition)) - (then a2) - (else a3)) - (if (and (not (eq condition-type 'false)) - (not (eq condition-type 'nil))) - (setq ast then) ; TCO - (if else - (setq ast else) ; TCO - (throw 'return mal-nil))))) - ((eq a0* 'fn*) - (let* ((binds (mapcar 'mal-value (mal-value a1))) - (body a2) - (fn (mal-fn - (lambda (&rest args) - (let ((env* (mal-env env binds args))) - (EVAL body env*)))))) - (throw 'return (mal-func body binds env fn)))) - (t - ;; not a special form - (let* ((ast* (mal-value (eval-ast ast env))) - (fn (car ast*)) - (args (cdr ast*))) - (if (mal-func-p fn) - (let ((env* (mal-env (mal-func-env fn) - (mal-func-params fn) - args))) - (setq env env* - ast (mal-func-ast fn))) ; TCO - ;; built-in function - (let ((fn* (mal-value fn))) - (throw 'return (apply fn* args)))))))) - (throw 'return (eval-ast ast env)))))) - -(defun eval-ast (ast env) - (let ((type (mal-type ast)) - (value (mal-value ast))) - (cond - ((eq type 'symbol) - (let ((definition (mal-env-get env value))) - (or definition (error "Definition not found")))) - ((eq type 'list) - (mal-list (mapcar (lambda (item) (EVAL item env)) value))) - ((eq type 'vector) - (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) - ((eq type 'map) - (let ((map (copy-hash-table value))) - (maphash (lambda (key value) - (puthash key (EVAL value env) map)) - map) - (mal-map map))) - (t - ;; return as is - ast)))) - -(mal-env-set repl-env 'eval (mal-fn (let ((env repl-env)) (lambda (form) (EVAL form env))))) -(mal-env-set repl-env '*ARGV* (mal-list (mapcar 'mal-string (cdr argv)))) - -(defun PRINT (input) - (pr-str input t)) - -(defun rep (input) - (PRINT (EVAL (READ input) repl-env))) - -(rep "(def! not (fn* (a) (if a false true)))") -(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") - -(defun readln (prompt) - ;; C-d throws an error - (ignore-errors (read-from-minibuffer prompt))) - -(defun println (format-string &rest args) - (if (not args) - (princ format-string) - (princ (apply 'format format-string args))) - (terpri)) - -(defmacro with-error-handling (&rest body) - `(condition-case err - (progn ,@body) - (end-of-token-stream - ;; empty input, carry on - ) - (unterminated-sequence - (let* ((type (cadr err)) - (end - (cond - ((eq type 'string) ?\") - ((eq type 'list) ?\)) - ((eq type 'vector) ?\]) - ((eq type 'map) ?})))) - (princ (format "Expected '%c', got EOF\n" end)))) - (error ; catch-all - (println (error-message-string err))))) - -(defun main () - (if argv - (with-error-handling - (rep (format "(load-file \"%s\")" (car argv)))) - (let (eof) - (while (not eof) - (let ((input (readln "user> "))) - (if input - (with-error-handling - (println (rep input))) - (setq eof t) - ;; print final newline - (terpri))))))) - -(main) diff --git a/elisp/step7_quote.el b/elisp/step7_quote.el deleted file mode 100644 index aefde0e297..0000000000 --- a/elisp/step7_quote.el +++ /dev/null @@ -1,202 +0,0 @@ -;; -*- lexical-binding: t; -*- - -(defun load-relative (file) - (let* ((current-file (or load-file-name buffer-file-name)) - (current-file-directory (file-name-directory current-file))) - (load (expand-file-name file current-file-directory) nil t))) - -(load-relative "types.el") -(load-relative "env.el") -(load-relative "func.el") -(load-relative "reader.el") -(load-relative "printer.el") -(load-relative "core.el") - -(defvar repl-env (mal-env)) - -(dolist (binding core-ns) - (let ((symbol (car binding)) - (fn (cdr binding))) - (mal-env-set repl-env symbol fn))) - -(defun mal-pair-p (mal-object) - (let ((type (mal-type mal-object)) - (value (mal-value mal-object))) - (if (and (or (eq type 'list) (eq type 'vector)) - (not (zerop (length value)))) - t - nil))) - -(defun quasiquote (ast) - (if (not (mal-pair-p ast)) - (mal-list (list (mal-symbol 'quote) ast)) - (let* ((a (mal-listify ast)) - (a0 (car a)) - (a0... (cdr a)) - (a1 (cadr a))) - (cond - ((eq (mal-value a0) 'unquote) - a1) - ((and (mal-pair-p a0) - (eq (mal-value (car (mal-value a0))) - 'splice-unquote)) - (mal-list (list (mal-symbol 'concat) - (cadr (mal-value a0)) - (quasiquote (mal-list a0...))))) - (t - (mal-list (list (mal-symbol 'cons) - (quasiquote a0) - (quasiquote (mal-list a0...))))))))) - -(defun READ (input) - (read-str input)) - -(defun EVAL (ast env) - (catch 'return - (while t - (if (and (mal-list-p ast) (mal-value ast)) - (let* ((a (mal-value ast)) - (a0 (car a)) - (a0* (mal-value a0)) - (a1 (cadr a)) - (a2 (nth 2 a)) - (a3 (nth 3 a))) - (cond - ((eq a0* 'def!) - (let ((identifier (mal-value a1)) - (value (EVAL a2 env))) - (throw 'return (mal-env-set env identifier value)))) - ((eq a0* 'let*) - (let* ((env* (mal-env env)) - (bindings (mal-value a1)) - (form a2)) - (when (vectorp bindings) - (setq bindings (append bindings nil))) - (while bindings - (let ((key (mal-value (pop bindings))) - (value (EVAL (pop bindings) env*))) - (mal-env-set env* key value))) - (setq env env* - ast form))) ; TCO - ((eq a0* 'quote) - (throw 'return a1)) - ((eq a0* 'quasiquote) - (setq ast (quasiquote a1))) ; TCO - ((eq a0* 'do) - (let* ((a0... (cdr a)) - (butlast (butlast a0...)) - (last (car (last a0...)))) - (when butlast - (eval-ast (mal-list butlast) env)) - (setq ast last))) ; TCO - ((eq a0* 'if) - (let* ((condition (EVAL a1 env)) - (condition-type (mal-type condition)) - (then a2) - (else a3)) - (if (and (not (eq condition-type 'false)) - (not (eq condition-type 'nil))) - (setq ast then) ; TCO - (if else - (setq ast else) ; TCO - (throw 'return mal-nil))))) - ((eq a0* 'fn*) - (let* ((binds (mapcar 'mal-value (mal-value a1))) - (body a2) - (fn (mal-fn - (lambda (&rest args) - (let ((env* (mal-env env binds args))) - (EVAL body env*)))))) - (throw 'return (mal-func body binds env fn)))) - (t - ;; not a special form - (let* ((ast* (mal-value (eval-ast ast env))) - (fn (car ast*)) - (args (cdr ast*))) - (if (mal-func-p fn) - (let ((env* (mal-env (mal-func-env fn) - (mal-func-params fn) - args))) - (setq env env* - ast (mal-func-ast fn))) ; TCO - ;; built-in function - (let ((fn* (mal-value fn))) - (throw 'return (apply fn* args)))))))) - (throw 'return (eval-ast ast env)))))) - -(defun eval-ast (ast env) - (let ((type (mal-type ast)) - (value (mal-value ast))) - (cond - ((eq type 'symbol) - (let ((definition (mal-env-get env value))) - (or definition (error "Definition not found")))) - ((eq type 'list) - (mal-list (mapcar (lambda (item) (EVAL item env)) value))) - ((eq type 'vector) - (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) - ((eq type 'map) - (let ((map (copy-hash-table value))) - (maphash (lambda (key value) - (puthash key (EVAL value env) map)) - map) - (mal-map map))) - (t - ;; return as is - ast)))) - -(mal-env-set repl-env 'eval (mal-fn (let ((env repl-env)) (lambda (form) (EVAL form env))))) -(mal-env-set repl-env '*ARGV* (mal-list (mapcar 'mal-string (cdr argv)))) - -(defun PRINT (input) - (pr-str input t)) - -(defun rep (input) - (PRINT (EVAL (READ input) repl-env))) - -(rep "(def! not (fn* (a) (if a false true)))") -(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") - -(defun readln (prompt) - ;; C-d throws an error - (ignore-errors (read-from-minibuffer prompt))) - -(defun println (format-string &rest args) - (if (not args) - (princ format-string) - (princ (apply 'format format-string args))) - (terpri)) - -(defmacro with-error-handling (&rest body) - `(condition-case err - (progn ,@body) - (end-of-token-stream - ;; empty input, carry on - ) - (unterminated-sequence - (let* ((type (cadr err)) - (end - (cond - ((eq type 'string) ?\") - ((eq type 'list) ?\)) - ((eq type 'vector) ?\]) - ((eq type 'map) ?})))) - (princ (format "Expected '%c', got EOF\n" end)))) - (error ; catch-all - (println (error-message-string err))))) - -(defun main () - (if argv - (with-error-handling - (rep (format "(load-file \"%s\")" (car argv)))) - (let (eof) - (while (not eof) - (let ((input (readln "user> "))) - (if input - (with-error-handling - (println (rep input))) - (setq eof t) - ;; print final newline - (terpri))))))) - -(main) diff --git a/elisp/step8_macros.el b/elisp/step8_macros.el deleted file mode 100644 index ee9f220605..0000000000 --- a/elisp/step8_macros.el +++ /dev/null @@ -1,235 +0,0 @@ -;; -*- lexical-binding: t; -*- - -(defun load-relative (file) - (let* ((current-file (or load-file-name buffer-file-name)) - (current-file-directory (file-name-directory current-file))) - (load (expand-file-name file current-file-directory) nil t))) - -(load-relative "types.el") -(load-relative "env.el") -(load-relative "func.el") -(load-relative "reader.el") -(load-relative "printer.el") -(load-relative "core.el") - -(defvar repl-env (mal-env)) - -(dolist (binding core-ns) - (let ((symbol (car binding)) - (fn (cdr binding))) - (mal-env-set repl-env symbol fn))) - -(defun mal-pair-p (mal-object) - (let ((type (mal-type mal-object)) - (value (mal-value mal-object))) - (if (and (or (eq type 'list) (eq type 'vector)) - (not (zerop (length value)))) - t - nil))) - -(defun quasiquote (ast) - (if (not (mal-pair-p ast)) - (mal-list (list (mal-symbol 'quote) ast)) - (let* ((a (mal-listify ast)) - (a0 (car a)) - (a0... (cdr a)) - (a1 (cadr a))) - (cond - ((eq (mal-value a0) 'unquote) - a1) - ((and (mal-pair-p a0) - (eq (mal-value (car (mal-value a0))) - 'splice-unquote)) - (mal-list (list (mal-symbol 'concat) - (cadr (mal-value a0)) - (quasiquote (mal-list a0...))))) - (t - (mal-list (list (mal-symbol 'cons) - (quasiquote a0) - (quasiquote (mal-list a0...))))))))) - -(defun macro-call-p (ast env) - (when (mal-list-p ast) - (let ((a0 (car (mal-value ast)))) - (when (mal-symbol-p a0) - (let ((value (mal-env-find env (mal-value a0)))) - (when (and (mal-func-p value) - (mal-func-macro-p value)) - t)))))) - -(defun MACROEXPAND (ast env) - (while (macro-call-p ast env) - (let* ((a (mal-value ast)) - (a0* (mal-value (car a))) - (a0... (cdr a)) - (macro (mal-env-find env a0*))) - (setq ast (apply (mal-value (mal-func-fn macro)) a0...)))) - ast) - -(defun READ (input) - (read-str input)) - -(defun EVAL (ast env) - (catch 'return - (while t - (when (not (mal-list-p ast)) - (throw 'return (eval-ast ast env))) - - (setq ast (MACROEXPAND ast env)) - (when (or (not (mal-list-p ast)) (not (mal-value ast))) - (throw 'return (eval-ast ast env))) - - (let* ((a (mal-value ast)) - (a0 (car a)) - (a0* (mal-value a0)) - (a1 (cadr a)) - (a2 (nth 2 a)) - (a3 (nth 3 a))) - (cond - ((eq a0* 'def!) - (let* ((identifier (mal-value a1)) - (value (EVAL a2 env))) - (throw 'return (mal-env-set env identifier value)))) - ((eq a0* 'let*) - (let* ((env* (mal-env env)) - (bindings (mal-value a1)) - (form a2)) - (when (vectorp bindings) - (setq bindings (append bindings nil))) - (while bindings - (let ((key (mal-value (pop bindings))) - (value (EVAL (pop bindings) env*))) - (mal-env-set env* key value))) - (setq env env* - ast form))) ; TCO - ((eq a0* 'quote) - (throw 'return a1)) - ((eq a0* 'quasiquote) - (setq ast (quasiquote a1))) ; TCO - ((eq a0* 'defmacro!) - (let ((identifier (mal-value a1)) - (value (EVAL a2 env))) - (setf (aref (aref value 1) 4) t) - (throw 'return (mal-env-set env identifier value)))) - ((eq a0* 'macroexpand) - (throw 'return (MACROEXPAND a1 env))) - ((eq a0* 'do) - (let* ((a0... (cdr a)) - (butlast (butlast a0...)) - (last (car (last a0...)))) - (when butlast - (eval-ast (mal-list butlast) env)) - (setq ast last))) ; TCO - ((eq a0* 'if) - (let* ((condition (EVAL a1 env)) - (condition-type (mal-type condition)) - (then a2) - (else a3)) - (if (and (not (eq condition-type 'false)) - (not (eq condition-type 'nil))) - (setq ast then) ; TCO - (if else - (setq ast else) ; TCO - (throw 'return mal-nil))))) - ((eq a0* 'fn*) - (let* ((binds (mapcar 'mal-value (mal-value a1))) - (body a2) - (fn (mal-fn - (lambda (&rest args) - (let ((env* (mal-env env binds args))) - (EVAL body env*)))))) - (throw 'return (mal-func body binds env fn)))) - (t - ;; not a special form - (let* ((ast* (mal-value (eval-ast ast env))) - (fn (car ast*)) - (args (cdr ast*))) - (if (mal-func-p fn) - (let ((env* (mal-env (mal-func-env fn) - (mal-func-params fn) - args))) - (setq env env* - ast (mal-func-ast fn))) ; TCO - ;; built-in function - (let ((fn* (mal-value fn))) - (throw 'return (apply fn* args))))))))))) - -(defun eval-ast (ast env) - (let ((type (mal-type ast)) - (value (mal-value ast))) - (cond - ((eq type 'symbol) - (let ((definition (mal-env-get env value))) - (or definition (error "Definition not found")))) - ((eq type 'list) - (mal-list (mapcar (lambda (item) (EVAL item env)) value))) - ((eq type 'vector) - (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) - ((eq type 'map) - (let ((map (copy-hash-table value))) - (maphash (lambda (key value) - (puthash key (EVAL value env) map)) - map) - (mal-map map))) - (t - ;; return as is - ast)))) - -(mal-env-set repl-env 'eval (mal-fn (let ((env repl-env)) (lambda (form) (EVAL form env))))) -(mal-env-set repl-env '*ARGV* (mal-list (mapcar 'mal-string (cdr argv)))) - -(defun PRINT (input) - (pr-str input t)) - -(defun rep (input) - (PRINT (EVAL (READ input) repl-env))) - -(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))))))))") - -(defun readln (prompt) - ;; C-d throws an error - (ignore-errors (read-from-minibuffer prompt))) - -(defun println (format-string &rest args) - (if (not args) - (princ format-string) - (princ (apply 'format format-string args))) - (terpri)) - -(defmacro with-error-handling (&rest body) - `(condition-case err - (progn ,@body) - (end-of-token-stream - ;; empty input, carry on - ) - (unterminated-sequence - (let* ((type (cadr err)) - (end - (cond - ((eq type 'string) ?\") - ((eq type 'list) ?\)) - ((eq type 'vector) ?\]) - ((eq type 'map) ?})))) - (princ (format "Expected '%c', got EOF\n" end)))) - (error ; catch-all - (println (error-message-string err))))) - -(defun main () - (if argv - (with-error-handling - (rep (format "(load-file \"%s\")" (car argv)))) - (let (eof) - (while (not eof) - (let ((input (readln "user> "))) - (if input - (with-error-handling - (println (rep input))) - (setq eof t) - ;; print final newline - (terpri))))))) - -(main) diff --git a/elisp/step9_try.el b/elisp/step9_try.el deleted file mode 100644 index c3b5907aa9..0000000000 --- a/elisp/step9_try.el +++ /dev/null @@ -1,251 +0,0 @@ -;; -*- lexical-binding: t; -*- - -(defun load-relative (file) - (let* ((current-file (or load-file-name buffer-file-name)) - (current-file-directory (file-name-directory current-file))) - (load (expand-file-name file current-file-directory) nil t))) - -(load-relative "types.el") -(load-relative "env.el") -(load-relative "func.el") -(load-relative "reader.el") -(load-relative "printer.el") -(load-relative "core.el") - -(defvar repl-env (mal-env)) - -(dolist (binding core-ns) - (let ((symbol (car binding)) - (fn (cdr binding))) - (mal-env-set repl-env symbol fn))) - -(defun mal-pair-p (mal-object) - (let ((type (mal-type mal-object)) - (value (mal-value mal-object))) - (if (and (or (eq type 'list) (eq type 'vector)) - (not (zerop (length value)))) - t - nil))) - -(defun quasiquote (ast) - (if (not (mal-pair-p ast)) - (mal-list (list (mal-symbol 'quote) ast)) - (let* ((a (mal-listify ast)) - (a0 (car a)) - (a0... (cdr a)) - (a1 (cadr a))) - (cond - ((eq (mal-value a0) 'unquote) - a1) - ((and (mal-pair-p a0) - (eq (mal-value (car (mal-value a0))) - 'splice-unquote)) - (mal-list (list (mal-symbol 'concat) - (cadr (mal-value a0)) - (quasiquote (mal-list a0...))))) - (t - (mal-list (list (mal-symbol 'cons) - (quasiquote a0) - (quasiquote (mal-list a0...))))))))) - -(defun macro-call-p (ast env) - (when (mal-list-p ast) - (let ((a0 (car (mal-value ast)))) - (when (mal-symbol-p a0) - (let ((value (mal-env-find env (mal-value a0)))) - (when (and (mal-func-p value) - (mal-func-macro-p value)) - t)))))) - -(defun MACROEXPAND (ast env) - (while (macro-call-p ast env) - (let* ((a (mal-value ast)) - (a0* (mal-value (car a))) - (a0... (cdr a)) - (macro (mal-env-find env a0*))) - (setq ast (apply (mal-value (mal-func-fn macro)) a0...)))) - ast) - -(defun READ (input) - (read-str input)) - -(defun EVAL (ast env) - (catch 'return - (while t - (when (not (mal-list-p ast)) - (throw 'return (eval-ast ast env))) - - (setq ast (MACROEXPAND ast env)) - (when (or (not (mal-list-p ast)) (not (mal-value ast))) - (throw 'return (eval-ast ast env))) - - (let* ((a (mal-value ast)) - (a0 (car a)) - (a0* (mal-value a0)) - (a1 (cadr a)) - (a2 (nth 2 a)) - (a3 (nth 3 a))) - (cond - ((eq a0* 'def!) - (let* ((identifier (mal-value a1)) - (value (EVAL a2 env))) - (throw 'return (mal-env-set env identifier value)))) - ((eq a0* 'let*) - (let* ((env* (mal-env env)) - (bindings (mal-value a1)) - (form a2)) - (when (vectorp bindings) - (setq bindings (append bindings nil))) - (while bindings - (let ((key (mal-value (pop bindings))) - (value (EVAL (pop bindings) env*))) - (mal-env-set env* key value))) - (setq env env* - ast form))) ; TCO - ((eq a0* 'quote) - (throw 'return a1)) - ((eq a0* 'quasiquote) - (setq ast (quasiquote a1))) ; TCO - ((eq a0* 'defmacro!) - (let ((identifier (mal-value a1)) - (value (EVAL a2 env))) - (setf (aref (aref value 1) 4) t) - (throw 'return (mal-env-set env identifier value)))) - ((eq a0* 'macroexpand) - (throw 'return (MACROEXPAND a1 env))) - ((eq a0* 'try*) - (condition-case err - (throw 'return (EVAL a1 env)) - (error - (if (and a2 (eq (mal-value (car (mal-value a2))) 'catch*)) - (let* ((a2* (mal-value a2)) - (identifier (mal-value (cadr a2*))) - (form (nth 2 a2*)) - (err* (if (eq (car err) 'mal-custom) - ;; throw - (cadr err) - ;; normal error - (mal-string (error-message-string err)))) - (env* (mal-env env (list identifier) (list err*)))) - (throw 'return (EVAL form env*))) - (apply 'signal err))))) - ((eq a0* 'do) - (let* ((a0... (cdr a)) - (butlast (butlast a0...)) - (last (car (last a0...)))) - (when butlast - (eval-ast (mal-list butlast) env)) - (setq ast last))) ; TCO - ((eq a0* 'if) - (let* ((condition (EVAL a1 env)) - (condition-type (mal-type condition)) - (then a2) - (else a3)) - (if (and (not (eq condition-type 'false)) - (not (eq condition-type 'nil))) - (setq ast then) ; TCO - (if else - (setq ast else) ; TCO - (throw 'return (mal-nil)))))) - ((eq a0* 'fn*) - (let* ((binds (mapcar 'mal-value (mal-value a1))) - (body a2) - (fn (mal-fn - (lambda (&rest args) - (let ((env* (mal-env env binds args))) - (EVAL body env*)))))) - (throw 'return (mal-func body binds env fn)))) - (t - ;; not a special form - (let* ((ast* (mal-value (eval-ast ast env))) - (fn (car ast*)) - (args (cdr ast*))) - (if (mal-func-p fn) - (let ((env* (mal-env (mal-func-env fn) - (mal-func-params fn) - args))) - (setq env env* - ast (mal-func-ast fn))) ; TCO - ;; built-in function - (let ((fn* (mal-value fn))) - (throw 'return (apply fn* args))))))))))) - -(defun eval-ast (ast env) - (let ((type (mal-type ast)) - (value (mal-value ast))) - (cond - ((eq type 'symbol) - (let ((definition (mal-env-get env value))) - (or definition (error "Definition not found")))) - ((eq type 'list) - (mal-list (mapcar (lambda (item) (EVAL item env)) value))) - ((eq type 'vector) - (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) - ((eq type 'map) - (let ((map (copy-hash-table value))) - (maphash (lambda (key value) - (puthash key (EVAL value env) map)) - map) - (mal-map map))) - (t - ;; return as is - ast)))) - -(mal-env-set repl-env 'eval (mal-fn (let ((env repl-env)) (lambda (form) (EVAL form env))))) -(mal-env-set repl-env '*ARGV* (mal-list (mapcar 'mal-string (cdr argv)))) - -(defun PRINT (input) - (pr-str input t)) - -(defun rep (input) - (PRINT (EVAL (READ input) repl-env))) - -(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))))))))") - -(defun readln (prompt) - ;; C-d throws an error - (ignore-errors (read-from-minibuffer prompt))) - -(defun println (format-string &rest args) - (if (not args) - (princ format-string) - (princ (apply 'format format-string args))) - (terpri)) - -(defmacro with-error-handling (&rest body) - `(condition-case err - (progn ,@body) - (end-of-token-stream - ;; empty input, carry on - ) - (unterminated-sequence - (let* ((type (cadr err)) - (end - (cond - ((eq type 'string) ?\") - ((eq type 'list) ?\)) - ((eq type 'vector) ?\]) - ((eq type 'map) ?})))) - (princ (format "Expected '%c', got EOF\n" end)))) - (error ; catch-all - (println (error-message-string err))))) - -(defun main () - (if argv - (with-error-handling - (rep (format "(load-file \"%s\")" (car argv)))) - (let (eof) - (while (not eof) - (let ((input (readln "user> "))) - (if input - (with-error-handling - (println (rep input))) - (setq eof t) - ;; print final newline - (terpri))))))) - -(main) diff --git a/elisp/stepA_mal.el b/elisp/stepA_mal.el deleted file mode 100644 index 9f26edbca0..0000000000 --- a/elisp/stepA_mal.el +++ /dev/null @@ -1,256 +0,0 @@ -;; -*- lexical-binding: t; -*- - -(defun load-relative (file) - (let* ((current-file (or load-file-name buffer-file-name)) - (current-file-directory (file-name-directory current-file))) - (load (expand-file-name file current-file-directory) nil t))) - -(load-relative "types.el") -(load-relative "env.el") -(load-relative "func.el") -(load-relative "reader.el") -(load-relative "printer.el") -(load-relative "core.el") - -(defvar repl-env (mal-env)) - -(dolist (binding core-ns) - (let ((symbol (car binding)) - (fn (cdr binding))) - (mal-env-set repl-env symbol fn))) - -(defun mal-pair-p (mal-object) - (let ((type (mal-type mal-object)) - (value (mal-value mal-object))) - (if (and (or (eq type 'list) (eq type 'vector)) - (not (zerop (length value)))) - t - nil))) - -(defun quasiquote (ast) - (if (not (mal-pair-p ast)) - (mal-list (list (mal-symbol 'quote) ast)) - (let* ((a (mal-listify ast)) - (a0 (car a)) - (a0... (cdr a)) - (a1 (cadr a))) - (cond - ((eq (mal-value a0) 'unquote) - a1) - ((and (mal-pair-p a0) - (eq (mal-value (car (mal-value a0))) - 'splice-unquote)) - (mal-list (list (mal-symbol 'concat) - (cadr (mal-value a0)) - (quasiquote (mal-list a0...))))) - (t - (mal-list (list (mal-symbol 'cons) - (quasiquote a0) - (quasiquote (mal-list a0...))))))))) - -(defun macro-call-p (ast env) - (when (mal-list-p ast) - (let ((a0 (car (mal-value ast)))) - (when (mal-symbol-p a0) - (let ((value (mal-env-find env (mal-value a0)))) - (when (and (mal-func-p value) - (mal-func-macro-p value)) - t)))))) - -(defun MACROEXPAND (ast env) - (while (macro-call-p ast env) - (let* ((a (mal-value ast)) - (a0* (mal-value (car a))) - (a0... (cdr a)) - (macro (mal-env-find env a0*))) - (setq ast (apply (mal-value (mal-func-fn macro)) a0...)))) - ast) - -(defun READ (input) - (read-str input)) - -(defun EVAL (ast env) - (catch 'return - (while t - (when (not (mal-list-p ast)) - (throw 'return (eval-ast ast env))) - - (setq ast (MACROEXPAND ast env)) - (when (or (not (mal-list-p ast)) (not (mal-value ast))) - (throw 'return (eval-ast ast env))) - - (let* ((a (mal-value ast)) - (a0 (car a)) - (a0* (mal-value a0)) - (a1 (cadr a)) - (a2 (nth 2 a)) - (a3 (nth 3 a))) - (cond - ((eq a0* 'def!) - (let* ((identifier (mal-value a1)) - (value (EVAL a2 env))) - (throw 'return (mal-env-set env identifier value)))) - ((eq a0* 'let*) - (let* ((env* (mal-env env)) - (bindings (mal-value a1)) - (form a2)) - (when (vectorp bindings) - (setq bindings (append bindings nil))) - (while bindings - (let ((key (mal-value (pop bindings))) - (value (EVAL (pop bindings) env*))) - (mal-env-set env* key value))) - (setq env env* - ast form))) ; TCO - ((eq a0* 'quote) - (throw 'return a1)) - ((eq a0* 'quasiquote) - (setq ast (quasiquote a1))) ; TCO - ((eq a0* 'defmacro!) - (let ((identifier (mal-value a1)) - (value (EVAL a2 env))) - (setf (aref (aref value 1) 4) t) - (throw 'return (mal-env-set env identifier value)))) - ((eq a0* 'macroexpand) - (throw 'return (MACROEXPAND a1 env))) - ((eq a0* 'try*) - (condition-case err - (throw 'return (EVAL a1 env)) - (error - (if (and a2 (eq (mal-value (car (mal-value a2))) 'catch*)) - (let* ((a2* (mal-value a2)) - (identifier (mal-value (cadr a2*))) - (form (nth 2 a2*)) - (err* (if (eq (car err) 'mal-custom) - ;; throw - (cadr err) - ;; normal error - (mal-string (error-message-string err)))) - (env* (mal-env env (list identifier) (list err*)))) - (throw 'return (EVAL form env*))) - (apply 'signal err))))) - ((eq a0* 'do) - (let* ((a0... (cdr a)) - (butlast (butlast a0...)) - (last (car (last a0...)))) - (when butlast - (eval-ast (mal-list butlast) env)) - (setq ast last))) ; TCO - ((eq a0* 'if) - (let* ((condition (EVAL a1 env)) - (condition-type (mal-type condition)) - (then a2) - (else a3)) - (if (and (not (eq condition-type 'false)) - (not (eq condition-type 'nil))) - (setq ast then) ; TCO - (if else - (setq ast else) ; TCO - (throw 'return mal-nil))))) - ((eq a0* 'fn*) - (let* ((binds (mapcar 'mal-value (mal-value a1))) - (body a2) - (fn (mal-fn - (lambda (&rest args) - (let ((env* (mal-env env binds args))) - (EVAL body env*)))))) - (throw 'return (mal-func body binds env fn)))) - (t - ;; not a special form - (let* ((ast* (mal-value (eval-ast ast env))) - (fn (car ast*)) - (args (cdr ast*))) - (if (mal-func-p fn) - (let ((env* (mal-env (mal-func-env fn) - (mal-func-params fn) - args))) - (setq env env* - ast (mal-func-ast fn))) ; TCO - ;; built-in function - (let ((fn* (mal-value fn))) - (throw 'return (apply fn* args))))))))))) - -(defun eval-ast (ast env) - (let ((type (mal-type ast)) - (value (mal-value ast))) - (cond - ((eq type 'symbol) - (let ((definition (mal-env-get env value))) - (or definition (error "Definition not found")))) - ((eq type 'list) - (mal-list (mapcar (lambda (item) (EVAL item env)) value))) - ((eq type 'vector) - (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) - ((eq type 'map) - (let ((map (copy-hash-table value))) - (maphash (lambda (key value) - (puthash key (EVAL value env) map)) - map) - (mal-map map))) - (t - ;; return as is - ast)))) - -(mal-env-set repl-env 'eval (mal-fn (let ((env repl-env)) (lambda (form) (EVAL form env))))) -(mal-env-set repl-env '*ARGV* (mal-list (mapcar 'mal-string (cdr argv)))) -(mal-env-set repl-env '*host-language* (mal-string "elisp")) - -(defun PRINT (input) - (pr-str input t)) - -(defun rep (input) - (PRINT (EVAL (READ input) repl-env))) - -(rep "(def! not (fn* (a) (if a false true)))") -(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") - -(rep "(def! *gensym-counter* (atom 0))") -(rep "(def! gensym (fn* [] (symbol (str \"G__\" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))") - -(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* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))") - -(defun readln (prompt) - ;; C-d throws an error - (ignore-errors (read-from-minibuffer prompt))) - -(defun println (format-string &rest args) - (if (not args) - (princ format-string) - (princ (apply 'format format-string args))) - (terpri)) - -(defmacro with-error-handling (&rest body) - `(condition-case err - (progn ,@body) - (end-of-token-stream - ;; empty input, carry on - ) - (unterminated-sequence - (let* ((type (cadr err)) - (end - (cond - ((eq type 'string) ?\") - ((eq type 'list) ?\)) - ((eq type 'vector) ?\]) - ((eq type 'map) ?})))) - (princ (format "Expected '%c', got EOF\n" end)))) - (error ; catch-all - (println (error-message-string err))))) - -(defun main () - (if argv - (with-error-handling - (rep (format "(load-file \"%s\")" (car argv)))) - (let (eof) - (rep "(println (str \"Mal [\" *host-language* \"]\"))") - (while (not eof) - (let ((input (readln "user> "))) - (if input - (with-error-handling - (println (rep input))) - (setq eof t) - ;; print final newline - (terpri))))))) - -(main) diff --git a/elisp/tests/stepA_mal.mal b/elisp/tests/stepA_mal.mal deleted file mode 100644 index a6c9bca187..0000000000 --- a/elisp/tests/stepA_mal.mal +++ /dev/null @@ -1,21 +0,0 @@ -;; 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 \"24.\" digit \".\" digit))") -(elisp-eval "(and (string-match-p emacs-version-re emacs-version) t)") -;=>true diff --git a/elisp/types.el b/elisp/types.el deleted file mode 100644 index 8029e5eecf..0000000000 --- a/elisp/types.el +++ /dev/null @@ -1,104 +0,0 @@ -;;; general accessors - -(defun mal-type (mal-object) - (aref mal-object 0)) - -(defun mal-value (mal-object) - (aref mal-object 1)) - -(defun mal-meta (mal-object) - (aref mal-object 2)) - -;;; objects - -(defmacro mal-object (name) - (let ((constructor (intern (format "mal-%s" name))) - (predicate (intern (format "mal-%s-p" name)))) - `(progn - (defun ,constructor (&optional value meta) - (vector ',name value meta)) - (defun ,predicate (arg) - (and (arrayp arg) (eq (aref arg 0) ',name)))))) - -(mal-object nil) -(mal-object true) -(mal-object false) - -(defvar mal-nil (mal-nil)) -(defvar mal-true (mal-true 'true)) -(defvar mal-false (mal-false 'false)) - -(mal-object number) -(mal-object string) -(mal-object symbol) -(mal-object keyword) - -(mal-object list) -(mal-object vector) -(mal-object map) - -(mal-object env) -(mal-object atom) - -(mal-object fn) -(mal-object func) - -;;; 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 "Unterminated token sequence" 'mal) -(define-error 'end-of-token-stream "End of token stream" 'mal) -(define-error 'mal-custom "Custom error" 'mal) diff --git a/elixir/Dockerfile b/elixir/Dockerfile deleted file mode 100644 index 7f013a5928..0000000000 --- a/elixir/Dockerfile +++ /dev/null @@ -1,29 +0,0 @@ -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 -########################################################## - -# Elixir -RUN curl -O https://packages.erlang-solutions.com/erlang-solutions_1.0_all.deb \ - && dpkg -i erlang-solutions_1.0_all.deb -RUN apt-get -y update -RUN apt-get -y install elixir - diff --git a/elixir/Makefile b/elixir/Makefile deleted file mode 100644 index 7f922cc097..0000000000 --- a/elixir/Makefile +++ /dev/null @@ -1,25 +0,0 @@ -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 - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*#|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" - -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*#|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" - -.PHONY: clean stats stats-lisp diff --git a/elixir/lib/mix/tasks/step2_eval.ex b/elixir/lib/mix/tasks/step2_eval.ex deleted file mode 100644 index 0d130afce9..0000000000 --- a/elixir/lib/mix/tasks/step2_eval.ex +++ /dev/null @@ -1,70 +0,0 @@ -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 - {:list, Enum.map(ast, fn elem -> eval(elem, env) end), meta} - end - - defp eval_ast({:map, ast, meta}, env) do - map = for {key, value} <- ast, into: %{} do - {eval(key, env), 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({:list, [], _} = empty_ast, env), do: empty_ast - defp eval({:list, ast, meta}, env), do: eval_list(ast, env, meta) - defp eval(ast, env), do: eval_ast(ast, env) - - defp eval_list(ast, env, meta) do - {:list, [func | args], _} = eval_ast({:list, ast, meta}, env) - apply(func, args) - end - - 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/elixir/lib/mix/tasks/step7_quote.ex b/elixir/lib/mix/tasks/step7_quote.ex deleted file mode 100644 index 566f6c54ba..0000000000 --- a/elixir/lib/mix/tasks/step7_quote.ex +++ /dev/null @@ -1,190 +0,0 @@ -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) ")"))))) - """, 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 - {:list, Enum.map(ast, fn elem -> eval(elem, env) end), meta} - end - - defp eval_ast({:map, ast, meta}, env) do - map = for {key, value} <- ast, into: %{} do - {eval(key, env), 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 quasi_list([], _env), do: list([{:symbol, "quote"}, list([])]) - defp quasi_list([{:symbol, "unquote"}, arg], _env), do: arg - defp quasi_list([{:list, [{:symbol, "splice-unquote"}, first], _meta} | tail], env) do - right = tail - |> list - |> quasiquote(env) - - list([{:symbol, "concat"}, first, right]) - end - defp quasi_list([head | tail], env) do - left = quasiquote(head, env) - right = tail - |> list - |> quasiquote(env) - - list([{:symbol, "cons"}, left, right]) - end - - defp quasiquote({list_type, ast, _}, env) - when list_type in [:list, :vector] do - quasi_list(ast, env) - end - defp quasiquote(ast, _env), do: list([{:symbol, "quote"}, ast]) - - defp eval({:list, [], _} = empty_ast, env), do: empty_ast - defp eval({:list, ast, meta}, env), do: eval_list(ast, env, meta) - defp eval(ast, env), do: eval_ast(ast, env) - - 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) - |> list - |> eval_ast(env) - 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 - quasiquote(ast, env) - |> eval(env) - end - - defp eval_list(ast, env, meta) do - {:list, [func | args], _} = eval_ast({:list, ast, meta}, env) - func.value.(args) - 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, message} -> IO.puts("Error: #{message}") - end -end diff --git a/elixir/lib/mix/tasks/step8_macros.ex b/elixir/lib/mix/tasks/step8_macros.ex deleted file mode 100644 index 11cc5777b8..0000000000 --- a/elixir/lib/mix/tasks/step8_macros.ex +++ /dev/null @@ -1,248 +0,0 @@ -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) ")"))))) - """, 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) - - # or: - read_eval_print(""" - (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)))))))) - """, 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 - {:list, Enum.map(ast, fn elem -> eval(elem, env) end), meta} - end - - defp eval_ast({:map, ast, meta}, env) do - map = for {key, value} <- ast, into: %{} do - {eval(key, env), 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 quasi_list([], _env), do: list([{:symbol, "quote"}, list([])]) - defp quasi_list([{:symbol, "unquote"}, arg], _env), do: arg - defp quasi_list([{:list, [{:symbol, "splice-unquote"}, first], _meta} | tail], env) do - right = tail - |> list - |> quasiquote(env) - - list([{:symbol, "concat"}, first, right]) - end - defp quasi_list([head | tail], env) do - left = quasiquote(head, env) - right = tail - |> list - |> quasiquote(env) - - list([{:symbol, "cons"}, left, right]) - end - - defp quasiquote({list_type, ast, _}, env) - when list_type in [:list, :vector] do - quasi_list(ast, env) - end - defp quasiquote(ast, _env), do: list([{:symbol, "quote"}, ast]) - - defp macro_call?({:list, [{:symbol, key} | _tail], _}, env) do - case Mal.Env.get(env, key) do - {:ok, %Function{macro: true}} -> true - _ -> false - end - end - defp macro_call?(_ast, _env), do: false - - defp do_macro_call({:list, [{:symbol, key} | tail], _}, env) do - {:ok, %Function{value: macro, macro: true}} = Mal.Env.get(env, key) - macro.(tail) - |> macroexpand(env) - end - - defp macroexpand(ast, env) do - if macro_call?(ast, env) do - do_macro_call(ast, env) - else - ast - end - end - - defp eval({:list, [], _} = empty_ast, env), do: empty_ast - defp eval({:list, _list, _meta} = ast, env) do - case macroexpand(ast, env) do - {:list, list, meta} -> eval_list(list, env, meta) - result -> eval_ast(result, env) - end - end - defp eval(ast, env), do: eval_ast(ast, env) - - defp eval_list([{:symbol, "macroexpand"}, ast], env, _), do: macroexpand(ast, env) - - 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) - |> list - |> eval_ast(env) - 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 - quasiquote(ast, env) - |> eval(env) - end - - defp eval_list(ast, env, meta) do - {:list, [func | args], _} = eval_ast({:list, ast, meta}, env) - func.value.(args) - 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, message} -> IO.puts("Error: #{message}") - end -end diff --git a/elixir/lib/mix/tasks/step9_try.ex b/elixir/lib/mix/tasks/step9_try.ex deleted file mode 100644 index aa8f75ef38..0000000000 --- a/elixir/lib/mix/tasks/step9_try.ex +++ /dev/null @@ -1,272 +0,0 @@ -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) ")"))))) - """, 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) - - # or: - read_eval_print(""" - (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)))))))) - """, 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 - {:list, Enum.map(ast, fn elem -> eval(elem, env) end), meta} - end - - defp eval_ast({:map, ast, meta}, env) do - map = for {key, value} <- ast, into: %{} do - {eval(key, env), 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 quasi_list([], _env), do: list([{:symbol, "quote"}, list([])]) - defp quasi_list([{:symbol, "unquote"}, arg], _env), do: arg - defp quasi_list([{:list, [{:symbol, "splice-unquote"}, first], _meta} | tail], env) do - right = tail - |> list - |> quasiquote(env) - - list([{:symbol, "concat"}, first, right]) - end - defp quasi_list([head | tail], env) do - left = quasiquote(head, env) - right = tail - |> list - |> quasiquote(env) - - list([{:symbol, "cons"}, left, right]) - end - - defp quasiquote({list_type, ast, _}, env) - when list_type in [:list, :vector] do - quasi_list(ast, env) - end - defp quasiquote(ast, _env), do: list([{:symbol, "quote"}, ast]) - - defp macro_call?({:list, [{:symbol, key} | _tail], _}, env) do - case Mal.Env.get(env, key) do - {:ok, %Function{macro: true}} -> true - _ -> false - end - end - defp macro_call?(_ast, _env), do: false - - defp do_macro_call({:list, [{:symbol, key} | tail], _}, env) do - {:ok, %Function{value: macro, macro: true}} = Mal.Env.get(env, key) - macro.(tail) - |> macroexpand(env) - end - - defp macroexpand(ast, env) do - if macro_call?(ast, env) do - do_macro_call(ast, env) - else - ast - end - end - - defp eval({:list, [], _} = empty_ast, env), do: empty_ast - defp eval({:list, _list, _meta} = ast, env) do - case macroexpand(ast, env) do - {:list, list, meta} -> eval_list(list, env, meta) - result -> eval_ast(result, env) - end - end - defp eval(ast, env), do: eval_ast(ast, env) - - defp eval_list([{:symbol, "macroexpand"}, ast], env, _), do: macroexpand(ast, env) - - 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) - |> list - |> eval_ast(env) - 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 - quasiquote(ast, env) - |> 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 - throw({:error, "try* requires a list as the second parameter"}) - end - - defp eval_list(ast, env, meta) do - {:list, [func | args], _} = eval_ast({:list, ast, meta}, env) - func.value.(args) - end - - 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/elixir/lib/mix/tasks/stepA_mal.ex b/elixir/lib/mix/tasks/stepA_mal.ex deleted file mode 100644 index 7ac36b8370..0000000000 --- a/elixir/lib/mix/tasks/stepA_mal.ex +++ /dev/null @@ -1,291 +0,0 @@ -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) ")"))))) - """, 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) - - # gensym - read_eval_print("(def! *gensym-counter* (atom 0))", env) - read_eval_print(""" - (def! gensym - (fn* [] - (symbol (str \"G__\" (swap! *gensym-counter* (fn* [x] (+ 1 x))))))) - """, env) - - # or: - read_eval_print(""" - (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))))))))) - """, 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 - {:list, Enum.map(ast, fn elem -> eval(elem, env) end), meta} - end - - defp eval_ast({:map, ast, meta}, env) do - map = for {key, value} <- ast, into: %{} do - {eval(key, env), 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 quasi_list([], _env), do: list([{:symbol, "quote"}, list([])]) - defp quasi_list([{:symbol, "unquote"}, arg], _env), do: arg - defp quasi_list([{:list, [{:symbol, "splice-unquote"}, first], _meta} | tail], env) do - right = tail - |> list - |> quasiquote(env) - - list([{:symbol, "concat"}, first, right]) - end - defp quasi_list([head | tail], env) do - left = quasiquote(head, env) - right = tail - |> list - |> quasiquote(env) - - list([{:symbol, "cons"}, left, right]) - end - - defp quasiquote({list_type, ast, _}, env) - when list_type in [:list, :vector] do - quasi_list(ast, env) - end - defp quasiquote(ast, _env), do: list([{:symbol, "quote"}, ast]) - - defp macro_call?({:list, [{:symbol, key} | _tail], _}, env) do - case Mal.Env.get(env, key) do - {:ok, %Function{macro: true}} -> true - _ -> false - end - end - defp macro_call?(_ast, _env), do: false - - defp do_macro_call({:list, [{:symbol, key} | tail], _}, env) do - {:ok, %Function{value: macro, macro: true}} = Mal.Env.get(env, key) - macro.(tail) - |> macroexpand(env) - end - - defp macroexpand(ast, env) do - if macro_call?(ast, env) do - do_macro_call(ast, env) - else - ast - end - end - - defp eval({:list, [], _} = empty_ast, env), do: empty_ast - defp eval({:list, _list, _meta} = ast, env) do - case macroexpand(ast, env) do - {:list, list, meta} -> eval_list(list, env, meta) - result -> eval_ast(result, env) - end - end - defp eval(ast, env), do: eval_ast(ast, env) - - defp eval_list([{:symbol, "macroexpand"}, ast], env, _), do: macroexpand(ast, env) - - 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) - |> list - |> eval_ast(env) - 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 - quasiquote(ast, env) - |> 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 - throw({:error, "try* requires a list as the second parameter"}) - end - - defp eval_list(ast, env, meta) do - {:list, [func | args], _} = eval_ast({:list, ast, meta}, env) - func.value.(args) - end - - 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/elixir/run b/elixir/run deleted file mode 100755 index db29600d6f..0000000000 --- a/elixir/run +++ /dev/null @@ -1,3 +0,0 @@ -#!/bin/bash -cd $(dirname $0) -exec mix ${STEP:-stepA_mal} "${@}" diff --git a/erlang/Dockerfile b/erlang/Dockerfile deleted file mode 100644 index f2b907627c..0000000000 --- a/erlang/Dockerfile +++ /dev/null @@ -1,35 +0,0 @@ -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 -########################################################## - -# Erlang R17 (so I can use maps) -RUN apt-get -y install build-essential libncurses5-dev libssl-dev -RUN cd /tmp && curl -O 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 apt-get -y install git sudo -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 - diff --git a/erlang/Makefile b/erlang/Makefile deleted file mode 100644 index 808a2a9019..0000000000 --- a/erlang/Makefile +++ /dev/null @@ -1,44 +0,0 @@ -##################### - -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 stats stats-lisp - -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 - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*%|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*%|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" diff --git a/erlang/run b/erlang/run deleted file mode 100755 index 8ba68a5484..0000000000 --- a/erlang/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec $(dirname $0)/${STEP:-stepA_mal} "${@}" diff --git a/erlang/src/step2_eval.erl b/erlang/src/step2_eval.erl deleted file mode 100644 index 39dfd6942c..0000000000 --- a/erlang/src/step2_eval.erl +++ /dev/null @@ -1,80 +0,0 @@ -%%% -%%% 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 eval_ast({list, List, Meta}, Env) of - {list, [F|Args], _M} -> erlang:apply(F, [Args]); - _ -> {error, "expected a list"} - end; -eval(Value, Env) -> - eval_ast(Value, Env). - -eval_ast(Value, Env) -> - EvalList = fun(Elem) -> - eval(Elem, Env) - end, - EvalMap = fun(_Key, Val) -> - eval(Val, Env) - end, - case Value of - {symbol, Sym} -> - case maps:is_key(Sym, Env) of - true -> maps:get(Sym, Env); - false -> error(io_lib:format("'~s' not found", [Sym])) - end; - {list, L, Meta} -> {list, lists:map(EvalList, L), Meta}; - {vector, V, Meta} -> {vector, lists:map(EvalList, V), Meta}; - {map, M, Meta} -> {map, maps:map(EvalMap, M), Meta}; - _ -> Value - end. - -print(none) -> - % if nothing meaningful was entered, print nothing at all - ok; -print(Value) -> - io:format("~s~n", [Value]). diff --git a/erlang/src/step3_env.erl b/erlang/src/step3_env.erl deleted file mode 100644 index 2abfbea88a..0000000000 --- a/erlang/src/step3_env.erl +++ /dev/null @@ -1,100 +0,0 @@ -%%% -%%% 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({list, [], _Meta}=AST, _Env) -> - AST; -eval({list, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) -> - Result = eval(A2, Env), - env:set(Env, {symbol, A1}, Result), - Result; -eval({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) -> - error("def! called with non-symbol"); -eval({list, [{symbol, "def!"}|_], _Meta}, _Env) -> - error("def! requires exactly two arguments"); -eval({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> - NewEnv = env:new(Env), - let_star(NewEnv, A1), - eval(A2, NewEnv); -eval({list, [{symbol, "let*"}|_], _Meta}, _Env) -> - error("let* requires exactly two arguments"); -eval({list, List, Meta}, Env) -> - case eval_ast({list, List, Meta}, Env) of - {list, [{function, F, _MF}|A], _M1} -> erlang:apply(F, [A]); - _ -> error("expected a list with a function") - end; -eval(Value, Env) -> - eval_ast(Value, Env). - -eval_ast({symbol, _Sym}=Value, Env) -> - env:get(Env, Value); -eval_ast({Type, Seq, _Meta}, Env) when Type == list orelse Type == vector -> - {Type, 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/erlang/src/step4_if_fn_do.erl b/erlang/src/step4_if_fn_do.erl deleted file mode 100644 index df8e82d3b7..0000000000 --- a/erlang/src/step4_if_fn_do.erl +++ /dev/null @@ -1,128 +0,0 @@ -%%% -%%% 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({list, [], _Meta}=AST, _Env) -> - AST; -eval({list, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) -> - Result = eval(A2, Env), - env:set(Env, {symbol, A1}, Result), - Result; -eval({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) -> - error("def! called with non-symbol"); -eval({list, [{symbol, "def!"}|_], _Meta}, _Env) -> - error("def! requires exactly two arguments"); -eval({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> - NewEnv = env:new(Env), - let_star(NewEnv, A1), - eval(A2, NewEnv); -eval({list, [{symbol, "let*"}|_], _Meta}, _Env) -> - error("let* requires exactly two arguments"); -eval({list, [{symbol, "do"}|Args], _Meta}, Env) -> - {list, Results, _M2} = eval_ast({list, Args, nil}, Env), - lists:last(Results); -eval({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, [{symbol, "if"}|_], _Meta}, _Env) -> - error("if requires test and consequent"); -eval({list, [{symbol, "fn*"}, {vector, Binds, _M1}, Body], _Meta}, Env) -> - {closure, fun eval/2, Binds, Body, Env, nil}; -eval({list, [{symbol, "fn*"}, {list, Binds, _M1}, Body], _Meta}, Env) -> - {closure, fun eval/2, Binds, Body, Env, nil}; -eval({list, [{symbol, "fn*"}|_], _Meta}, _Env) -> - error("fn* requires 2 arguments"); -eval({list, List, Meta}, Env) -> - case eval_ast({list, List, Meta}, Env) of - {list, [{closure, _Eval, Binds, Body, CE, _M1}|A], _M3} -> - % 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. - NewEnv = env:new(CE), - env:bind(NewEnv, Binds, lists:flatten([A])), - eval(Body, NewEnv); - {list, [{function, F, _MF}|A], _M4} -> erlang:apply(F, [A]); - _ -> error("expected a list") - end; -eval(Value, Env) -> - eval_ast(Value, Env). - -eval_ast({symbol, _Sym}=Value, Env) -> - env:get(Env, Value); -eval_ast({Type, Seq, _Meta}, Env) when Type == list orelse Type == vector -> - {Type, 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/erlang/src/step5_tco.erl b/erlang/src/step5_tco.erl deleted file mode 100644 index 933d7450e6..0000000000 --- a/erlang/src/step5_tco.erl +++ /dev/null @@ -1,128 +0,0 @@ -%%% -%%% 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({list, [], _Meta}=AST, _Env) -> - AST; -eval({list, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) -> - Result = eval(A2, Env), - env:set(Env, {symbol, A1}, Result), - Result; -eval({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) -> - error("def! called with non-symbol"); -eval({list, [{symbol, "def!"}|_], _Meta}, _Env) -> - error("def! requires exactly two arguments"); -eval({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> - NewEnv = env:new(Env), - let_star(NewEnv, A1), - eval(A2, NewEnv); -eval({list, [{symbol, "let*"}|_], _Meta}, _Env) -> - error("let* requires exactly two arguments"); -eval({list, [{symbol, "do"}|Args], _Meta}, Env) -> - eval_ast({list, lists:droplast(Args), nil}, Env), - eval(lists:last(Args), Env); -eval({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, [{symbol, "if"}|_], _Meta}, _Env) -> - error("if requires test and consequent"); -eval({list, [{symbol, "fn*"}, {vector, Binds, _M1}, Body], _Meta}, Env) -> - {closure, fun eval/2, Binds, Body, Env, nil}; -eval({list, [{symbol, "fn*"}, {list, Binds, _M1}, Body], _Meta}, Env) -> - {closure, fun eval/2, Binds, Body, Env, nil}; -eval({list, [{symbol, "fn*"}|_], _Meta}, _Env) -> - error("fn* requires 2 arguments"); -eval({list, List, Meta}, Env) -> - case eval_ast({list, List, Meta}, Env) of - {list, [{closure, _Eval, Binds, Body, CE, _M2}|A], _M3} -> - % 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. - NewEnv = env:new(CE), - env:bind(NewEnv, Binds, lists:flatten([A])), - eval(Body, NewEnv); - {list, [{function, F, _MF}|A], _M4} -> erlang:apply(F, [A]); - _ -> error("expected a list") - end; -eval(Value, Env) -> - eval_ast(Value, Env). - -eval_ast({symbol, _Sym}=Value, Env) -> - env:get(Env, Value); -eval_ast({Type, Seq, _Meta}, Env) when Type == list orelse Type == vector -> - {Type, 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/erlang/src/step6_file.erl b/erlang/src/step6_file.erl deleted file mode 100644 index 4b1ea4d8d1..0000000000 --- a/erlang/src/step6_file.erl +++ /dev/null @@ -1,145 +0,0 @@ -%%% -%%% 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) \")\")))))"), 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({list, [], _Meta}=AST, _Env) -> - AST; -eval({list, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) -> - Result = eval(A2, Env), - env:set(Env, {symbol, A1}, Result), - Result; -eval({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) -> - error("def! called with non-symbol"); -eval({list, [{symbol, "def!"}|_], _Meta}, _Env) -> - error("def! requires exactly two arguments"); -eval({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> - NewEnv = env:new(Env), - let_star(NewEnv, A1), - eval(A2, NewEnv); -eval({list, [{symbol, "let*"}|_], _Meta}, _Env) -> - error("let* requires exactly two arguments"); -eval({list, [{symbol, "do"}|Args], _Meta}, Env) -> - eval_ast({list, lists:droplast(Args), nil}, Env), - eval(lists:last(Args), Env); -eval({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, [{symbol, "if"}|_], _Meta}, _Env) -> - error("if requires test and consequent"); -eval({list, [{symbol, "fn*"}, {vector, Binds, _M1}, Body], _Meta}, Env) -> - {closure, fun eval/2, Binds, Body, Env, nil}; -eval({list, [{symbol, "fn*"}, {list, Binds, _M1}, Body], _Meta}, Env) -> - {closure, fun eval/2, Binds, Body, Env, nil}; -eval({list, [{symbol, "fn*"}|_], _Meta}, _Env) -> - error("fn* requires 2 arguments"); -eval({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, [{symbol, "eval"}|_], _Meta}, _Env) -> - error("eval requires 1 argument"); -eval({list, List, Meta}, Env) -> - case eval_ast({list, List, Meta}, Env) of - {list, [{closure, _Eval, Binds, Body, CE, _M1}|A], _M2} -> - % 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. - NewEnv = env:new(CE), - env:bind(NewEnv, Binds, lists:flatten([A])), - eval(Body, NewEnv); - {list, [{function, F, _MF}|A], _M3} -> erlang:apply(F, [A]); - {list, [{error, Reason}], _M4} -> {error, Reason}; - _ -> error("expected a list") - end; -eval(Value, Env) -> - eval_ast(Value, Env). - -eval_ast({symbol, _Sym}=Value, Env) -> - env:get(Env, Value); -eval_ast({Type, Seq, _Meta}, Env) when Type == list orelse Type == vector -> - {Type, 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/erlang/src/step7_quote.erl b/erlang/src/step7_quote.erl deleted file mode 100644 index 3ad11910f4..0000000000 --- a/erlang/src/step7_quote.erl +++ /dev/null @@ -1,179 +0,0 @@ -%%% -%%% 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) \")\")))))"), 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({list, [], _Meta}=AST, _Env) -> - AST; -eval({list, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) -> - Result = eval(A2, Env), - env:set(Env, {symbol, A1}, Result), - Result; -eval({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) -> - error("def! called with non-symbol"); -eval({list, [{symbol, "def!"}|_], _Meta}, _Env) -> - error("def! requires exactly two arguments"); -eval({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> - NewEnv = env:new(Env), - let_star(NewEnv, A1), - eval(A2, NewEnv); -eval({list, [{symbol, "let*"}|_], _Meta}, _Env) -> - error("let* requires exactly two arguments"); -eval({list, [{symbol, "do"}|Args], _Meta}, Env) -> - eval_ast({list, lists:droplast(Args), nil}, Env), - eval(lists:last(Args), Env); -eval({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, [{symbol, "if"}|_], _Meta}, _Env) -> - error("if requires test and consequent"); -eval({list, [{symbol, "fn*"}, {vector, Binds, _M1}, Body], _Meta}, Env) -> - {closure, fun eval/2, Binds, Body, Env, nil}; -eval({list, [{symbol, "fn*"}, {list, Binds, _M1}, Body], _Meta}, Env) -> - {closure, fun eval/2, Binds, Body, Env, nil}; -eval({list, [{symbol, "fn*"}|_], _Meta}, _Env) -> - error("fn* requires 2 arguments"); -eval({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, [{symbol, "eval"}|_], _Meta}, _Env) -> - error("eval requires 1 argument"); -eval({list, [{symbol, "quote"}, AST], _Meta}, _Env) -> - AST; -eval({list, [{symbol, "quote"}|_], _Meta}, _Env) -> - error("quote requires 1 argument"); -eval({list, [{symbol, "quasiquote"}, AST], _Meta}, Env) -> - eval(quasiquote(AST), Env); -eval({list, [{symbol, "quasiquote"}|_], _Meta}, _Env) -> - error("quasiquote requires 1 argument"); -eval({list, List, Meta}, Env) -> - case eval_ast({list, List, Meta}, Env) of - {list, [{closure, _Eval, Binds, Body, CE, _M1}|A], _M2} -> - % 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. - NewEnv = env:new(CE), - env:bind(NewEnv, Binds, lists:flatten([A])), - eval(Body, NewEnv); - {list, [{function, F, _MF}|A], _M3} -> erlang:apply(F, [A]); - {list, [{error, Reason}], _M4} -> {error, Reason}; - _ -> error("expected a list") - end; -eval(Value, Env) -> - eval_ast(Value, Env). - -eval_ast({symbol, _Sym}=Value, Env) -> - env:get(Env, Value); -eval_ast({Type, Seq, _Meta}, Env) when Type == list orelse Type == vector -> - {Type, 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]). - -quasiquote({T, [{list, [{symbol, "splice-unquote"}, First], _M1}|Rest], _M2}) when T == list orelse T == vector -> - % 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. - {list, [{symbol, "concat"}, First] ++ [quasiquote({list, Rest, nil})], nil}; -quasiquote({T, [{symbol, "splice-unquote"}], _M}) when T == list orelse T == vector -> - {error, "splice-unquote requires an argument"}; -quasiquote({T, [{symbol, "unquote"}, AST], _M}) when T == list orelse T == vector -> - % 2. else if the first element of ast is a symbol named "unquote": return - % the second element of ast. - AST; -quasiquote({T, [{symbol, "unquote"}|_], _M}) when T == list orelse T == vector -> - {error, "unquote expects one argument"}; -quasiquote({T, [First|Rest], _M}) when T == list orelse T == vector -> - % 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. - {list, [{symbol, "cons"}, quasiquote(First)] ++ [quasiquote({list, Rest, nil})], nil}; -quasiquote(AST) -> - % 1. if is_pair of ast is false: return a new list containing: - % a symbol named "quote" and ast. - {list, [{symbol, "quote"}, AST], nil}. diff --git a/erlang/src/step8_macros.erl b/erlang/src/step8_macros.erl deleted file mode 100644 index 8f7bccaf20..0000000000 --- a/erlang/src/step8_macros.erl +++ /dev/null @@ -1,233 +0,0 @@ -%%% -%%% 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) \")\")))))"), 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), - eval(read("(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))))))))"), 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 Value of - {list, _L1, _M1} -> - case macroexpand(Value, Env) of - {list, _L2, _M2} = List -> eval_list(List, Env); - AST -> eval_ast(AST, Env) - end; - _ -> eval_ast(Value, Env) - end. - -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) -> - eval_ast({list, lists:droplast(Args), nil}, Env), - 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, 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, "macroexpand"}, Macro], _Meta}, Env) -> - macroexpand(Macro, Env); -eval_list({list, [{symbol, "macroexpand"}], _Meta}, _Env) -> - error("macroexpand requires 1 argument"); -eval_list({list, List, Meta}, Env) -> - case eval_ast({list, List, Meta}, Env) of - {list, [{closure, _Eval, Binds, Body, CE, _MC}|A], _M1} -> - % 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. - NewEnv = env:new(CE), - env:bind(NewEnv, Binds, lists:flatten([A])), - eval(Body, NewEnv); - {list, [{function, F, _MF}|A], _M2} -> erlang:apply(F, [A]); - {list, [{error, Reason}], _M3} -> {error, Reason}; - _ -> error("expected a list") - end. - -eval_ast({symbol, _Sym}=Value, Env) -> - env:get(Env, Value); -eval_ast({Type, Seq, _Meta}, Env) when Type == list orelse Type == vector -> - {Type, 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]). - -quasiquote({T, [{list, [{symbol, "splice-unquote"}, First], _M1}|Rest], _M2}) when T == list orelse T == vector -> - % 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. - {list, [{symbol, "concat"}, First] ++ [quasiquote({list, Rest, nil})], nil}; -quasiquote({T, [{symbol, "splice-unquote"}], _M}) when T == list orelse T == vector -> - {error, "splice-unquote requires an argument"}; -quasiquote({T, [{symbol, "unquote"}, AST], _M}) when T == list orelse T == vector -> - % 2. else if the first element of ast is a symbol named "unquote": return - % the second element of ast. - AST; -quasiquote({T, [{symbol, "unquote"}|_], _M}) when T == list orelse T == vector -> - {error, "unquote expects one argument"}; -quasiquote({T, [First|Rest], _M}) when T == list orelse T == vector -> - % 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. - {list, [{symbol, "cons"}, quasiquote(First)] ++ [quasiquote({list, Rest, nil})], nil}; -quasiquote(AST) -> - % 1. if is_pair of ast is false: return a new list containing: - % a symbol named "quote" and ast. - {list, [{symbol, "quote"}, AST], nil}. - -is_macro_call({list, [{symbol, Name}|_], _Meta}, Env) -> - case env:find(Env, {symbol, Name}) of - nil -> false; - Env2 -> - case env:get(Env2, {symbol, Name}) of - {macro, _Binds, _Body, _ME} -> true; - _ -> false - end - end; -is_macro_call(_AST, _Env) -> - false. - -macroexpand(AST, Env) -> - case is_macro_call(AST, Env) of - true -> - {list, [Name|A], _Meta} = AST, - {macro, Binds, Body, ME} = env:get(Env, Name), - NewEnv = env:new(ME), - env:bind(NewEnv, Binds, lists:flatten([A])), - NewAST = eval(Body, NewEnv), - macroexpand(NewAST, Env); - false -> AST - end. diff --git a/erlang/src/step9_try.erl b/erlang/src/step9_try.erl deleted file mode 100644 index 41116205e8..0000000000 --- a/erlang/src/step9_try.erl +++ /dev/null @@ -1,248 +0,0 @@ -%%% -%%% 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) \")\")))))"), 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), - eval(read("(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))))))))"), 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 Value of - {list, _L1, _M1} -> - case macroexpand(Value, Env) of - {list, _L2, _M2} = List -> eval_list(List, Env); - AST -> eval_ast(AST, Env) - end; - _ -> eval_ast(Value, Env) - end. - -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) -> - eval_ast({list, lists:droplast(Args), nil}, Env), - 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, 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, "macroexpand"}, Macro], _Meta}, Env) -> - macroexpand(Macro, Env); -eval_list({list, [{symbol, "macroexpand"}], _Meta}, _Env) -> - error("macroexpand requires 1 argument"); -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*"}|_], _Meta}, _Env) -> - error("try*/catch* must be of the form (try* A (catch* B C))"); -eval_list({list, List, Meta}, Env) -> - case eval_ast({list, List, Meta}, Env) of - {list, [{closure, _Eval, Binds, Body, CE, _MC}|A], _M1} -> - % 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. - NewEnv = env:new(CE), - env:bind(NewEnv, Binds, lists:flatten([A])), - eval(Body, NewEnv); - {list, [{function, F, _MF}|A], _M2} -> erlang:apply(F, [A]); - {list, [{error, Reason}], _M3} -> {error, Reason}; - _ -> error("expected a list") - end. - -eval_ast({symbol, _Sym}=Value, Env) -> - env:get(Env, Value); -eval_ast({Type, Seq, _Meta}, Env) when Type == list orelse Type == vector -> - {Type, 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]). - -quasiquote({T, [{list, [{symbol, "splice-unquote"}, First], _M1}|Rest], _M2}) when T == list orelse T == vector -> - % 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. - {list, [{symbol, "concat"}, First] ++ [quasiquote({list, Rest, nil})], nil}; -quasiquote({T, [{symbol, "splice-unquote"}], _M}) when T == list orelse T == vector -> - {error, "splice-unquote requires an argument"}; -quasiquote({T, [{symbol, "unquote"}, AST], _M}) when T == list orelse T == vector -> - % 2. else if the first element of ast is a symbol named "unquote": return - % the second element of ast. - AST; -quasiquote({T, [{symbol, "unquote"}|_], _M}) when T == list orelse T == vector -> - {error, "unquote expects one argument"}; -quasiquote({T, [First|Rest], _M}) when T == list orelse T == vector -> - % 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. - {list, [{symbol, "cons"}, quasiquote(First)] ++ [quasiquote({list, Rest, nil})], nil}; -quasiquote(AST) -> - % 1. if is_pair of ast is false: return a new list containing: - % a symbol named "quote" and ast. - {list, [{symbol, "quote"}, AST], nil}. - -is_macro_call({list, [{symbol, Name}|_], _Meta}, Env) -> - case env:find(Env, {symbol, Name}) of - nil -> false; - Env2 -> - case env:get(Env2, {symbol, Name}) of - {macro, _Binds, _Body, _ME} -> true; - _ -> false - end - end; -is_macro_call(_AST, _Env) -> - false. - -macroexpand(AST, Env) -> - case is_macro_call(AST, Env) of - true -> - {list, [Name|A], _M2} = AST, - {macro, Binds, Body, ME} = env:get(Env, Name), - NewEnv = env:new(ME), - env:bind(NewEnv, Binds, lists:flatten([A])), - NewAST = eval(Body, NewEnv), - macroexpand(NewAST, Env); - false -> AST - end. diff --git a/erlang/src/stepA_mal.erl b/erlang/src/stepA_mal.erl deleted file mode 100644 index b763f2bb15..0000000000 --- a/erlang/src/stepA_mal.erl +++ /dev/null @@ -1,252 +0,0 @@ -%%% -%%% 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) \")\")))))"), 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), - eval(read("(def! *gensym-counter* (atom 0))"), Env), - eval(read("(def! gensym (fn* [] (symbol (str \"G__\" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))"), Env), - eval(read("(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)))))))))"), 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 Value of - {list, _L1, _M1} -> - case macroexpand(Value, Env) of - {list, _L2, _M2} = List -> eval_list(List, Env); - AST -> eval_ast(AST, Env) - end; - _ -> eval_ast(Value, Env) - end. - -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) -> - eval_ast({list, lists:droplast(Args), nil}, Env), - 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, 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, "macroexpand"}, Macro], _Meta}, Env) -> - macroexpand(Macro, Env); -eval_list({list, [{symbol, "macroexpand"}], _Meta}, _Env) -> - error("macroexpand requires 1 argument"); -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*"}|_], _Meta}, _Env) -> - error("try*/catch* must be of the form (try* A (catch* B C))"); -eval_list({list, List, Meta}, Env) -> - case eval_ast({list, List, Meta}, Env) of - {list, [{closure, _Eval, Binds, Body, CE, _MC}|A], _M2} -> - % 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. - NewEnv = env:new(CE), - env:bind(NewEnv, Binds, lists:flatten([A])), - eval(Body, NewEnv); - {list, [{function, F, _MF}|A], _M3} -> erlang:apply(F, [A]); - {list, [{error, Reason}], _M4} -> {error, Reason}; - _ -> error("expected a list") - end. - -eval_ast({symbol, _Sym}=Value, Env) -> - env:get(Env, Value); -eval_ast({Type, Seq, _Meta}, Env) when Type == list orelse Type == vector -> - {Type, 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]). - -quasiquote({T, [{list, [{symbol, "splice-unquote"}, First], _M1}|Rest], _M2}) when T == list orelse T == vector -> - % 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. - {list, [{symbol, "concat"}, First] ++ [quasiquote({list, Rest, nil})], nil}; -quasiquote({T, [{symbol, "splice-unquote"}], _M}) when T == list orelse T == vector -> - {error, "splice-unquote requires an argument"}; -quasiquote({T, [{symbol, "unquote"}, AST], _M}) when T == list orelse T == vector -> - % 2. else if the first element of ast is a symbol named "unquote": return - % the second element of ast. - AST; -quasiquote({T, [{symbol, "unquote"}|_], _M}) when T == list orelse T == vector -> - {error, "unquote expects one argument"}; -quasiquote({T, [First|Rest], _M}) when T == list orelse T == vector -> - % 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. - {list, [{symbol, "cons"}, quasiquote(First)] ++ [quasiquote({list, Rest, nil})], nil}; -quasiquote(AST) -> - % 1. if is_pair of ast is false: return a new list containing: - % a symbol named "quote" and ast. - {list, [{symbol, "quote"}, AST], nil}. - -is_macro_call({list, [{symbol, Name}|_], _Meta}, Env) -> - case env:find(Env, {symbol, Name}) of - nil -> false; - Env2 -> - case env:get(Env2, {symbol, Name}) of - {macro, _Binds, _Body, _ME} -> true; - _ -> false - end - end; -is_macro_call(_AST, _Env) -> - false. - -macroexpand(AST, Env) -> - case is_macro_call(AST, Env) of - true -> - {list, [Name|A], _Meta} = AST, - {macro, Binds, Body, ME} = env:get(Env, Name), - NewEnv = env:new(ME), - env:bind(NewEnv, Binds, lists:flatten([A])), - NewAST = eval(Body, NewEnv), - macroexpand(NewAST, Env); - false -> AST - end. diff --git a/es6/Dockerfile b/es6/Dockerfile deleted file mode 100644 index b2033c1e6a..0000000000 --- a/es6/Dockerfile +++ /dev/null @@ -1,39 +0,0 @@ -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 node modules -RUN apt-get -y install g++ - -# Add nodesource apt repo config for 0.12 stable -RUN curl -sL https://deb.nodesource.com/setup_0.12 | bash - - -# Install nodejs -RUN apt-get -y install nodejs - -# Link common name -RUN ln -sf nodejs /usr/bin/node - -ENV NPM_CONFIG_CACHE /mal/.npm - -# ES6 -RUN npm install -g babel diff --git a/es6/Makefile b/es6/Makefile deleted file mode 100644 index d576e5b51e..0000000000 --- a/es6/Makefile +++ /dev/null @@ -1,59 +0,0 @@ - -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) - -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: node_modules $(foreach s,$(STEPS),build/$(s).js) - -dist: mal.js mal - -build/%.js: %.js - @mkdir -p $(dir $@) - babel --source-maps true $< --out-file $@ - @echo >> $@ # workaround node-uglifier bug - -mal.js: $(foreach s,$(SOURCES),build/$(s)) - node -e 'nu = new (require("node-uglifier"))("./build/stepA_mal.js"); nu.merge().exportToFile("$@")' - -mal: mal.js - echo "#!/usr/bin/env node" > $@ - cat $< >> $@ - chmod +x $@ - -build/step0_repl.js: step0_repl.js build/node_readline.js -build/step1_read_print.js: step1_read_print.js build/node_readline.js build/types.js build/reader.js build/printer.js -build/step2_eval.js: step2_eval.js build/node_readline.js build/types.js build/reader.js build/printer.js -build/step3_env.js: step3_env.js build/node_readline.js build/types.js build/reader.js build/printer.js build/env.js -build/step4_if_fn_do.js: step4_if_fn_do.js build/node_readline.js build/types.js build/reader.js build/printer.js build/env.js build/core.js -build/step5_tco.js: step5_tco.js build/node_readline.js build/types.js build/reader.js build/printer.js build/env.js build/core.js -build/step6_file.js: step6_file.js build/node_readline.js build/types.js build/reader.js build/printer.js build/env.js build/core.js -build/step7_quote.js: step7_quote.js build/node_readline.js build/types.js build/reader.js build/printer.js build/env.js build/core.js -build/step8_macros.js: step8_macros.js build/node_readline.js build/types.js build/reader.js build/printer.js build/env.js build/core.js -build/step9_try.js: step9_try.js build/node_readline.js build/types.js build/reader.js build/printer.js build/env.js build/core.js -build/stepA_mal.js: stepA_mal.js build/node_readline.js build/types.js build/reader.js build/printer.js build/env.js build/core.js - - -node_modules: - npm install - -clean: - rm -f build/* mal.js mal - -.PHONY: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" - -tests: $(TESTS) - -$(TESTS): - @echo "Running $@"; \ - node $@ || exit 1; \ diff --git a/es6/core.js b/es6/core.js deleted file mode 100644 index 621b7c62ec..0000000000 --- a/es6/core.js +++ /dev/null @@ -1,145 +0,0 @@ -import { _equal_Q, _clone, _list_Q, _sequential_Q, - _keyword, _keyword_Q, _vector, _vector_Q, - _hash_map, _hash_map_Q, _assoc_BANG, _dissoc_BANG, - _symbol, _symbol_Q, Atom } from './types' -import { pr_str } from './printer' -import { readline } from './node_readline' -import { read_str } from './reader' - -// Errors/Exceptions -function mal_throw(exc) { throw exc; } - -// String functions -function slurp(f) { - if (typeof require !== 'undefined') { - return require('fs').readFileSync(f, 'utf-8') - } else { - var req = new XMLHttpRequest() - req.open('GET', f, false) - req.send() - if (req.status == 200) { - return req.responseText - } else { - throw new Error(`Failed to slurp file: ${f}`) - } - } -} - -// Sequence functions -function nth(lst, idx) { - if (idx < lst.length) { return lst[idx]; } - else { throw new Error('nth: index out of range'); } -} - -function conj(lst, ...args) { - if (_list_Q(lst)) { - return args.reverse().concat(lst) - } else { - return _vector(...lst.concat(args)) - } -} - -function seq(obj) { - if (_list_Q(obj)) { - return obj.length > 0 ? obj : null - } else if (_vector_Q(obj)) { - return obj.length > 0 ? obj.slice(0) : null - } else if (typeof obj === "string" && obj[0] !== '\u029e') { - return obj.length > 0 ? obj.split('') : null - } else if (obj === null) { - return null - } else { - throw new Error('seq: called on non-sequence') - } -} - -// hash-map functions - -function keys(hm) { - // TODO: Array.from(hm.keys()) when supported - let ks = [] - for (let k of hm.keys()) { ks.push(k) } - return ks -} - -function vals(hm) { - // TODO: Array.from(hm.keys()) when supported - let vs = [] - for (let v of hm.values()) { vs.push(v) } - return vs -} - -// Metadata functions -function with_meta(obj, m) { - let new_obj = _clone(obj) - new_obj.meta = m - return new_obj -} - -// core_ns is namespace of type functions -export const core_ns = new Map([ - ['=', _equal_Q], - ['throw', mal_throw], - - ['nil?', a => a === null], - ['true?', a => a === true], - ['false?', a => a === false], - ['string?', a => typeof a === "string" && a[0] !== '\u029e'], - ['symbol', a => _symbol(a)], - ['symbol?', a => _symbol_Q(a)], - ['keyword', a => _keyword(a)], - ['keyword?', a => _keyword_Q(a)], - - ['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', _vector], - ['vector?', _vector_Q], - ['hash-map', _hash_map], - ['map?', _hash_map_Q], - ['assoc', (m,...a) => _assoc_BANG(_clone(m), ...a)], - ['dissoc', (m,...a) => _dissoc_BANG(_clone(m), ...a)], - ['get', (m,a) => m === null ? null : m.has(a) ? m.get(a) : null], - ['contains?', (m,a) => m.has(a)], - ['keys', keys], - ['vals', vals], - - ['sequential?', _sequential_Q], - ['cons', (a,b) => [a].concat(b)], - ['concat', (...a) => a.reduce((x,y) => x.concat(y), [])], - ['nth', nth], - ['first', a => a !== null && a.length > 0 ? a[0] : null], - ['rest', a => a === null ? [] : 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) => a.map(x => f(x))], - - ['conj', conj], - ['seq', seq], - - ['meta', a => 'meta' in a ? a['meta'] : null], - ['with-meta', with_meta], - ['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/es6/env.js b/es6/env.js deleted file mode 100644 index b2a9429c40..0000000000 --- a/es6/env.js +++ /dev/null @@ -1,21 +0,0 @@ -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] - } else { - throw Error(`'${Symbol.keyFor(sym)}' not found`) - } -} -export const env_set = (env, sym, val) => env[sym] = val diff --git a/es6/node_readline.js b/es6/node_readline.js deleted file mode 100644 index dd5db0b68e..0000000000 --- a/es6/node_readline.js +++ /dev/null @@ -1,43 +0,0 @@ -// 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 ffi = require('ffi'), - fs = require('fs'); - -var rllib = ffi.Library(RL_LIB, { - 'readline': [ 'string', [ 'string' ] ], - 'add_history': [ 'int', [ 'string' ] ]}); - -var rl_history_loaded = false; - -export 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 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/es6/step1_read_print.js b/es6/step1_read_print.js deleted file mode 100644 index 6b1d1c8033..0000000000 --- a/es6/step1_read_print.js +++ /dev/null @@ -1,27 +0,0 @@ -import { readline } from './node_readline' -import { BlankException, read_str } from './reader' -import { pr_str } from './printer' - -// 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.stack) { console.log(exc.stack); } - else { console.log(`Error: ${exc}`); } - } -} diff --git a/es6/step2_eval.js b/es6/step2_eval.js deleted file mode 100644 index 3622ab8d28..0000000000 --- a/es6/step2_eval.js +++ /dev/null @@ -1,61 +0,0 @@ -import { readline } from './node_readline' -import { _symbol, _symbol_Q, _list_Q, _vector, _vector_Q, - _hash_map_Q } from './types' -import { BlankException, read_str } from './reader' -import { pr_str } from './printer' - -// read -const READ = (str) => read_str(str) - -// eval -const eval_ast = (ast, env) => { - if (_symbol_Q(ast)) { - if (ast in env) { - return env[ast] - } else { - throw Error(`'${Symbol.keyFor(ast)}' not found`) - } - } else if (_list_Q(ast)) { - return ast.map((x) => EVAL(x, env)) - } else if (_vector_Q(ast)) { - return _vector(...ast.map((x) => EVAL(x, env))) - } else if (_hash_map_Q(ast)) { - let new_hm = new Map() - for (let [k, v] of ast) { - new_hm.set(EVAL(k, env), EVAL(v, env)) - } - return new_hm - } else { - return ast - } -} - -const EVAL = (ast, env) => { - if (!_list_Q(ast)) { return eval_ast(ast, env) } - if (ast.length === 0) { return ast } - - const [f, ...args] = eval_ast(ast, env) - return f(...args) -} - -// print -const PRINT = (exp) => pr_str(exp, true) - -// repl -var repl_env = {[_symbol('+')]: (a,b) => a+b, - [_symbol('-')]: (a,b) => a-b, - [_symbol('*')]: (a,b) => a*b, - [_symbol('/')]: (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.stack) { console.log(exc.stack); } - else { console.log(`Error: ${exc}`); } - } -} diff --git a/es6/step3_env.js b/es6/step3_env.js deleted file mode 100644 index 10de2c2f53..0000000000 --- a/es6/step3_env.js +++ /dev/null @@ -1,73 +0,0 @@ -import { readline } from './node_readline' -import { _symbol, _symbol_Q, _list_Q, _vector, _vector_Q, - _hash_map_Q } from './types' -import { BlankException, read_str } from './reader' -import { pr_str } from './printer' -import { new_env, env_set, env_get } from './env' - -// read -const READ = (str) => read_str(str) - -// eval -const eval_ast = (ast, env) => { - if (_symbol_Q(ast)) { - return env_get(env, ast) - } else if (_list_Q(ast)) { - return ast.map((x) => EVAL(x, env)) - } else if (_vector_Q(ast)) { - return _vector(...ast.map((x) => EVAL(x, env))) - } else if (_hash_map_Q(ast)) { - let new_hm = new Map() - for (let [k, v] of ast) { - new_hm.set(EVAL(k, env), EVAL(v, env)) - } - return new_hm - } else { - return ast - } -} - -const EVAL = (ast, env) => { - //console.log('EVAL:', pr_str(ast, true)) - if (!_list_Q(ast)) { return eval_ast(ast, env) } - if (ast.length === 0) { return ast } - - const [a0, a1, a2, a3] = ast - const a0sym = _symbol_Q(a0) ? Symbol.keyFor(a0) : Symbol(':default') - switch (a0sym) { - 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: - let [f, ...args] = eval_ast(ast, env) - return f(...args) - } -} - -// print -const PRINT = (exp) => pr_str(exp, true) - -// repl -let repl_env = new_env() -env_set(repl_env, _symbol('+'), (a,b) => a+b) -env_set(repl_env, _symbol('-'), (a,b) => a-b) -env_set(repl_env, _symbol('*'), (a,b) => a*b) -env_set(repl_env, _symbol('/'), (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.stack) { console.log(exc.stack); } - else { console.log(`Error: ${exc}`); } - } -} diff --git a/es6/step4_if_fn_do.js b/es6/step4_if_fn_do.js deleted file mode 100644 index dca40df45f..0000000000 --- a/es6/step4_if_fn_do.js +++ /dev/null @@ -1,87 +0,0 @@ -import { readline } from './node_readline' -import { _symbol, _symbol_Q, _list_Q, _vector, _vector_Q, - _hash_map_Q } from './types' -import { BlankException, read_str } from './reader' -import { pr_str } from './printer' -import { new_env, env_set, env_get } from './env' -import { core_ns } from './core' - -// read -const READ = (str) => read_str(str) - -// eval -const eval_ast = (ast, env) => { - if (_symbol_Q(ast)) { - return env_get(env, ast) - } else if (_list_Q(ast)) { - return ast.map((x) => EVAL(x, env)) - } else if (_vector_Q(ast)) { - return _vector(...ast.map((x) => EVAL(x, env))) - } else if (_hash_map_Q(ast)) { - let new_hm = new Map() - for (let [k, v] of ast) { - new_hm.set(EVAL(k, env), EVAL(v, env)) - } - return new_hm - } else { - return ast - } -} - -const EVAL = (ast, env) => { - //console.log('EVAL:', pr_str(ast, true)) - if (!_list_Q(ast)) { return eval_ast(ast, env) } - if (ast.length === 0) { return ast } - - const [a0, a1, a2, a3] = ast - const a0sym = _symbol_Q(a0) ? Symbol.keyFor(a0) : Symbol(':default') - switch (a0sym) { - 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 eval_ast(ast.slice(1), 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: - let [f, ...args] = eval_ast(ast, 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(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.stack) { console.log(exc.stack); } - else { console.log(`Error: ${exc}`); } - } -} diff --git a/es6/step5_tco.js b/es6/step5_tco.js deleted file mode 100644 index 37c7fc0d30..0000000000 --- a/es6/step5_tco.js +++ /dev/null @@ -1,101 +0,0 @@ -import { readline } from './node_readline' -import { _symbol, _symbol_Q, _list_Q, _vector, _vector_Q, - _hash_map_Q, _malfunc, _malfunc_Q } from './types' -import { BlankException, read_str } from './reader' -import { pr_str } from './printer' -import { new_env, env_set, env_get } from './env' -import { core_ns } from './core' - -// read -const READ = (str) => read_str(str) - -// eval -const eval_ast = (ast, env) => { - if (_symbol_Q(ast)) { - return env_get(env, ast) - } else if (_list_Q(ast)) { - return ast.map((x) => EVAL(x, env)) - } else if (_vector_Q(ast)) { - return _vector(...ast.map((x) => EVAL(x, env))) - } else if (_hash_map_Q(ast)) { - let new_hm = new Map() - for (let [k, v] of ast) { - new_hm.set(EVAL(k, env), EVAL(v, env)) - } - return new_hm - } else { - return ast - } -} - -const EVAL = (ast, env) => { - while (true) { - //console.log('EVAL:', pr_str(ast, true)) - if (!_list_Q(ast)) { return eval_ast(ast, env) } - if (ast.length === 0) { return ast } - - const [a0, a1, a2, a3] = ast - const a0sym = _symbol_Q(a0) ? Symbol.keyFor(a0) : Symbol(':default') - switch (a0sym) { - 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': - eval_ast(ast.slice(1,-1), 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: - let [f, ...args] = eval_ast(ast, 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(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.stack) { console.log(exc.stack); } - else { console.log(`Error: ${exc}`); } - } -} diff --git a/es6/step6_file.js b/es6/step6_file.js deleted file mode 100644 index 00314bf6c2..0000000000 --- a/es6/step6_file.js +++ /dev/null @@ -1,111 +0,0 @@ -import { readline } from './node_readline' -import { _symbol, _symbol_Q, _list_Q, _vector, _vector_Q, - _hash_map_Q, _malfunc, _malfunc_Q } from './types' -import { BlankException, read_str } from './reader' -import { pr_str } from './printer' -import { new_env, env_set, env_get } from './env' -import { core_ns } from './core' - -// read -const READ = (str) => read_str(str) - -// eval -const eval_ast = (ast, env) => { - if (_symbol_Q(ast)) { - return env_get(env, ast) - } else if (_list_Q(ast)) { - return ast.map((x) => EVAL(x, env)) - } else if (_vector_Q(ast)) { - return _vector(...ast.map((x) => EVAL(x, env))) - } else if (_hash_map_Q(ast)) { - let new_hm = new Map() - for (let [k, v] of ast) { - new_hm.set(EVAL(k, env), EVAL(v, env)) - } - return new_hm - } else { - return ast - } -} - -const EVAL = (ast, env) => { - while (true) { - //console.log('EVAL:', pr_str(ast, true)) - if (!_list_Q(ast)) { return eval_ast(ast, env) } - if (ast.length === 0) { return ast } - - const [a0, a1, a2, a3] = ast - const a0sym = _symbol_Q(a0) ? Symbol.keyFor(a0) : Symbol(':default') - switch (a0sym) { - 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': - eval_ast(ast.slice(1,-1), 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: - let [f, ...args] = eval_ast(ast, 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(k), v) } -env_set(repl_env, _symbol('eval'), a => EVAL(a, repl_env)) -env_set(repl_env, _symbol('*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) ")")))))') - -if (process.argv.length > 2) { - env_set(repl_env, _symbol('*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.stack) { console.log(exc.stack); } - else { console.log(`Error: ${exc}`); } - } -} diff --git a/es6/step7_quote.js b/es6/step7_quote.js deleted file mode 100644 index f3094394f3..0000000000 --- a/es6/step7_quote.js +++ /dev/null @@ -1,130 +0,0 @@ -import { readline } from './node_readline' -import { _symbol, _symbol_Q, _list_Q, _vector, _vector_Q, - _hash_map_Q, _sequential_Q, _malfunc, _malfunc_Q } from './types' -import { BlankException, read_str } from './reader' -import { pr_str } from './printer' -import { new_env, env_set, env_get } from './env' -import { core_ns } from './core' - -// read -const READ = (str) => read_str(str) - -// eval -const is_pair = x => _sequential_Q(x) && x.length > 0 - -const quasiquote = ast => { - if (!is_pair(ast)) { - return [_symbol('quote'), ast] - } else if (ast[0] === _symbol('unquote')) { - return ast[1] - } else if (is_pair(ast[0]) && ast[0][0] === _symbol('splice-unquote')) { - return [_symbol('concat'), ast[0][1], quasiquote(ast.slice(1))] - } else { - return [_symbol('cons'), quasiquote(ast[0]), quasiquote(ast.slice(1))] - } -} - -const eval_ast = (ast, env) => { - if (_symbol_Q(ast)) { - return env_get(env, ast) - } else if (_list_Q(ast)) { - return ast.map((x) => EVAL(x, env)) - } else if (_vector_Q(ast)) { - return _vector(...ast.map((x) => EVAL(x, env))) - } else if (_hash_map_Q(ast)) { - let new_hm = new Map() - for (let [k, v] of ast) { - new_hm.set(EVAL(k, env), EVAL(v, env)) - } - return new_hm - } else { - return ast - } -} - -const EVAL = (ast, env) => { - while (true) { - //console.log('EVAL:', pr_str(ast, true)) - if (!_list_Q(ast)) { return eval_ast(ast, env) } - if (ast.length === 0) { return ast } - - const [a0, a1, a2, a3] = ast - const a0sym = _symbol_Q(a0) ? Symbol.keyFor(a0) : Symbol(':default') - switch (a0sym) { - 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': - eval_ast(ast.slice(1,-1), 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: - let [f, ...args] = eval_ast(ast, 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(k), v) } -env_set(repl_env, _symbol('eval'), a => EVAL(a, repl_env)) -env_set(repl_env, _symbol('*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) ")")))))') - -if (process.argv.length > 2) { - env_set(repl_env, _symbol('*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.stack) { console.log(exc.stack); } - else { console.log(`Error: ${exc}`); } - } -} diff --git a/es6/step8_macros.js b/es6/step8_macros.js deleted file mode 100644 index 277a5ef580..0000000000 --- a/es6/step8_macros.js +++ /dev/null @@ -1,157 +0,0 @@ -import { readline } from './node_readline' -import { _symbol, _symbol_Q, _list_Q, _vector, _vector_Q, - _hash_map_Q, _sequential_Q, _malfunc, _malfunc_Q } from './types' -import { BlankException, read_str } from './reader' -import { pr_str } from './printer' -import { new_env, env_set, env_get } from './env' -import { core_ns } from './core' - -// read -const READ = (str) => read_str(str) - -// eval -const is_pair = x => _sequential_Q(x) && x.length > 0 - -const quasiquote = ast => { - if (!is_pair(ast)) { - return [_symbol('quote'), ast] - } else if (ast[0] === _symbol('unquote')) { - return ast[1] - } else if (is_pair(ast[0]) && ast[0][0] === _symbol('splice-unquote')) { - return [_symbol('concat'), ast[0][1], quasiquote(ast.slice(1))] - } else { - return [_symbol('cons'), quasiquote(ast[0]), quasiquote(ast.slice(1))] - } -} - -function is_macro_call(ast, env) { - return _list_Q(ast) && - _symbol_Q(ast[0]) && - ast[0] in env && - env_get(env, ast[0]).ismacro -} - -function macroexpand(ast, env) { - while (is_macro_call(ast, env)) { - let mac = env_get(env, ast[0]) - ast = mac(...ast.slice(1)) - } - return ast -} - - -const eval_ast = (ast, env) => { - if (_symbol_Q(ast)) { - return env_get(env, ast) - } else if (_list_Q(ast)) { - return ast.map((x) => EVAL(x, env)) - } else if (_vector_Q(ast)) { - return _vector(...ast.map((x) => EVAL(x, env))) - } else if (_hash_map_Q(ast)) { - let new_hm = new Map() - for (let [k, v] of ast) { - new_hm.set(EVAL(k, env), EVAL(v, env)) - } - return new_hm - } else { - return ast - } -} - -const EVAL = (ast, env) => { - while (true) { - //console.log('EVAL:', pr_str(ast, true)) - if (!_list_Q(ast)) { return eval_ast(ast, env) } - - ast = macroexpand(ast, env) - if (!_list_Q(ast)) { return eval_ast(ast, env) } - if (ast.length === 0) { return ast } - - const [a0, a1, a2, a3] = ast - const a0sym = _symbol_Q(a0) ? Symbol.keyFor(a0) : Symbol(':default') - switch (a0sym) { - 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 = EVAL(a2, env) - func.ismacro = true - return env_set(env, a1, func) - case 'macroexpand': - return macroexpand(a1, env) - case 'do': - eval_ast(ast.slice(1,-1), 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: - let [f, ...args] = eval_ast(ast, 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(k), v) } -env_set(repl_env, _symbol('eval'), a => EVAL(a, repl_env)) -env_set(repl_env, _symbol('*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) ")")))))') -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.argv.length > 2) { - env_set(repl_env, _symbol('*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.stack) { console.log(exc.stack); } - else { console.log(`Error: ${exc}`); } - } -} diff --git a/es6/step9_try.js b/es6/step9_try.js deleted file mode 100644 index a50cc08ed1..0000000000 --- a/es6/step9_try.js +++ /dev/null @@ -1,168 +0,0 @@ -import { readline } from './node_readline' -import { _symbol, _symbol_Q, _list_Q, _vector, _vector_Q, - _hash_map_Q, _sequential_Q, _malfunc, _malfunc_Q } from './types' -import { BlankException, read_str } from './reader' -import { pr_str } from './printer' -import { new_env, env_set, env_get } from './env' -import { core_ns } from './core' - -// read -const READ = (str) => read_str(str) - -// eval -const is_pair = x => _sequential_Q(x) && x.length > 0 - -const quasiquote = ast => { - if (!is_pair(ast)) { - return [_symbol('quote'), ast] - } else if (ast[0] === _symbol('unquote')) { - return ast[1] - } else if (is_pair(ast[0]) && ast[0][0] === _symbol('splice-unquote')) { - return [_symbol('concat'), ast[0][1], quasiquote(ast.slice(1))] - } else { - return [_symbol('cons'), quasiquote(ast[0]), quasiquote(ast.slice(1))] - } -} - -function is_macro_call(ast, env) { - return _list_Q(ast) && - _symbol_Q(ast[0]) && - ast[0] in env && - env_get(env, ast[0]).ismacro -} - -function macroexpand(ast, env) { - while (is_macro_call(ast, env)) { - let mac = env_get(env, ast[0]) - ast = mac(...ast.slice(1)) - } - return ast -} - - -const eval_ast = (ast, env) => { - if (_symbol_Q(ast)) { - return env_get(env, ast) - } else if (_list_Q(ast)) { - return ast.map((x) => EVAL(x, env)) - } else if (_vector_Q(ast)) { - return _vector(...ast.map((x) => EVAL(x, env))) - } else if (_hash_map_Q(ast)) { - let new_hm = new Map() - for (let [k, v] of ast) { - new_hm.set(EVAL(k, env), EVAL(v, env)) - } - return new_hm - } else { - return ast - } -} - -const EVAL = (ast, env) => { - while (true) { - //console.log('EVAL:', pr_str(ast, true)) - if (!_list_Q(ast)) { return eval_ast(ast, env) } - - ast = macroexpand(ast, env) - if (!_list_Q(ast)) { return eval_ast(ast, env) } - if (ast.length === 0) { return ast } - - const [a0, a1, a2, a3] = ast - const a0sym = _symbol_Q(a0) ? Symbol.keyFor(a0) : Symbol(':default') - switch (a0sym) { - 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 = EVAL(a2, env) - func.ismacro = true - return env_set(env, a1, func) - case 'macroexpand': - return macroexpand(a1, env) - case 'try*': - try { - return EVAL(a1, env) - } catch (exc) { - if (a2 && a2[0] === _symbol('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; // 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: - let [f, ...args] = eval_ast(ast, 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(k), v) } -env_set(repl_env, _symbol('eval'), a => EVAL(a, repl_env)) -env_set(repl_env, _symbol('*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) ")")))))') -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.argv.length > 2) { - env_set(repl_env, _symbol('*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.stack) { console.log(exc.stack); } - else { console.log(`Error: ${exc}`); } - } -} diff --git a/es6/stepA_mal.js b/es6/stepA_mal.js deleted file mode 100644 index c6fda41488..0000000000 --- a/es6/stepA_mal.js +++ /dev/null @@ -1,171 +0,0 @@ -import { readline } from './node_readline' -import { _symbol, _symbol_Q, _list_Q, _vector, _vector_Q, - _hash_map_Q, _sequential_Q, _malfunc, _malfunc_Q } from './types' -import { BlankException, read_str } from './reader' -import { pr_str } from './printer' -import { new_env, env_set, env_get } from './env' -import { core_ns } from './core' - -// read -const READ = (str) => read_str(str) - -// eval -const is_pair = x => _sequential_Q(x) && x.length > 0 - -const quasiquote = ast => { - if (!is_pair(ast)) { - return [_symbol('quote'), ast] - } else if (ast[0] === _symbol('unquote')) { - return ast[1] - } else if (is_pair(ast[0]) && ast[0][0] === _symbol('splice-unquote')) { - return [_symbol('concat'), ast[0][1], quasiquote(ast.slice(1))] - } else { - return [_symbol('cons'), quasiquote(ast[0]), quasiquote(ast.slice(1))] - } -} - -function is_macro_call(ast, env) { - return _list_Q(ast) && - _symbol_Q(ast[0]) && - ast[0] in env && - env_get(env, ast[0]).ismacro -} - -function macroexpand(ast, env) { - while (is_macro_call(ast, env)) { - let mac = env_get(env, ast[0]) - ast = mac(...ast.slice(1)) - } - return ast -} - - -const eval_ast = (ast, env) => { - if (_symbol_Q(ast)) { - return env_get(env, ast) - } else if (_list_Q(ast)) { - return ast.map((x) => EVAL(x, env)) - } else if (_vector_Q(ast)) { - return _vector(...ast.map((x) => EVAL(x, env))) - } else if (_hash_map_Q(ast)) { - let new_hm = new Map() - for (let [k, v] of ast) { - new_hm.set(EVAL(k, env), EVAL(v, env)) - } - return new_hm - } else { - return ast - } -} - -const EVAL = (ast, env) => { - while (true) { - //console.log('EVAL:', pr_str(ast, true)) - if (!_list_Q(ast)) { return eval_ast(ast, env) } - - ast = macroexpand(ast, env) - if (!_list_Q(ast)) { return eval_ast(ast, env) } - if (ast.length === 0) { return ast } - - const [a0, a1, a2, a3] = ast - const a0sym = _symbol_Q(a0) ? Symbol.keyFor(a0) : Symbol(':default') - switch (a0sym) { - 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 = EVAL(a2, env) - func.ismacro = true - return env_set(env, a1, func) - case 'macroexpand': - return macroexpand(a1, env) - case 'try*': - try { - return EVAL(a1, env) - } catch (exc) { - if (a2 && a2[0] === _symbol('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; // 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: - let [f, ...args] = eval_ast(ast, 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(k), v) } -env_set(repl_env, _symbol('eval'), a => EVAL(a, repl_env)) -env_set(repl_env, _symbol('*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) ")")))))') -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! *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)))))))))') - -if (process.argv.length > 2) { - env_set(repl_env, _symbol('*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.stack) { console.log(exc.stack); } - else { console.log(`Error: ${exc}`); } - } -} diff --git a/es6/types.js b/es6/types.js deleted file mode 100644 index fb579b3cc3..0000000000 --- a/es6/types.js +++ /dev/null @@ -1,129 +0,0 @@ -// General functions - -export const _sequential_Q = lst => _list_Q(lst) || _vector_Q(lst) - -export 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 (obj === null) { return 'nil' } - else if (obj === true) { return 'true' } - else if (obj === false) { return 'false' } - 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)}'`) - } - } -} - -export function _equal_Q (a, b) { - let ota = _obj_type(a), otb = _obj_type(b) - if (!(ota === otb || (_sequential_Q(a) && _sequential_Q(b)))) { - return false - } - switch (ota) { - case 'list': - case 'vector': - if (a.length !== b.length) { return false } - for (let i=0; i f.ast ? true : false -Function.prototype.clone = function() { - let that = this - // New function instance - let f = function (...args) { return that.apply(this, args) } - // Copy properties - for (let k of Object.keys(this)) { f[k] = this[k] } - return f -} - - -// Symbols -export const _symbol = name => Symbol.for(name) -export const _symbol_Q = obj => typeof obj === 'symbol' - -// 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.__isvector__ - -// Vectors -// TODO: Extend Array when supported -export function _vector(...args) { - let v = args.slice(0) - v.__isvector__ = true - return v -} -export const _vector_Q = obj => Array.isArray(obj) && !!obj.__isvector__ - -// Hash Maps -export const _hash_map = (...args) => _assoc_BANG(new Map(), ...args) -export const _hash_map_Q = hm => hm instanceof Map -export function _assoc_BANG(hm, ...args) { - if (args % 2 === 1) { - throw new Error('Odd number of assoc arguments') - } - // Use iterator/Array.from when it works - for (let i=0; i (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/memoize.mal b/examples/memoize.mal deleted file mode 100644 index 500666c2de..0000000000 --- a/examples/memoize.mal +++ /dev/null @@ -1,53 +0,0 @@ -;; -;; memoize.mal -;; -;; Impelement `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`. -;; -;; Adapated from http://clojure.org/atoms -;; - -;; Memoize any function -(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)))))))) - -;; Naive (non-memoized) Fibonacci function -(def! fib - (fn* [n] - (if (<= n 1) - n - (+ (fib (- n 1)) (fib (- n 2)))))) - - -;; ----------------------------------------------- -;; Benchmarks - -(load-file "../perf.mal") ; for the 'time' macro -(def! N 32) - -;; Benchmark naive 'fib' - -(println "fib N=" N ": without memoization:") -(time (fib N)) -;; "Elapsed time: 14402 msecs" - - -;; Benchmark memoized 'fib' - -(def! fib (memoize fib)) - -(println "fib N=" N ": with memoization:") -(time (fib N)) -;; "Elapsed time: 1 msecs" diff --git a/examples/pprint.mal b/examples/pprint.mal deleted file mode 100644 index 5039215b49..0000000000 --- a/examples/pprint.mal +++ /dev/null @@ -1,41 +0,0 @@ - -(def! spaces- (fn* [indent] - (if (> indent 0) - (str " " (spaces- (- indent 1))) - ""))) - -(def! 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)))))) - -(def! 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 (keys obj))))))) - -(def! 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)))) - -(def! pprint (fn* [obj] - (println (pp- obj 0)))) - - -;;(pprint '(7 8 9 "ten" [11 12 [13 14]] 15 16)) -;;(pprint '{:abc 123 :def {:ghi 456 :jkl [789 "ten eleven twelve"]}}) -;;(pprint '(7 8 {:abc 123 :def {:ghi 456 :jkl 789}} 9 10 [11 12 [13 14]] 15 16)) diff --git a/examples/presentation.mal b/examples/presentation.mal index 80dadac426..4e0c3383bc 100755 --- a/examples/presentation.mal +++ b/examples/presentation.mal @@ -83,7 +83,7 @@ (title "things it does not have") "- performance" "- namespaces" - "- GC (in bash, make, C implmentations)" + "- GC (in bash, make, C implementations)" "- protocols :-(" "- lots of other things") (list @@ -120,4 +120,3 @@ (present (rest slides)))))) (present slides) - diff --git a/examples/protocols.mal b/examples/protocols.mal deleted file mode 100644 index 4c31160b0e..0000000000 --- a/examples/protocols.mal +++ /dev/null @@ -1,70 +0,0 @@ -;; A sketch of Clojure-like protocols, implemented in Mal -;; By chouser (Chris Houser) -;; Original: https://gist.github.com/Chouser/6081ea66d144d13e56fc - -(def! builtin-type (fn* [obj] - (cond - (list? obj) :mal/list - (vector? obj) :mal/vector - (map? obj) :mal/map - (symbol? obj) :mal/symbol - (keyword? obj) :mal/keyword - (atom? obj) :mal/atom - (nil? obj) nil - (true? obj) :mal/bool - (false? obj) :mal/bool))) - -(def! find-protocol-methods (fn* [protocol obj] - (let* [p @protocol] - (or (get p (get (meta obj) :type)) - (get p (builtin-type obj)) - (get p :mal/default))))) - -(def! satisfies? (fn* [protocol obj] - (if (find-protocol-methods protocol obj) true false))) - -(defmacro! defprotocol (fn* [proto-name & methods] - `(do - (def! ~proto-name (atom {})) - ~@(map (fn* [m] - (let* [name (first m), sig (first (rest m))] - `(def! ~name (fn* [this-FIXME & args-FIXME] - (apply (get (find-protocol-methods ~proto-name this-FIXME) - ~(keyword (str name))) - this-FIXME args-FIXME))))) - methods)))) - -(def! extend (fn* [type proto methods & more] - (do - (swap! proto assoc type methods) - (if (first more) - (apply extend type more))))) - -;;---- -;; Example: - -(def! make-triangle (fn* [o a] - ^{:type :shape/triangle} {:opposite o, :adjacent a})) - -(def! make-rectangle (fn* [x y] - ^{:type :shape/rectangle} {:width x, :height y})) - -(defprotocol IDraw - (area [this]) - (draw [this])) - -(prn :false-> (satisfies? IDraw (make-triangle 5 5))) ;=> false - -(extend :shape/rectangle - IDraw - {:area (fn* [obj] (* (get obj :width) (get obj :height))) - :draw (fn* [obj] (println "[]"))}) - -(extend :shape/triangle - IDraw - {:area (fn* [obj] (/ (* (get obj :opposite) (get obj :adjacent)) 2)) - :draw (fn* [obj] (println " .\n.."))}) - -(prn :true-> (satisfies? IDraw (make-triangle 5 5))) ;=> true - -(prn :area-> (area (make-triangle 5 4))) ;=> 10 diff --git a/factor/Dockerfile b/factor/Dockerfile deleted file mode 100644 index c213838156..0000000000 --- a/factor/Dockerfile +++ /dev/null @@ -1,31 +0,0 @@ -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 -########################################################## - -# Factor -RUN apt-get -y install libgtkglext1 -RUN cd /usr/lib/x86_64-linux-gnu/ \ - && curl -O 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 - diff --git a/factor/Makefile b/factor/Makefile deleted file mode 100644 index b11d591f32..0000000000 --- a/factor/Makefile +++ /dev/null @@ -1,43 +0,0 @@ -TESTS = - -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 - -.PHONY: stats stats-lisp - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*\!|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*\!|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" - diff --git a/factor/lib/reader/reader.factor b/factor/lib/reader/reader.factor deleted file mode 100644 index 587ed90ab7..0000000000 --- a/factor/lib/reader/reader.factor +++ /dev/null @@ -1,67 +0,0 @@ -! 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 ; -IN: lib.reader - -CONSTANT: token-regex R/ (~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"|;.*|[^\s\[\]{}('"`,;)~^@]+)/ - -DEFER: read-form - -: (read-atom) ( str -- maltype ) - { - { [ dup first CHAR: " = ] [ rest but-last "\\\"" "\"" replace - "\\n" "\n" replace - "\\\\" "\\" replace ] } - { [ 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 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/factor/run b/factor/run deleted file mode 100755 index 4757514db8..0000000000 --- a/factor/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec factor $(dirname $0)/${STEP:-stepA_mal}/${STEP:-stepA_mal}.factor "${@}" diff --git a/factor/step2_eval/step2_eval.factor b/factor/step2_eval/step2_eval.factor deleted file mode 100755 index aa1c06ea0e..0000000000 --- a/factor/step2_eval/step2_eval.factor +++ /dev/null @@ -1,55 +0,0 @@ -! Copyright (C) 2015 Jordan Lewis. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays assocs combinators combinators.short-circuit -continuations fry io kernel math lib.printer lib.reader lib.types -quotations readline sequences ; -IN: step2_eval - -CONSTANT: repl-env H{ - { "+" [ + ] } - { "-" [ - ] } - { "*" [ * ] } - { "/" [ / ] } -} - -DEFER: EVAL - -: eval-symbol ( sym env -- ast ) - [ name>> ] dip ?at [ "no variable " prepend throw ] unless ; - -: eval-list ( list env -- ast ) - '[ _ EVAL ] map ; - -: eval-assoc ( assoc env -- ast ) - '[ [ _ EVAL ] bi@ ] assoc-map ; - -: eval-ast ( ast env -- ast ) - { - { [ over malsymbol? ] [ eval-symbol ] } - { [ over sequence? ] [ eval-list ] } - { [ over assoc? ] [ eval-assoc ] } - [ drop ] - } cond ; - -: READ ( str -- maltype ) read-str ; - -: EVAL ( maltype env -- maltype ) - eval-ast dup { [ array? ] [ empty? not ] } 1&& [ - unclip - dup quotation? [ "not a fn" throw ] unless - with-datastack first - ] when ; - -: PRINT ( maltype -- str ) pr-str ; - -: REP ( str -- str ) - [ READ repl-env EVAL ] [ nip ] recover PRINT ; - -: REPL ( -- ) - [ - "user> " readline [ - [ REP print flush ] unless-empty - ] keep - ] loop ; - -MAIN: REPL diff --git a/factor/step3_env/step3_env.factor b/factor/step3_env/step3_env.factor deleted file mode 100755 index 3dbdc002c9..0000000000 --- a/factor/step3_env/step3_env.factor +++ /dev/null @@ -1,67 +0,0 @@ -! 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 locals lib.env lib.printer -lib.reader lib.types math namespaces quotations readline sequences ; -IN: step3_env - -CONSTANT: repl-bindings H{ - { "+" [ + ] } - { "-" [ - ] } - { "*" [ * ] } - { "/" [ / ] } -} - -SYMBOL: repl-env - -DEFER: EVAL - -: eval-ast ( ast env -- ast ) - { - { [ over malsymbol? ] [ env-get ] } - { [ over sequence? ] [ '[ _ EVAL ] map ] } - { [ over assoc? ] [ '[ [ _ EVAL ] bi@ ] assoc-map ] } - [ drop ] - } cond ; - -:: 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 ; - -:: EVAL ( maltype env -- maltype ) - maltype dup { [ array? ] [ empty? not ] } 1&& [ - unclip dup dup malsymbol? [ name>> ] when { - { "def!" [ drop first2 env eval-def! ] } - { "let*" [ drop first2 env eval-let* ] } - [ - drop env eval-ast dup quotation? [ - [ env eval-ast ] dip with-datastack first - ] [ - drop "not a fn" throw - ] if - ] - } case - ] [ - env eval-ast - ] if ; - -: PRINT ( maltype -- str ) pr-str ; - -: REP ( str -- str ) - [ READ repl-env get EVAL ] [ nip ] recover PRINT ; - -: REPL ( -- ) - f repl-bindings repl-env set - [ - "user> " readline [ - [ REP print flush ] unless-empty - ] keep - ] loop ; - -MAIN: REPL diff --git a/factor/step4_if_fn_do/step4_if_fn_do.factor b/factor/step4_if_fn_do/step4_if_fn_do.factor deleted file mode 100755 index d48f2414bc..0000000000 --- a/factor/step4_if_fn_do/step4_if_fn_do.factor +++ /dev/null @@ -1,86 +0,0 @@ -! 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 ; -IN: step4_if_fn_do - -SYMBOL: repl-env - -DEFER: EVAL - -: eval-ast ( ast env -- ast ) - { - { [ over malsymbol? ] [ env-get ] } - { [ over sequence? ] [ '[ _ EVAL ] map ] } - { [ over assoc? ] [ '[ [ _ EVAL ] bi@ ] assoc-map ] } - [ drop ] - } cond ; - -:: 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 ; - -:: EVAL ( maltype env -- maltype ) - maltype dup { [ array? ] [ empty? not ] } 1&& [ - dup first dup malsymbol? [ name>> ] when { - { "def!" [ rest first2 env eval-def! ] } - { "let*" [ rest first2 env eval-let* ] } - { "do" [ rest env eval-ast last ] } - { "if" [ rest env eval-if ] } - { "fn*" [ rest env eval-fn* ] } - [ drop [ env EVAL ] map unclip apply ] - } case - ] [ - env eval-ast - ] if ; - -: PRINT ( maltype -- str ) pr-str ; - -: REP ( str -- str ) - [ READ repl-env get EVAL ] [ nip ] recover PRINT ; - -: 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/factor/step7_quote/step7_quote.factor b/factor/step7_quote/step7_quote.factor deleted file mode 100755 index f980509c7e..0000000000 --- a/factor/step7_quote/step7_quote.factor +++ /dev/null @@ -1,123 +0,0 @@ -! 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 ; -IN: step7_quote - -SYMBOL: repl-env - -DEFER: EVAL - -: eval-ast ( ast env -- ast ) - { - { [ over malsymbol? ] [ env-get ] } - { [ over sequence? ] [ '[ _ EVAL ] map ] } - { [ over assoc? ] [ '[ [ _ EVAL ] bi@ ] assoc-map ] } - [ drop ] - } cond ; - -:: 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-ast drop ] 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 ; - -: is-pair? ( maltype -- bool ) - { [ sequence? ] [ empty? not ] } 1&& ; - -: quasiquote ( maltype -- maltype ) - { - { [ dup is-pair? not ] [ [ "quote" ] dip 2array ] } - { [ "unquote" over first symeq? ] [ second ] } - { [ dup first { [ is-pair? ] [ first "splice-unquote" swap symeq? ] } 1&& ] - [ [ "concat" ] dip unclip second swap quasiquote 3array ] } - [ "cons" swap unclip quasiquote swap quasiquote 3array ] - } cond ; - -: READ ( str -- maltype ) read-str ; - -: EVAL ( maltype env -- maltype ) - over { [ array? ] [ empty? not ] } 1&& [ - over first dup malsymbol? [ name>> ] when { - { "def!" [ [ rest first2 ] dip eval-def! f ] } - { "let*" [ [ 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* - ] [ - eval-ast - ] if ; - -[ apply [ EVAL ] when* ] mal-apply set-global - -: PRINT ( maltype -- str ) pr-str ; - -: REP ( str -- str ) - [ READ repl-env get EVAL ] [ nip ] recover PRINT ; - -: 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) \")\"))))) -" string-lines harvest [ REP drop ] each - -MAIN: main diff --git a/factor/step8_macros/step8_macros.factor b/factor/step8_macros/step8_macros.factor deleted file mode 100755 index 9b77f97da1..0000000000 --- a/factor/step8_macros/step8_macros.factor +++ /dev/null @@ -1,143 +0,0 @@ -! 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 ; -IN: step8_macros - -SYMBOL: repl-env - -DEFER: EVAL - -: eval-ast ( ast env -- ast ) - { - { [ over malsymbol? ] [ env-get ] } - { [ over sequence? ] [ '[ _ EVAL ] map ] } - { [ over assoc? ] [ '[ [ _ EVAL ] bi@ ] assoc-map ] } - [ drop ] - } cond ; - -:: eval-def! ( key value env -- maltype ) - value env EVAL [ key env env-set ] keep ; - -:: eval-defmacro! ( key value env -- maltype ) - value env EVAL t >>macro? [ 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-ast drop ] 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 ; - -: is-pair? ( maltype -- bool ) - { [ sequence? ] [ empty? not ] } 1&& ; - -: quasiquote ( maltype -- maltype ) - { - { [ dup is-pair? not ] [ [ "quote" ] dip 2array ] } - { [ "unquote" over first symeq? ] [ second ] } - { [ dup first { [ is-pair? ] [ first "splice-unquote" swap symeq? ] } 1&& ] - [ [ "concat" ] dip unclip second swap quasiquote 3array ] } - [ "cons" swap unclip swap [ quasiquote ] bi@ 3array ] - } cond ; - -:: macro-expand ( maltype env -- maltype ) - maltype dup array? [ - dup first { [ malsymbol? ] [ env env-find drop ] } 1&& [ - dup { [ malfn? ] [ macro?>> ] } 1&& [ - [ rest ] dip apply [ EVAL ] keep macro-expand - ] [ drop ] if - ] when* - ] when ; - -: READ ( str -- maltype ) read-str ; - -: EVAL ( maltype env -- maltype ) - over { [ array? ] [ empty? not ] } 1&& [ - [ macro-expand ] keep over array? [ - 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 ] } - { "macroexpand" [ [ second ] dip macro-expand f ] } - [ drop '[ _ EVAL ] map unclip apply ] - } case [ EVAL ] when* - ] [ - eval-ast - ] if - ] [ - eval-ast - ] if ; - -[ apply [ EVAL ] when* ] mal-apply set-global - -: PRINT ( maltype -- str ) pr-str ; - -: REP ( str -- str ) - [ READ repl-env get EVAL ] [ nip ] recover PRINT ; - -: 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) \")\"))))) -(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs))))))) -(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)))))))) -" string-lines harvest [ REP drop ] each - -MAIN: main diff --git a/factor/step9_try/step9_try.factor b/factor/step9_try/step9_try.factor deleted file mode 100755 index 403b9e2fe1..0000000000 --- a/factor/step9_try/step9_try.factor +++ /dev/null @@ -1,151 +0,0 @@ -! 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 ; -IN: step9_try - -SYMBOL: repl-env - -DEFER: EVAL - -: eval-ast ( ast env -- ast ) - { - { [ over malsymbol? ] [ env-get ] } - { [ over sequence? ] [ '[ _ EVAL ] map ] } - { [ over assoc? ] [ '[ [ _ EVAL ] bi@ ] assoc-map ] } - [ drop ] - } cond ; - -:: eval-def! ( key value env -- maltype ) - value env EVAL [ key env env-set ] keep ; - -:: eval-defmacro! ( key value env -- maltype ) - value env EVAL t >>macro? [ 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-ast drop ] 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 second second env new-env [ env-set ] keep - params second third swap EVAL - ] 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 ; - -: is-pair? ( maltype -- bool ) - { [ sequence? ] [ empty? not ] } 1&& ; - -: quasiquote ( maltype -- maltype ) - { - { [ dup is-pair? not ] [ [ "quote" ] dip 2array ] } - { [ "unquote" over first symeq? ] [ second ] } - { [ dup first { [ is-pair? ] [ first "splice-unquote" swap symeq? ] } 1&& ] - [ [ "concat" ] dip unclip second swap quasiquote 3array ] } - [ "cons" swap unclip swap [ quasiquote ] bi@ 3array ] - } cond ; - -:: macro-expand ( maltype env -- maltype ) - maltype dup array? [ - dup first { [ malsymbol? ] [ env env-find drop ] } 1&& [ - dup { [ malfn? ] [ macro?>> ] } 1&& [ - [ rest ] dip apply [ EVAL ] keep macro-expand - ] [ drop ] if - ] when* - ] when ; - -: READ ( str -- maltype ) read-str ; - -: EVAL ( maltype env -- maltype ) - over { [ array? ] [ empty? not ] } 1&& [ - [ macro-expand ] keep over array? [ - 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 ] } - { "macroexpand" [ [ second ] dip macro-expand f ] } - { "try*" [ [ rest ] dip eval-try* f ] } - [ drop '[ _ EVAL ] map unclip apply ] - } case [ EVAL ] when* - ] [ - eval-ast - ] if - ] [ - eval-ast - ] if ; - -[ apply [ EVAL ] when* ] mal-apply set-global - -: PRINT ( maltype -- str ) pr-str ; - -: REP ( str -- str ) - [ READ repl-env get EVAL ] [ nip ] recover PRINT ; - -: 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) \")\"))))) -(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs))))))) -(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)))))))) -" string-lines harvest [ REP drop ] each - -MAIN: main diff --git a/factor/stepA_mal/stepA_mal.factor b/factor/stepA_mal/stepA_mal.factor deleted file mode 100755 index 698254c000..0000000000 --- a/factor/stepA_mal/stepA_mal.factor +++ /dev/null @@ -1,155 +0,0 @@ -! 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 ; -IN: stepA_mal - -SYMBOL: repl-env - -DEFER: EVAL - -: eval-ast ( ast env -- ast ) - { - { [ over malsymbol? ] [ env-get ] } - { [ over sequence? ] [ '[ _ EVAL ] map ] } - { [ over assoc? ] [ '[ [ _ EVAL ] bi@ ] assoc-map ] } - [ drop ] - } cond ; - -:: eval-def! ( key value env -- maltype ) - value env EVAL [ key env env-set ] keep ; - -:: eval-defmacro! ( key value env -- maltype ) - value env EVAL t >>macro? [ 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-ast drop ] 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 second second env new-env [ env-set ] keep - params second third swap EVAL - ] 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 ; - -: is-pair? ( maltype -- ? ) - { [ sequence? ] [ string? not ] [ empty? not ] } 1&& ; - -: quasiquote ( maltype -- maltype ) - { - { [ dup is-pair? not ] [ [ "quote" ] dip 2array ] } - { [ "unquote" over first symeq? ] [ second ] } - { [ dup first { [ is-pair? ] [ first "splice-unquote" swap symeq? ] } 1&& ] - [ [ "concat" ] dip unclip second swap quasiquote 3array ] } - [ "cons" swap unclip swap [ quasiquote ] bi@ 3array ] - } cond ; - -:: macro-expand ( maltype env -- maltype ) - maltype dup array? [ - dup first { [ malsymbol? ] [ env env-find drop ] } 1&& [ - dup { [ malfn? ] [ macro?>> ] } 1&& [ - [ rest ] dip apply [ EVAL ] keep macro-expand - ] [ drop ] if - ] when* - ] when ; - -: READ ( str -- maltype ) read-str ; - -: EVAL ( maltype env -- maltype ) - over { [ array? ] [ empty? not ] } 1&& [ - [ macro-expand ] keep over array? [ - 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 ] } - { "macroexpand" [ [ second ] dip macro-expand f ] } - { "try*" [ [ rest ] dip eval-try* f ] } - [ drop '[ _ EVAL ] map unclip apply ] - } case [ EVAL ] when* - ] [ - eval-ast - ] if - ] [ - eval-ast - ] if ; - -[ apply [ EVAL ] when* ] mal-apply set-global - -: PRINT ( maltype -- str ) pr-str ; - -: REP ( str -- str ) - [ READ repl-env get EVAL ] [ nip ] recover PRINT ; - -: 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) \")\"))))) -(defmacro! cond (fn* (& xs) (if (> (count xs) 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! *gensym-counter* (atom 0)) -(def! gensym (fn* [] (symbol (str \"G__\" (swap! *gensym-counter* (fn* [x] (+ 1 x))))))) -(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))))))))) -" string-lines harvest [ READ repl-env get EVAL drop ] each - -MAIN: main diff --git a/forth/Dockerfile b/forth/Dockerfile deleted file mode 100644 index c84caec2c4..0000000000 --- a/forth/Dockerfile +++ /dev/null @@ -1,24 +0,0 @@ -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 -########################################################## - -RUN apt-get -y install gforth diff --git a/forth/Makefile b/forth/Makefile deleted file mode 100644 index c619d19684..0000000000 --- a/forth/Makefile +++ /dev/null @@ -1,28 +0,0 @@ -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 - -.PHONY: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*[\\]|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*[\\]|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" diff --git a/forth/core.fs b/forth/core.fs deleted file mode 100644 index 79fa6847fa..0000000000 --- a/forth/core.fs +++ /dev/null @@ -1,227 +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 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 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/run b/forth/run deleted file mode 100755 index c7479ea8a9..0000000000 --- a/forth/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec gforth $(dirname $0)/${STEP:-stepA_mal}.fs "${@}" 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 68e189e051..0000000000 --- a/forth/step2_eval.fs +++ /dev/null @@ -1,124 +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 } - 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 ) - 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 fcc40a3d76..0000000000 --- a/forth/step3_env.fs +++ /dev/null @@ -1,158 +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 } - 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 ) - 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 2ecde297f3..0000000000 --- a/forth/step4_if_fn_do.fs +++ /dev/null @@ -1,218 +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 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 - ." 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 } - 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 ) - 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 e5c92f1d31..0000000000 --- a/forth/step5_tco.fs +++ /dev/null @@ -1,229 +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 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 - ." 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 } - 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 ) - 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 cca5b4eb54..0000000000 --- a/forth/step6_file.fs +++ /dev/null @@ -1,276 +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 } - 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 - ." 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 } - 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! 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 75af3f10a7..0000000000 --- a/forth/step7_quote.fs +++ /dev/null @@ -1,318 +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 } - 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 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 - ." 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 } - 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! 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 68f80524ec..0000000000 --- a/forth/step8_macros.fs +++ /dev/null @@ -1,345 +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 } - 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 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 ! ;; - -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 } - 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! 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 b16c2ac157..0000000000 --- a/forth/step9_try.fs +++ /dev/null @@ -1,397 +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 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 ! ;; - -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 } - 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 ;; - -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 - -: 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 394b638477..0000000000 --- a/forth/stepA_mal.fs +++ /dev/null @@ -1,408 +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 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 ! ;; - -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 } - 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 ;; - -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\" (def! *gensym-counter* (atom 0))" rep 2drop -s\" (def! gensym (fn* [] (symbol (str \"G__\" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))" rep 2drop -s\" (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)))))))))" 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/fsharp/Dockerfile b/fsharp/Dockerfile deleted file mode 100644 index 01cf8044c7..0000000000 --- a/fsharp/Dockerfile +++ /dev/null @@ -1,27 +0,0 @@ -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 -########################################################## - -# Deps for Mono-based languages (C#, VB.Net) -RUN apt-get -y install mono-runtime mono-mcs mono-vbnc mono-devel - -RUN apt-get -y install fsharp diff --git a/fsharp/Makefile b/fsharp/Makefile deleted file mode 100644 index 9c56a1e021..0000000000 --- a/fsharp/Makefile +++ /dev/null @@ -1,63 +0,0 @@ -##################### - -DEBUG = - -TESTS = - -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 - -.PHONY: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" - -tests: $(TESTS) - -$(TESTS): - @echo "Running $@"; \ - ./$@ || exit 1; \ diff --git a/fsharp/core.fs b/fsharp/core.fs deleted file mode 100644 index cbd08206f2..0000000000 --- a/fsharp/core.fs +++ /dev/null @@ -1,296 +0,0 @@ -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 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 - | 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 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 fromString f = function - | [String(str)] -> f str - | [_] -> raise <| Error.argMismatch () - | _ -> raise <| Error.wrongArity () - - let symbol = fromString (fun s -> Symbol(s)) - let keyword = fromString (fun s -> Keyword(s)) - 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/fsharp/run b/fsharp/run deleted file mode 100755 index fa517a6ec7..0000000000 --- a/fsharp/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec mono $(dirname $0)/${STEP:-stepA_mal}.exe ${RAW:+--raw} "${@}" diff --git a/fsharp/step1_read_print.fs b/fsharp/step1_read_print.fs deleted file mode 100644 index 27751f51c2..0000000000 --- a/fsharp/step1_read_print.fs +++ /dev/null @@ -1,41 +0,0 @@ -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 rec main args = - let mode = getReadlineMode args - match Readline.read "user> " mode with - | null -> 0 - | input -> - REP input - main args diff --git a/fsharp/step2_eval.fs b/fsharp/step2_eval.fs deleted file mode 100644 index 2db015f837..0000000000 --- a/fsharp/step2_eval.fs +++ /dev/null @@ -1,65 +0,0 @@ -module REPL - open System - open Node - open Types - - let rec eval_ast env = function - | Symbol(sym) -> Env.get env sym - | List(_, lst) -> lst |> List.map (eval env) |> makeList - | Vector(_, seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray - | Map(_, map) -> map |> Map.map (fun k v -> eval env v) |> makeMap - | node -> node - - and eval env = function - | List(_, []) as emptyList -> emptyList - | List(_, _) as node -> - let resolved = node |> eval_ast env - match resolved with - | List(_, BuiltInFunc(_, _, f)::rest) -> f rest - | _ -> raise <| Error.errExpectedX "func" - | node -> node |> eval_ast env - - let READ input = - try - Reader.read_str input - with - | Error.ReaderError(msg) -> - printfn "%s" msg - [] - - let EVAL env ast = - try - Some(eval env ast) - with - | Error.EvalError(msg) - | Error.ReaderError(msg) -> - printfn "%s" msg - None - - 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 rec main args = - let mode = getReadlineMode args - let env = Env.makeRootEnv () - match Readline.read "user> " mode with - | null -> 0 - | input -> - REP env input - main args diff --git a/fsharp/step3_env.fs b/fsharp/step3_env.fs deleted file mode 100644 index 68226af319..0000000000 --- a/fsharp/step3_env.fs +++ /dev/null @@ -1,103 +0,0 @@ -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 eval_ast env = function - | Symbol(sym) -> Env.get env sym - | List(_, lst) -> lst |> List.map (eval env) |> makeList - | Vector(_, seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray - | Map(_, map) -> map |> Map.map (fun k v -> eval env v) |> makeMap - | node -> node - - and 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 = function - | List(_, []) as emptyList -> emptyList - | List(_, Symbol("def!")::rest) -> defBang env rest - | List(_, Symbol("let*")::rest) -> letStar env rest - | List(_, _) as node -> - let resolved = node |> eval_ast env - match resolved with - | List(_, BuiltInFunc(_, _, f)::rest) -> f rest - | _ -> raise <| Error.errExpectedX "func" - | node -> node |> eval_ast env - - let READ input = - try - Reader.read_str input - with - | Error.ReaderError(msg) -> - printfn "%s" msg - [] - - let EVAL env ast = - try - Some(eval env ast) - with - | Error.EvalError(msg) - | Error.ReaderError(msg) -> - printfn "%s" msg - None - - 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 -> - REP env input - loop () - loop () diff --git a/fsharp/step4_if_fn_do.fs b/fsharp/step4_if_fn_do.fs deleted file mode 100644 index d6e6e5a266..0000000000 --- a/fsharp/step4_if_fn_do.fs +++ /dev/null @@ -1,146 +0,0 @@ -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 eval_ast env = function - | Symbol(sym) -> Env.get env sym - | List(_, lst) -> lst |> List.map (eval env) |> makeList - | Vector(_, seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray - | Map(_, map) -> map |> Map.map (fun k v -> eval env v) |> makeMap - | node -> node - - and 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 = function - | List(_, []) as emptyList -> emptyList - | 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(_, _) as node -> - let resolved = node |> eval_ast env - match resolved with - | List(_, BuiltInFunc(_, _, f)::rest) -> f rest - | List(_, Func(_, _, _, body, binds, outer)::rest) -> - let inner = Env.makeNew outer binds rest - body |> eval inner - | _ -> raise <| Error.errExpectedX "func" - | node -> node |> eval_ast env - - let READ input = - try - Reader.read_str input - with - | Error.ReaderError(msg) -> - printfn "%s" msg - [] - - let EVAL env ast = - try - Some(eval env ast) - with - | Error.EvalError(msg) - | Error.ReaderError(msg) -> - printfn "%s" msg - None - - 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 -> - REP env input - loop () - loop () diff --git a/fsharp/step5_tco.fs b/fsharp/step5_tco.fs deleted file mode 100644 index 7c0a7d30b0..0000000000 --- a/fsharp/step5_tco.fs +++ /dev/null @@ -1,148 +0,0 @@ -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 eval_ast env = function - | Symbol(sym) -> Env.get env sym - | List(_, lst) -> lst |> List.map (eval env) |> makeList - | Vector(_, seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray - | Map(_, map) -> map |> Map.map (fun k v -> eval env v) |> makeMap - | node -> node - - and 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 = function - | List(_, []) as emptyList -> emptyList - | 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(_, _) as node -> - let resolved = node |> eval_ast env - match resolved with - | List(_, BuiltInFunc(_, _, f)::rest) -> f rest - | List(_, Func(_, _, _, body, binds, outer)::rest) -> - let inner = Env.makeNew outer binds rest - body |> eval inner - | _ -> raise <| Error.errExpectedX "func" - | node -> node |> eval_ast env - - let READ input = - try - Reader.read_str input - with - | Error.ReaderError(msg) -> - printfn "%s" msg - [] - - let EVAL env ast = - try - Some(eval env ast) - with - | Error.EvalError(msg) - | Error.ReaderError(msg) -> - printfn "%s" msg - None - - 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 -> - REP env input - loop () - loop () diff --git a/fsharp/step6_file.fs b/fsharp/step6_file.fs deleted file mode 100644 index 584bf1b426..0000000000 --- a/fsharp/step6_file.fs +++ /dev/null @@ -1,174 +0,0 @@ -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 eval_ast env = function - | Symbol(sym) -> Env.get env sym - | List(_, lst) -> lst |> List.map (eval env) |> makeList - | Vector(_, seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray - | Map(_, map) -> map |> Map.map (fun k v -> eval env v) |> makeMap - | node -> node - - and 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 = function - | List(_, []) as emptyList -> emptyList - | 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(_, _) as node -> - let resolved = node |> eval_ast env - match resolved with - | List(_, BuiltInFunc(_, _, f)::rest) -> f rest - | List(_, Func(_, _, _, body, binds, outer)::rest) -> - let inner = Env.makeNew outer binds rest - body |> eval inner - | _ -> raise <| Error.errExpectedX "func" - | node -> node |> eval_ast env - - let READ input = - try - Reader.read_str input - with - | Error.ReaderError(msg) -> - printfn "%s" msg - [] - - let EVAL env ast = - try - Some(eval env ast) - with - | Error.EvalError(msg) - | Error.ReaderError(msg) -> - printfn "%s" msg - None - - 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 (slurp f))))) - """ |> 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 -> - REP env input - loop () - loop () diff --git a/fsharp/step7_quote.fs b/fsharp/step7_quote.fs deleted file mode 100644 index 8c2746398d..0000000000 --- a/fsharp/step7_quote.fs +++ /dev/null @@ -1,193 +0,0 @@ -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 quasiquoteForm nodes = - let transformNode f = function - | Elements 1 [|a|] -> f a - | _ -> raise <| Error.wrongArity () - let singleNode = transformNode (fun n -> n) - let rec quasiquote node = - match node with - | Cons(Symbol("unquote"), rest) -> rest |> singleNode - | Cons(Cons(Symbol("splice-unquote"), spliceRest), rest) -> - makeList [Symbol("concat"); singleNode spliceRest; quasiquote rest] - | Cons(h, t) -> makeList [Symbol("cons"); quasiquote h; quasiquote t] - | n -> makeList [Symbol("quote"); n] - makeList nodes |> transformNode quasiquote - - let quoteForm = function - | [node] -> node - | _ -> raise <| Error.wrongArity () - - let rec eval_ast env = function - | Symbol(sym) -> Env.get env sym - | List(_, lst) -> lst |> List.map (eval env) |> makeList - | Vector(_, seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray - | Map(_, map) -> map |> Map.map (fun k v -> eval env v) |> makeMap - | node -> node - - and 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 = function - | List(_, []) as emptyList -> emptyList - | 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")::rest) -> quasiquoteForm rest |> eval env - | List(_, _) as node -> - let resolved = node |> eval_ast env - match resolved with - | List(_, BuiltInFunc(_, _, f)::rest) -> f rest - | List(_, Func(_, _, _, body, binds, outer)::rest) -> - let inner = Env.makeNew outer binds rest - body |> eval inner - | _ -> raise <| Error.errExpectedX "func" - | node -> node |> eval_ast env - - let READ input = - try - Reader.read_str input - with - | Error.ReaderError(msg) -> - printfn "%s" msg - [] - - let EVAL env ast = - try - Some(eval env ast) - with - | Error.EvalError(msg) -> - printfn "%s" msg - None - - 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 (slurp f))))) - """ |> 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 -> - REP env input - loop () - loop () diff --git a/fsharp/step8_macros.fs b/fsharp/step8_macros.fs deleted file mode 100644 index ea0468152d..0000000000 --- a/fsharp/step8_macros.fs +++ /dev/null @@ -1,223 +0,0 @@ -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 quasiquoteForm nodes = - let transformNode f = function - | Elements 1 [|a|] -> f a - | _ -> raise <| Error.wrongArity () - let singleNode = transformNode (fun n -> n) - let rec quasiquote node = - match node with - | Cons(Symbol("unquote"), rest) -> rest |> singleNode - | Cons(Cons(Symbol("splice-unquote"), spliceRest), rest) -> - makeList [Symbol("concat"); singleNode spliceRest; quasiquote rest] - | Cons(h, t) -> makeList [Symbol("cons"); quasiquote h; quasiquote t] - | n -> makeList [Symbol("quote"); n] - makeList nodes |> transformNode quasiquote - - let quoteForm = function - | [node] -> node - | _ -> raise <| Error.wrongArity () - - let rec macroExpand env = function - | Env.IsMacro env (Macro(_, _, f, _, _, _), rest) -> - f rest |> macroExpand env - | node -> node - - let rec eval_ast env = function - | Symbol(sym) -> Env.get env sym - | List(_, lst) -> lst |> List.map (eval env) |> makeList - | Vector(_, seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray - | Map(_, map) -> map |> Map.map (fun k v -> eval env v) |> makeMap - | node -> node - - and 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 macroExpandForm env = function - | [form] -> macroExpand env form - | _ -> 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 = function - | List(_, _) as node -> - match macroExpand env node with - | List(_, []) as emptyList -> emptyList - | List(_, Symbol("def!")::rest) -> defBangForm env rest - | List(_, Symbol("defmacro!")::rest) -> defMacroForm env rest - | List(_, Symbol("macroexpand")::rest) -> macroExpandForm 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")::rest) -> quasiquoteForm rest |> eval env - | List(_, _) as node -> - let resolved = node |> eval_ast env - match resolved with - | List(_, BuiltInFunc(_, _, f)::rest) -> f rest - | List(_, Func(_, _, _, body, binds, outer)::rest) -> - let inner = Env.makeNew outer binds rest - body |> eval inner - | _ -> raise <| Error.errExpectedX "func" - | node -> node |> eval_ast env - | node -> node |> eval_ast env - - let READ input = - try - Reader.read_str input - with - | Error.ReaderError(msg) -> - printfn "%s" msg - [] - - let EVAL env ast = - try - Some(eval env ast) - with - | Error.EvalError(msg) -> - printfn "%s" msg - None - - 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 (slurp f))))) - (defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_ ~(first xs)) (if or_ or_ (or ~@(rest xs)))))))) - (defmacro! cond (fn* (& xs) (if (> (count xs) 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 -> - REP env input - loop () - loop () diff --git a/fsharp/step9_try.fs b/fsharp/step9_try.fs deleted file mode 100644 index 602a9e380c..0000000000 --- a/fsharp/step9_try.fs +++ /dev/null @@ -1,240 +0,0 @@ -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 quasiquoteForm nodes = - let transformNode f = function - | Elements 1 [|a|] -> f a - | _ -> raise <| Error.wrongArity () - let singleNode = transformNode (fun n -> n) - let rec quasiquote node = - match node with - | Cons(Symbol("unquote"), rest) -> rest |> singleNode - | Cons(Cons(Symbol("splice-unquote"), spliceRest), rest) -> - makeList [Symbol("concat"); singleNode spliceRest; quasiquote rest] - | Cons(h, t) -> makeList [Symbol("cons"); quasiquote h; quasiquote t] - | n -> makeList [Symbol("quote"); n] - makeList nodes |> transformNode quasiquote - - let quoteForm = function - | [node] -> node - | _ -> raise <| Error.wrongArity () - - let rec macroExpand env = function - | Env.IsMacro env (Macro(_, _, f, _, _, _), rest) -> - f rest |> macroExpand env - | node -> node - - let rec eval_ast env = function - | Symbol(sym) -> Env.get env sym - | List(_, lst) -> lst |> List.map (eval env) |> makeList - | Vector(_, seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray - | Map(_, map) -> map |> Map.map (fun k v -> eval env v) |> makeMap - | node -> node - - and 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 macroExpandForm env = function - | [form] -> macroExpand env form - | _ -> 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; 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 = function - | List(_, _) as node -> - match macroExpand env node with - | List(_, []) as emptyList -> emptyList - | List(_, Symbol("def!")::rest) -> defBangForm env rest - | List(_, Symbol("defmacro!")::rest) -> defMacroForm env rest - | List(_, Symbol("macroexpand")::rest) -> macroExpandForm 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")::rest) -> quasiquoteForm rest |> eval env - | List(_, Symbol("try*")::rest) -> tryForm env rest - | List(_, _) as node -> - let resolved = node |> eval_ast env - match resolved with - | List(_, BuiltInFunc(_, _, f)::rest) -> f rest - | List(_, Func(_, _, _, body, binds, outer)::rest) -> - let inner = Env.makeNew outer binds rest - body |> eval inner - | _ -> raise <| Error.errExpectedX "func" - | node -> node |> eval_ast env - | node -> node |> eval_ast env - - let READ input = - try - Reader.read_str input - with - | Error.ReaderError(msg) -> - printfn "%s" msg - [] - - let EVAL env ast = - try - Some(eval env ast) - with - | Error.EvalError(msg) -> - printfn "%s" msg - None - - 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 (slurp f))))) - (defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_ ~(first xs)) (if or_ or_ (or ~@(rest xs)))))))) - (defmacro! cond (fn* (& xs) (if (> (count xs) 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 -> - REP env input - loop () - loop () diff --git a/fsharp/stepA_mal.fs b/fsharp/stepA_mal.fs deleted file mode 100644 index 04ab54d8f7..0000000000 --- a/fsharp/stepA_mal.fs +++ /dev/null @@ -1,254 +0,0 @@ -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 quasiquoteForm nodes = - let transformNode f = function - | Elements 1 [|a|] -> f a - | _ -> raise <| Error.wrongArity () - let singleNode = transformNode (fun n -> n) - let rec quasiquote node = - match node with - | Cons(Symbol("unquote"), rest) -> rest |> singleNode - | Cons(Cons(Symbol("splice-unquote"), spliceRest), rest) -> - makeList [Symbol("concat"); singleNode spliceRest; quasiquote rest] - | Cons(h, t) -> makeList [Symbol("cons"); quasiquote h; quasiquote t] - | n -> makeList [Symbol("quote"); n] - makeList nodes |> transformNode quasiquote - - let quoteForm = function - | [node] -> node - | _ -> raise <| Error.wrongArity () - - let rec macroExpand env = function - | Env.IsMacro env (Macro(_, _, f, _, _, _), rest) -> - f rest |> macroExpand env - | node -> node - - let rec eval_ast env = function - | Symbol(sym) -> Env.get env sym - | List(_, lst) -> lst |> List.map (eval env) |> makeList - | Vector(_, seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray - | Map(_, map) -> map |> Map.map (fun k v -> eval env v) |> makeMap - | node -> node - - and 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 macroExpandForm env = function - | [form] -> macroExpand env form - | _ -> 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; 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 = function - | List(_, _) as node -> - match macroExpand env node with - | List(_, []) as emptyList -> emptyList - | List(_, Symbol("def!")::rest) -> defBangForm env rest - | List(_, Symbol("defmacro!")::rest) -> defMacroForm env rest - | List(_, Symbol("macroexpand")::rest) -> macroExpandForm 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")::rest) -> quasiquoteForm rest |> eval env - | List(_, Symbol("try*")::rest) -> tryForm env rest - | List(_, _) as node -> - let resolved = node |> eval_ast env - match resolved with - | List(_, BuiltInFunc(_, _, f)::rest) -> f rest - | List(_, Func(_, _, _, body, binds, outer)::rest) -> - let inner = Env.makeNew outer binds rest - body |> eval inner - | _ -> raise <| Error.errExpectedX "func" - | node -> node |> eval_ast env - | node -> node |> eval_ast env - - let READ input = - try - Reader.read_str input - with - | Error.ReaderError(msg) -> - printfn "%s" msg - [] - - let EVAL env ast = - try - Some(eval env ast) - with - | Error.EvalError(msg) -> - printfn "%s" msg - None - - 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 (slurp f))))) - (defmacro! cond (fn* (& xs) (if (> (count xs) 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! *gensym-counter* (atom 0)) - (def! gensym (fn* [] (symbol (str "G__" (swap! *gensym-counter* (fn* [x] (+ 1 x))))))) - (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))))))))) - """ |> 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 -> - REP env input - loop () - loop () 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/Dockerfile b/go/Dockerfile deleted file mode 100644 index 608574edf0..0000000000 --- a/go/Dockerfile +++ /dev/null @@ -1,28 +0,0 @@ -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++ - -RUN apt-get -y install pkg-config -RUN apt-get -y install golang diff --git a/go/Makefile b/go/Makefile deleted file mode 100644 index f35976a37d..0000000000 --- a/go/Makefile +++ /dev/null @@ -1,45 +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) - -dist: 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 $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" diff --git a/go/run b/go/run deleted file mode 100755 index 8ba68a5484..0000000000 --- a/go/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec $(dirname $0)/${STEP:-stepA_mal} "${@}" diff --git a/go/src/core/core.go b/go/src/core/core.go deleted file mode 100644 index 646135f046..0000000000 --- a/go/src/core/core.go +++ /dev/null @@ -1,559 +0,0 @@ -package core - -import ( - "errors" - "fmt" - "io/ioutil" - "strings" - "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 - } - 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) { - 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 -} - -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) { - 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 - }, - "string?": func(a []MalType) (MalType, error) { - return (String_Q(a[0]) && !Keyword_Q(a[0])), nil - }, - "keyword": func(a []MalType) (MalType, error) { - if Keyword_Q(a[0]) { - return a[0], nil - } else { - 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, - "seq": seq, - - "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 e3a04a91a4..0000000000 --- a/go/src/stepA_mal/stepA_mal.go +++ /dev/null @@ -1,380 +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) - if len(slc) == 0 { - return false - } - 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 eval_ast(ast, env) - } - 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 "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("(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)))))))))") - - // 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/groovy/Dockerfile b/groovy/Dockerfile deleted file mode 100644 index 196698ab78..0000000000 --- a/groovy/Dockerfile +++ /dev/null @@ -1,30 +0,0 @@ -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 -########################################################## - -# Java and Groovy -RUN apt-get -y install openjdk-7-jdk -#RUN apt-get -y install maven2 -#ENV MAVEN_OPTS -Duser.home=/mal -RUN apt-get -y install ant - -RUN apt-get -y install groovy diff --git a/groovy/Makefile b/groovy/Makefile deleted file mode 100644 index b76e71f45f..0000000000 --- a/groovy/Makefile +++ /dev/null @@ -1,51 +0,0 @@ -CLASSES = types.class reader.class printer.class env.class core.class - -SOURCES_BASE = types.groovy reader.groovy printer.groovy -SOURCES_LISP = env.groovy core.groovy stepA_mal.groovy -SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) - -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 - -.PHONY: stats tests - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" diff --git a/groovy/run b/groovy/run deleted file mode 100755 index 80a452e6c8..0000000000 --- a/groovy/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec groovy $(dirname $0)/${STEP:-stepA_mal}.groovy "${@}" diff --git a/groovy/step2_eval.groovy b/groovy/step2_eval.groovy deleted file mode 100644 index 3159db25bd..0000000000 --- a/groovy/step2_eval.groovy +++ /dev/null @@ -1,70 +0,0 @@ -import reader -import printer -import types -import types.MalException -import types.MalSymbol - -// READ -READ = { str -> - reader.read_str str -} - -// EVAL -eval_ast = { ast, env -> - switch (ast) { - case MalSymbol: - if (env.containsKey(ast.value)) return env.get(ast.value) - throw new MalException("'${ast.value}' not found") - case List: - return types.vector_Q(ast) ? - types.vector(ast.collect { EVAL(it,env) }) : - ast.collect { EVAL(it,env) } - case Map: - def new_hm = [:] - ast.each { k,v -> - new_hm[EVAL(k, env)] = EVAL(v, env) - } - return new_hm - default: - return ast - } -} - -EVAL = { ast, env -> - if (! types.list_Q(ast)) return eval_ast(ast, env) - if (ast.size() == 0) return ast - - def el = eval_ast(ast, 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: ${ex.message}" - } catch(ex) { - println "Error: $ex" - ex.printStackTrace() - } -} diff --git a/groovy/step3_env.groovy b/groovy/step3_env.groovy deleted file mode 100644 index 5f375540c2..0000000000 --- a/groovy/step3_env.groovy +++ /dev/null @@ -1,78 +0,0 @@ -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 = { ast, env -> - switch (ast) { - case MalSymbol: return env.get(ast); - case List: return types.vector_Q(ast) ? - types.vector(ast.collect { EVAL(it,env) }) : - ast.collect { EVAL(it,env) } - case Map: def new_hm = [:] - ast.each { k,v -> - new_hm[EVAL(k, env)] = EVAL(v, env) - } - return new_hm - default: return ast - } -} - -EVAL = { ast, env -> - //println("EVAL: ${printer.pr_str(ast,true)}") - if (! types.list_Q(ast)) return eval_ast(ast, env) - 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 = eval_ast(ast, 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: ${ex.message}" - } catch(ex) { - println "Error: $ex" - ex.printStackTrace() - } -} diff --git a/groovy/step4_if_fn_do.groovy b/groovy/step4_if_fn_do.groovy deleted file mode 100644 index db86b993d4..0000000000 --- a/groovy/step4_if_fn_do.groovy +++ /dev/null @@ -1,100 +0,0 @@ -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 = { ast, env -> - switch (ast) { - case MalSymbol: return env.get(ast); - case List: return types.vector_Q(ast) ? - types.vector(ast.collect { EVAL(it,env) }) : - ast.collect { EVAL(it,env) } - case Map: def new_hm = [:] - ast.each { k,v -> - new_hm[EVAL(k, env)] = EVAL(v, env) - } - return new_hm - default: return ast - } -} - -EVAL = { ast, env -> - //println("EVAL: ${printer.pr_str(ast,true)}") - if (! types.list_Q(ast)) return eval_ast(ast, env) - 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 eval_ast(ast[1..-1], 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 = eval_ast(ast, 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: ${ex.message}" - } catch(ex) { - println "Error: $ex" - ex.printStackTrace() - } -} diff --git a/groovy/step7_quote.groovy b/groovy/step7_quote.groovy deleted file mode 100644 index d50a4a19f3..0000000000 --- a/groovy/step7_quote.groovy +++ /dev/null @@ -1,145 +0,0 @@ -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 -pair_Q = { ast -> types.sequential_Q(ast) && ast.size() > 0} -quasiquote = { ast -> - if (! pair_Q(ast)) { - [new MalSymbol("quote"), ast] - } else if (ast[0] != null && - ast[0].class == MalSymbol && - ast[0].value == "unquote") { - ast[1] - } else if (pair_Q(ast[0]) && ast[0][0].class == MalSymbol && - ast[0][0].value == "splice-unquote") { - [new MalSymbol("concat"), ast[0][1], quasiquote(ast.drop(1))] - } else { - [new MalSymbol("cons"), quasiquote(ast[0]), quasiquote(ast.drop(1))] - } -} - -eval_ast = { ast, env -> - switch (ast) { - case MalSymbol: return env.get(ast); - case List: return types.vector_Q(ast) ? - types.vector(ast.collect { EVAL(it,env) }) : - ast.collect { EVAL(it,env) } - case Map: def new_hm = [:] - ast.each { k,v -> - new_hm[EVAL(k, env)] = EVAL(v, env) - } - return new_hm - default: return ast - } -} - -EVAL = { ast, env -> - while (true) { - //println("EVAL: ${printer.pr_str(ast,true)}") - if (! types.list_Q(ast)) return eval_ast(ast, env) - 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 ? eval_ast(ast[1..-2], 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 = eval_ast(ast, 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) \")\")))))") - -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: ${ex.message}" - } catch(StackOverflowError ex) { - println "Error: ${ex}" - } catch(ex) { - println "Error: $ex" - ex.printStackTrace() - } -} diff --git a/groovy/step8_macros.groovy b/groovy/step8_macros.groovy deleted file mode 100644 index 7606526b30..0000000000 --- a/groovy/step8_macros.groovy +++ /dev/null @@ -1,177 +0,0 @@ -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 -macro_Q = { ast, env -> - if (types.list_Q(ast) && - ast.size() > 0 && - ast[0].class == MalSymbol && - env.find(ast[0])) { - def obj = env.get(ast[0]) - if (obj instanceof MalFunc && obj.ismacro) { - return true - } - } - return false -} -macroexpand = { ast, env -> - while (macro_Q(ast, env)) { - def mac = env.get(ast[0]) - ast = mac(ast.drop(1)) - } - return ast -} - -pair_Q = { ast -> types.sequential_Q(ast) && ast.size() > 0} -quasiquote = { ast -> - if (! pair_Q(ast)) { - [new MalSymbol("quote"), ast] - } else if (ast[0] != null && - ast[0].class == MalSymbol && - ast[0].value == "unquote") { - ast[1] - } else if (pair_Q(ast[0]) && ast[0][0].class == MalSymbol && - ast[0][0].value == "splice-unquote") { - [new MalSymbol("concat"), ast[0][1], quasiquote(ast.drop(1))] - } else { - [new MalSymbol("cons"), quasiquote(ast[0]), quasiquote(ast.drop(1))] - } -} - -eval_ast = { ast, env -> - switch (ast) { - case MalSymbol: return env.get(ast); - case List: return types.vector_Q(ast) ? - types.vector(ast.collect { EVAL(it,env) }) : - ast.collect { EVAL(it,env) } - case Map: def new_hm = [:] - ast.each { k,v -> - new_hm[EVAL(k, env)] = EVAL(v, env) - } - return new_hm - default: return ast - } -} - -EVAL = { ast, env -> - while (true) { - //println("EVAL: ${printer.pr_str(ast,true)}") - if (! types.list_Q(ast)) return eval_ast(ast, env) - - ast = macroexpand(ast, env) - if (! types.list_Q(ast)) return eval_ast(ast, env) - 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.ismacro = true - return env.set(ast[1], f) - case { it instanceof MalSymbol && it.value == "macroexpand" }: - return macroexpand(ast[1], env) - case { it instanceof MalSymbol && it.value == "do" }: - ast.size() > 2 ? eval_ast(ast[1..-2], 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 = eval_ast(ast, 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) \")\")))))") -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 (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: ${ex.message}" - } catch(StackOverflowError ex) { - println "Error: ${ex}" - } catch(ex) { - println "Error: $ex" - ex.printStackTrace() - } -} diff --git a/groovy/step9_try.groovy b/groovy/step9_try.groovy deleted file mode 100644 index 991803488c..0000000000 --- a/groovy/step9_try.groovy +++ /dev/null @@ -1,195 +0,0 @@ -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 -macro_Q = { ast, env -> - if (types.list_Q(ast) && - ast.size() > 0 && - ast[0].class == MalSymbol && - env.find(ast[0])) { - def obj = env.get(ast[0]) - if (obj instanceof MalFunc && obj.ismacro) { - return true - } - } - return false -} -macroexpand = { ast, env -> - while (macro_Q(ast, env)) { - def mac = env.get(ast[0]) - ast = mac(ast.drop(1)) - } - return ast -} - -pair_Q = { ast -> types.sequential_Q(ast) && ast.size() > 0} -quasiquote = { ast -> - if (! pair_Q(ast)) { - [new MalSymbol("quote"), ast] - } else if (ast[0] != null && - ast[0].class == MalSymbol && - ast[0].value == "unquote") { - ast[1] - } else if (pair_Q(ast[0]) && ast[0][0].class == MalSymbol && - ast[0][0].value == "splice-unquote") { - [new MalSymbol("concat"), ast[0][1], quasiquote(ast.drop(1))] - } else { - [new MalSymbol("cons"), quasiquote(ast[0]), quasiquote(ast.drop(1))] - } -} - -eval_ast = { ast, env -> - switch (ast) { - case MalSymbol: return env.get(ast); - case List: return types.vector_Q(ast) ? - types.vector(ast.collect { EVAL(it,env) }) : - ast.collect { EVAL(it,env) } - case Map: def new_hm = [:] - ast.each { k,v -> - new_hm[EVAL(k, env)] = EVAL(v, env) - } - return new_hm - default: return ast - } -} - -EVAL = { ast, env -> - while (true) { - //println("EVAL: ${printer.pr_str(ast,true)}") - if (! types.list_Q(ast)) return eval_ast(ast, env) - - ast = macroexpand(ast, env) - if (! types.list_Q(ast)) return eval_ast(ast, env) - 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.ismacro = true - return env.set(ast[1], f) - case { it instanceof MalSymbol && it.value == "macroexpand" }: - return macroexpand(ast[1], env) - 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 ? eval_ast(ast[1..-2], 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 = eval_ast(ast, 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) \")\")))))") -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 (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: ${ex.message}" - } catch(StackOverflowError ex) { - println "Error: ${ex}" - } catch(ex) { - println "Error: $ex" - ex.printStackTrace() - } -} diff --git a/groovy/stepA_mal.groovy b/groovy/stepA_mal.groovy deleted file mode 100644 index abf96dfd5a..0000000000 --- a/groovy/stepA_mal.groovy +++ /dev/null @@ -1,199 +0,0 @@ -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 -macro_Q = { ast, env -> - if (types.list_Q(ast) && - ast.size() > 0 && - ast[0].class == MalSymbol && - env.find(ast[0])) { - def obj = env.get(ast[0]) - if (obj instanceof MalFunc && obj.ismacro) { - return true - } - } - return false -} -macroexpand = { ast, env -> - while (macro_Q(ast, env)) { - def mac = env.get(ast[0]) - ast = mac(ast.drop(1)) - } - return ast -} - -pair_Q = { ast -> types.sequential_Q(ast) && ast.size() > 0} -quasiquote = { ast -> - if (! pair_Q(ast)) { - [new MalSymbol("quote"), ast] - } else if (ast[0] != null && - ast[0].class == MalSymbol && - ast[0].value == "unquote") { - ast[1] - } else if (pair_Q(ast[0]) && ast[0][0].class == MalSymbol && - ast[0][0].value == "splice-unquote") { - [new MalSymbol("concat"), ast[0][1], quasiquote(ast.drop(1))] - } else { - [new MalSymbol("cons"), quasiquote(ast[0]), quasiquote(ast.drop(1))] - } -} - -eval_ast = { ast, env -> - switch (ast) { - case MalSymbol: return env.get(ast); - case List: return types.vector_Q(ast) ? - types.vector(ast.collect { EVAL(it,env) }) : - ast.collect { EVAL(it,env) } - case Map: def new_hm = [:] - ast.each { k,v -> - new_hm[EVAL(k, env)] = EVAL(v, env) - } - return new_hm - default: return ast - } -} - -EVAL = { ast, env -> - while (true) { - //println("EVAL: ${printer.pr_str(ast,true)}") - if (! types.list_Q(ast)) return eval_ast(ast, env) - - ast = macroexpand(ast, env) - if (! types.list_Q(ast)) return eval_ast(ast, env) - 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.ismacro = true - return env.set(ast[1], f) - case { it instanceof MalSymbol && it.value == "macroexpand" }: - return macroexpand(ast[1], env) - 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 ? eval_ast(ast[1..-2], 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 = eval_ast(ast, 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! *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) \")\")))))") -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! *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)))))))))"); - - -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: ${ex.message}" - } catch(StackOverflowError ex) { - println "Error: ${ex}" - } catch(ex) { - println "Error: $ex" - ex.printStackTrace() - } -} diff --git a/guile/Dockerfile b/guile/Dockerfile deleted file mode 100644 index 0b4ae22bc3..0000000000 --- a/guile/Dockerfile +++ /dev/null @@ -1,33 +0,0 @@ -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 -########################################################## - -# Guile -RUN apt-get -y install libunistring-dev libgc-dev autoconf libtool flex gettext texinfo libgmp-dev -RUN apt-get -y install git pkg-config libffi-dev -# TODO: remove /tmp/guile in same command -RUN git clone git://git.sv.gnu.org/guile.git /tmp/guile \ - && cd /tmp/guile && ./autogen.sh && ./configure && make && make install -RUN ldconfig -# TODO: move this up with other deps -RUN apt-get -y install libpcre3 libpcre3-dev - diff --git a/guile/Makefile b/guile/Makefile deleted file mode 100644 index e7e6f345a7..0000000000 --- a/guile/Makefile +++ /dev/null @@ -1,26 +0,0 @@ -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 - -.PHONY: stats - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*;|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*;|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" diff --git a/guile/run b/guile/run deleted file mode 100755 index 7f1f2ba330..0000000000 --- a/guile/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec guile --no-auto-compile -L $(dirname $0) $(dirname $0)/${STEP:-stepA_mal}.scm "${@}" diff --git a/guile/step0_repl.scm b/guile/step0_repl.scm deleted file mode 100644 index dd598b6d2e..0000000000 --- a/guile/step0_repl.scm +++ /dev/null @@ -1,32 +0,0 @@ -;; 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) (_readline "user> ")) - -(define (EVAL ast env) ast) - -(define (PRINT str) - (and (not (eof-object? str)) - (format #t "~a~%" str))) - -(define (LOOP continue?) - (and continue? (REPL))) - -(define (REPL) - (LOOP (PRINT (EVAL (READ) '())))) - -(REPL) diff --git a/guile/step1_read_print.scm b/guile/step1_read_print.scm deleted file mode 100644 index 3517f7b791..0000000000 --- a/guile/step1_read_print.scm +++ /dev/null @@ -1,39 +0,0 @@ -;; 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) - (read_str (_readline "user> "))) - -(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 - (catch 'mal-error - (lambda () (PRINT (EVAL (READ) '()))) - (lambda (k . e) - (if (string=? (car e) "blank line") - (display "") - (format #t "Error: ~a~%" (car e))))))) - -(REPL) diff --git a/guile/step2_eval.scm b/guile/step2_eval.scm deleted file mode 100644 index a621118874..0000000000 --- a/guile/step2_eval.scm +++ /dev/null @@ -1,69 +0,0 @@ -;; 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)) - -(define *toplevel* - `((+ . ,+) - (- . ,-) - (* . ,*) - (/ . ,/))) - -(define (READ) - (read_str (_readline "user> "))) - -(define (eval_ast ast env) - (define (_eval x) (EVAL x env)) - (match ast - ((? symbol? sym) - (or (assoc-ref env sym) - (throw 'mal-error (format #f "'~a' not found" sym)))) - ((? list? lst) (map _eval lst)) - ((? vector? vec) (vector-map (lambda (i x) (_eval x)) vec)) - ((? hash-table? ht) - (hash-for-each (lambda (k v) (hash-set! ht k (_eval v))) ht) - ht) - (else ast))) - -(define (eval_func ast env) - (define expr (eval_ast ast env)) - (match expr - (((? procedure? proc) args ...) - (apply proc args)) - (else (throw 'mal-error (format #f "'~a' not found" (car expr)))))) - -(define (EVAL ast env) - (match ast - (() ast) - ((? list?) (eval_func ast env)) - (else (eval_ast ast env)))) - -(define (PRINT exp) - (and (not (eof-object? exp)) - (format #t "~a~%" (pr_str exp #t)))) - -(define (LOOP continue?) - (and continue? (REPL))) - -(define (REPL) - (LOOP - (catch 'mal-error - (lambda () (PRINT (EVAL (READ) *toplevel*))) - (lambda (k . e) - (if (string=? (car e) "blank line") - (display "") - (format #t "Error: ~a~%" (car e))))))) - -(REPL) diff --git a/guile/step3_env.scm b/guile/step3_env.scm deleted file mode 100644 index 40a891b127..0000000000 --- a/guile/step3_env.scm +++ /dev/null @@ -1,87 +0,0 @@ -;; 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)) - -(define *primitives* - `((+ ,+) - (- ,-) - (* ,*) - (/ ,/))) - -(define *toplevel* - (receive (b e) (unzip2 *primitives*) - (make-Env #:binds b #:exprs e))) - -(define (READ) - (read_str (_readline "user> "))) - -(define (eval_ast ast env) - (define (_eval x) (EVAL x env)) - (match ast - ((? symbol? sym) (env-has sym env)) - ((? list? lst) (map _eval lst)) - ((? vector? vec) (vector-map (lambda (i x) (_eval x)) vec)) - ((? hash-table? ht) - (hash-for-each (lambda (k v) (hash-set! ht k (_eval v))) ht) - ht) - (else ast))) - -(define (eval_func ast env) - (define expr (eval_ast ast env)) - (match expr - (((? procedure? proc) args ...) - (apply proc args)) - (else (throw 'mal-error (format #f "'~a' not found" (car expr)))))) - -(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 "let*: Invalid binding form" kvs)) - (else (lp (cddr next) (cons (car next) k) (cons (cadr next) v)))))) - (match ast - ((? (lambda (x) (not (list? x)))) (eval_ast ast env)) - (() 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 (eval_func ast env)))) - -(define (PRINT exp) - (and (not (eof-object? exp)) - (format #t "~a~%" (pr_str exp #t)))) - -(define (LOOP continue?) - (and continue? (REPL))) - -(define (REPL) - (LOOP - (catch 'mal-error - (lambda () (PRINT (EVAL (READ) *toplevel*))) - (lambda (k . e) - (if (string=? (car e) "blank line") - (display "") - (format #t "Error: ~a~%" (car e))))))) - -(REPL) diff --git a/guile/step4_if_fn_do.scm b/guile/step4_if_fn_do.scm deleted file mode 100644 index ac330e84a1..0000000000 --- a/guile/step4_if_fn_do.scm +++ /dev/null @@ -1,101 +0,0 @@ -;; 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) - (read_str (_readline "user> "))) - -(define (eval_ast ast env) - (define (_eval x) (EVAL x env)) - (match ast - ((? _nil? obj) obj) - ((? symbol? sym) (env-has sym env)) - ((? list? lst) (map _eval lst)) - ((? vector? vec) (vector-map (lambda (i x) (_eval x)) vec)) - ((? hash-table? ht) - (hash-for-each (lambda (k v) (hash-set! ht k (_eval v))) ht) - ht) - (else ast))) - -(define (eval_func ast env) - (define expr (eval_ast ast env)) - (match expr - (((? procedure? proc) args ...) - (apply proc args)) - (else (throw 'mal-error (format #f "'~a' not found" (car expr)))))) - -(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 (->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 "let*: Invalid binding form" kvs)) - (else (lp (cddr next) (cons (car next) k) (cons (cadr next) v)))))) - (match 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 "failed to match any pattern in form " 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)))) - ((? list?) (eval_func ast env)) ; function calling - (else (eval_ast ast env)))) - -(define (PRINT exp) - (and (not (eof-object? exp)) - (format #t "~a~%" (pr_str exp #t)))) - -(define (LOOP continue?) - (and continue? (REPL))) - -(define (REPL) - (LOOP - (catch 'mal-error - (lambda () (PRINT (EVAL (READ) *toplevel*))) - (lambda (k . e) - (if (string=? (car e) "blank line") - (display "") - (format #t "Error: ~a~%" (car e))))))) - -(REPL) diff --git a/guile/step5_tco.scm b/guile/step5_tco.scm deleted file mode 100644 index 5971aa4a34..0000000000 --- a/guile/step5_tco.scm +++ /dev/null @@ -1,130 +0,0 @@ -;; 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) - (read_str (_readline "user> "))) - -(define (eval_ast ast env) - (define (_eval x) (EVAL x env)) - (match ast - ((? _nil? obj) obj) - ((? symbol? sym) (env-has sym env)) - ((? list? lst) (map _eval lst)) - ((? vector? vec) (vector-map (lambda (i x) (_eval x)) vec)) - ((? hash-table? ht) - (hash-for-each (lambda (k v) (hash-set! ht k (_eval v))) ht) - ht) - (else ast))) - -(define (eval_func ast env) - (define expr (eval_ast ast env)) - (match expr - (((? procedure? proc) args ...) - (apply proc args)) - (else (throw 'mal-error (format #f "'~a' not found" (car expr)))))) - -(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 (->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 "let*: Invalid binding form" 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)) - (match 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 "do: Invalid form!" 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 "if: failed to match any pattern in form " 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 - (lambda args - (let ((nenv (make-Env #:outer env #:binds (->list params) #:exprs args))) - (cond - ((null? body) (throw 'mal-error "fn*: bad lambda in form " 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))))))) - ((? list?) (eval_func ast env)) ; function calling - (else (eval_ast ast env))))) - -(define (PRINT exp) - (and (not (eof-object? exp)) - (format #t "~a~%" (pr_str exp #t)))) - -(define (LOOP continue?) - (and continue? (REPL))) - -(define (REPL) - (LOOP - (catch 'mal-error - (lambda () (PRINT (EVAL (READ) *toplevel*))) - (lambda (k . e) - (if (string=? (car e) "blank line") - (display "") - (format #t "Error: ~a~%" (car e))))))) - -;; NOTE: we have to reduce stack size to pass step5 test -((@ (system vm vm) call-with-stack-overflow-handler) - 1024 - (lambda () (REPL)) - (lambda k (throw 'mal-error "stack overflow"))) - diff --git a/guile/step6_file.scm b/guile/step6_file.scm deleted file mode 100644 index 3fb7b651be..0000000000 --- a/guile/step6_file.scm +++ /dev/null @@ -1,141 +0,0 @@ -;; 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) - (read_str (_readline "user> "))) - -(define (eval_ast ast env) - (define (_eval x) (EVAL x env)) - (match ast - ((? _nil? obj) obj) - ((? symbol? sym) (env-has sym env)) - ((? list? lst) (map _eval lst)) - ((? vector? vec) (vector-map (lambda (i x) (_eval x)) vec)) - ((? hash-table? ht) - (hash-for-each (lambda (k v) (hash-set! ht k (_eval v))) ht) - ht) - (else ast))) - -(define (eval_func ast env) - (define (_eval o) (EVAL o env)) - (define (func? x) (and=> ((env 'get) x) is-func?)) - (cond - ((func? (car ast)) - => (lambda (c) - (callable-apply c (map _eval (cdr ast))))) - (else (throw 'mal-error (format #f "'~a' not found" (car ast)))))) - -(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 (->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 "let*: Invalid binding form" 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)) - (match 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 "do: Invalid form!" 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 "if: failed to match any pattern in form " 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 "fn*: bad lambda in form " 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)))))))) - ((? list?) (eval_func ast env)) ; function calling - (else (eval_ast ast env))))) - -(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 - (catch 'mal-error - (lambda () (PRINT (EVAL (READ) *toplevel*))) - (lambda (k . e) - (if (string=? (car e) "blank line") - (display "") - (format #t "Error: ~a~%" (car e))))))) - -;; initialization -((*toplevel* 'set) 'eval (make-func (lambda (ast) (EVAL ast *toplevel*)))) -((*toplevel* 'set) '*ARGV* '()) -(EVAL-string "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") - -(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/guile/step7_quote.scm b/guile/step7_quote.scm deleted file mode 100644 index 2cebf4493c..0000000000 --- a/guile/step7_quote.scm +++ /dev/null @@ -1,157 +0,0 @@ -;; 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) - (read_str (_readline "user> "))) - -(define (eval_ast ast env) - (define (_eval x) (EVAL x env)) - (match ast - ((? _nil? obj) obj) - ((? symbol? sym) (env-has sym env)) - ((? list? lst) (map _eval lst)) - ((? vector? vec) (vector-map (lambda (i x) (_eval x)) vec)) - ((? hash-table? ht) - (hash-for-each (lambda (k v) (hash-set! ht k (_eval v))) ht) - ht) - (else ast))) - -(define (eval_func ast env) - (define (_eval o) (EVAL o env)) - (define (func? x) (and=> ((env 'get) x) is-func?)) - (cond - ((func? (car ast)) - => (lambda (c) - (callable-apply c (map _eval (cdr ast))))) - (else (throw 'mal-error (format #f "'~a' not found" (car ast)))))) - -(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 "let*: Invalid binding form" kvs)) - (else (lp (cddr next) (cons (car next) k) (cons (cadr next) v)))))) - ;; (define (_quasiquote ast) - ;; (define (non-pair? x) (not (pair? x))) - ;; (match ast - ;; ((? non-pair?) `(quote ,ast)) - ;; (('unquote unq) unq) - ;; (((? pair? p) ('splice-unquote unqsp) rest ...) - ;; `(concat ,p ,unqsp ,(_quasiquote rest))) - ;; (else `(cons ,(_quasiquote (car ast)) ,(_quasiquote (cdr ast)))))) - (define (_quasiquote obj) - (match obj - ((('unquote unq) rest ...) `(cons ,unq ,(_quasiquote rest))) - (('unquote unq) unq) - ((('splice-unquote unqsp) rest ...) `(concat ,unqsp ,(_quasiquote rest))) - ((head rest ...) (list 'cons (list 'quote head) (_quasiquote rest))) - (else `(quote ,obj)))) - ;; 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)) - (match ast - (() ast) - (('quote obj) obj) - (('quasiquote obj) (EVAL (_quasiquote (->list 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 "do: Invalid form!" 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 "if: failed to match any pattern in form " 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 "fn*: bad lambda in form " 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)))))))) - ((? list?) (eval_func ast env)) ; function calling - (else (eval_ast ast env))))) - -(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 - (catch 'mal-error - (lambda () (PRINT (EVAL (READ) *toplevel*))) - (lambda (k . e) - (if (string=? (car e) "blank line") - (display "") - (format #t "Error: ~a~%" (car e))))))) - -;; initialization -((*toplevel* 'set) 'eval (make-func (lambda (ast) (EVAL ast *toplevel*)))) -((*toplevel* 'set) '*ARGV* '()) -(EVAL-string "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") - -(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/guile/step8_macros.scm b/guile/step8_macros.scm deleted file mode 100644 index af36411f49..0000000000 --- a/guile/step8_macros.scm +++ /dev/null @@ -1,171 +0,0 @@ -;; 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) - (read_str (_readline "user> "))) - -(define (eval_ast ast env) - (define (_eval x) (EVAL x env)) - (match ast - ((? _nil? obj) obj) - ((? symbol? sym) (env-has sym env)) - ((? list? lst) (map _eval lst)) - ((? vector? vec) (vector-map (lambda (i x) (_eval x)) vec)) - ((? hash-table? ht) - (hash-for-each (lambda (k v) (hash-set! ht k (_eval v))) ht) - ht) - (else ast))) - -(define (eval_func ast env) - (define (_eval o) (EVAL o env)) - (define (func? x) (and=> ((env 'get) x) is-func?)) - (cond - ((func? (car ast)) - => (lambda (c) - (callable-apply c (map _eval (cdr ast))))) - (else (throw 'mal-error (format #f "'~a' not found" (car ast)))))) - -(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 (is_macro_call ast env) - (and (list? ast) - (> (length ast) 0) - (and=> (env-check (car ast) env) is-macro?))) - -(define (_macroexpand ast env) - (cond - ((is_macro_call ast env) - => (lambda (c) - ;; NOTE: Macros are normal-order, so we shouldn't eval args here. - ;; Or it's applicable-order. - (_macroexpand (callable-apply c (cdr ast)) env))) - (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 "let*: Invalid binding form" kvs)) - (else (lp (cddr next) (cons (car next) k) (cons (cadr next) v)))))) - (define (_quasiquote obj) - (match obj - ((('unquote unq) rest ...) `(cons ,unq ,(_quasiquote rest))) - (('unquote unq) unq) - ((('splice-unquote unqsp) rest ...) `(concat ,unqsp ,(_quasiquote rest))) - ((head rest ...) (list 'cons (_quasiquote head) (_quasiquote rest))) - (else `(quote ,obj)))) - ;; 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)) ; expand as possible - (let ((ast (_macroexpand ast env))) - (match ast - ((? non-list?) (eval_ast ast env)) - (() ast) - (('defmacro! k v) - (let ((c (EVAL v env))) - (callable-is_macro-set! c #t) - ((env 'set) k c))) - (('macroexpand obj) (_macroexpand obj env)) - (('quote obj) obj) - (('quasiquote obj) (EVAL (_quasiquote (->list 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 "do: Invalid form!" 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 "if: failed to match any pattern in form " 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 "fn*: bad lambda in form " 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 (eval_func ast env)))))) - -(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 - (catch 'mal-error - (lambda () (PRINT (EVAL (READ) *toplevel*))) - (lambda (k . e) - (if (string=? (car e) "blank line") - (display "") - (format #t "Error: ~a~%" (car e))))))) - -;; initialization -((*toplevel* 'set) 'eval (make-func (lambda (ast) (EVAL ast *toplevel*)))) -((*toplevel* 'set) '*ARGV* '()) -(EVAL-string "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") -(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 "(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))))))))") - -(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/guile/step9_try.scm b/guile/step9_try.scm deleted file mode 100644 index 01ab6deaa9..0000000000 --- a/guile/step9_try.scm +++ /dev/null @@ -1,183 +0,0 @@ -;; 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) - (read_str (_readline "user> "))) - -(define (eval_ast ast env) - (define (_eval x) (EVAL x env)) - (match ast - ((? _nil? obj) obj) - ((? symbol? sym) (env-has sym env)) - ((? list? lst) (map _eval lst)) - ((? vector? vec) (vector-map (lambda (i x) (_eval x)) vec)) - ((? hash-table? ht) - (hash-for-each (lambda (k v) (hash-set! ht k (_eval v))) ht) - ht) - (else ast))) - -(define (eval_func ast env) - (define (_eval o) (EVAL o env)) - (define (func? x) (and=> (env-check x env) is-func?)) - ;;(format #t "AAA: ~a~%" (func? (car ast))) - (cond - ((func? (car ast)) - => (lambda (c) - (callable-apply c (map _eval (cdr ast))))) - (else (throw 'mal-error (format #f "'~a' not found" (car ast)))))) - -(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 (is_macro_call ast env) - (and (list? ast) - (> (length ast) 0) - (and=> (env-check (car ast) env) is-macro?))) - -(define (_macroexpand ast env) - (cond - ((is_macro_call ast env) - => (lambda (c) - ;;(format #t "AAA: ~a, ~a~%" ast (_macroexpand (callable-apply c (cdr ast)) env)) - ;;(format #t "BBB: ~a~%" (_macroexpand (callable-apply c (cdr ast)) env)) - ;; NOTE: Macros are normal-order, so we shouldn't eval args here. - ;; Or it's applicable-order. - (_macroexpand (callable-apply c (cdr ast)) env))) - (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 "let*: Invalid binding form" kvs)) - (else (lp (cddr next) (cons (car next) k) (cons (cadr next) v)))))) - (define (_quasiquote obj) - (match obj - ((('unquote unq) rest ...) `(cons ,unq ,(_quasiquote rest))) - (('unquote unq) unq) - ((('splice-unquote unqsp) rest ...) `(concat ,unqsp ,(_quasiquote rest))) - ((head rest ...) (list 'cons (_quasiquote head) (_quasiquote rest))) - (else `(quote ,obj)))) - ;; 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)) ; expand as possible - ;;(format #t "CCC: ~a === ~a~%" ast (_macroexpand ast env)) - (let ((ast (_macroexpand ast env))) - (match ast - ((? non-list?) (eval_ast ast env)) - (() ast) - (('defmacro! k v) - (let ((c (EVAL v env))) - (callable-is_macro-set! c #t) - ((env 'set) k c))) - (('macroexpand obj) (_macroexpand obj env)) - (('quote obj) obj) - (('quasiquote obj) (EVAL (_quasiquote (->list 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 "do: Invalid form!" 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 "if: failed to match any pattern in form " 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 "fn*: bad lambda in form " 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 ('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 (eval_func ast env)))))) - -(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 - (catch 'mal-error - (lambda () (PRINT (EVAL (READ) *toplevel*))) - (lambda (k . e) - (if (string=? (car e) "blank line") - (display "") - (format #t "Error: ~a~%" (car e))))))) - -;; 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! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") -(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 "(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))))))))") - -(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/guile/stepA_mal.scm b/guile/stepA_mal.scm deleted file mode 100644 index 98127ae252..0000000000 --- a/guile/stepA_mal.scm +++ /dev/null @@ -1,210 +0,0 @@ -;; 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) - (read_str (_readline "user> "))) - -(define (eval_ast ast env) - (define (_eval x) (EVAL x env)) - (match ast - ((? symbol? sym) (env-has sym env)) - ((? list? lst) (map _eval lst)) - ((? vector? vec) (vector-map (lambda (i x) (_eval x)) vec)) - ((? hash-table? ht) - ;; NOTE: we must allocate a new hashmap here to avoid any side-effects, or - ;; there'll be strange bugs!!! - (list->hash-map (hash-fold (lambda (k v p) (cons k (cons (_eval v) p))) '() ht))) - (else ast))) - -(define (eval_func ast env) - (define (_eval o) (EVAL o env)) - (define (func? x) - (let ((f (if (list? x) - (EVAL x env) - x))) - (if (callable? f) - f - (and=> (env-check f env) is-func?)))) - (cond - ((func? (car ast)) - => (lambda (c) - (callable-apply c (map _eval (cdr ast))))) - (else (throw 'mal-error (format #f "'~a' not found" (car ast)))))) - -(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 (is_macro_call ast env) - (and (list? ast) - (> (length ast) 0) - (and=> (env-check (car ast) env) is-macro?))) - -(define (_macroexpand ast env) - (cond - ((is_macro_call ast env) - => (lambda (c) - ;; NOTE: Macros are normal-order, so we shouldn't eval args here. - ;; Or it's applicable-order. - (_macroexpand (callable-apply c (cdr ast)) env))) - (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)))))) - (define (_quasiquote obj) - (match obj - ((('unquote unq) rest ...) `(cons ,unq ,(_quasiquote rest))) - (('unquote unq) unq) - ((('splice-unquote unqsp) rest ...) `(concat ,unqsp ,(_quasiquote rest))) - ((head rest ...) (list 'cons (_quasiquote head) (_quasiquote rest))) - (else `(quote ,obj)))) - ;; 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)) ; expand as possible - (let ((ast (_macroexpand ast env))) - (match ast - ((? non-list?) (eval_ast ast env)) - (() ast) - (('defmacro! k v) - (let ((c (EVAL v env))) - (callable-is_macro-set! c #t) - ((env 'set) k c))) - (('macroexpand obj) (_macroexpand obj env)) - (('quote obj) obj) - (('quasiquote obj) (EVAL (_quasiquote (->list 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 ('catch* B C)) - (catch - #t - (lambda () (EVAL A env)) - (lambda (k . e) - (case k - ((mal-error) - (let ((nenv (make-Env #:outer env #:binds (list B) #:exprs e))) - (EVAL C nenv))) - ;; TODO: add backtrace - (else (print-exception (current-output-port) #f k e)))))) - (else (eval_func ast env)))))) - -(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 - (catch #t - (lambda () (PRINT (EVAL (READ) *toplevel*))) - (lambda (k . e) - (case k - ((mal-error) - (if (string=? (car e) "blank line") - (display "") - (format #t "Error: ~a~%" (car e)))) - (else (print-exception (current-output-port) #f k e))))))) - -;; 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! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") -(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! *gensym-counter* (atom 0))") -(EVAL-string "(def! gensym (fn* [] (symbol (str \"G__\" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))") -(EVAL-string "(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)))))))))") -(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/haskell/Core.hs b/haskell/Core.hs deleted file mode 100644 index da7a2dd00b..0000000000 --- a/haskell/Core.hs +++ /dev/null @@ -1,312 +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 ('\x029e':str):[]) = return $ MalString $ "\x029e" ++ str -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 Nil = Nil -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 Nil = MalList [] 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" - -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 - -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" - -do_seq (l@(MalList [] _):[]) = return $ Nil -do_seq (l@(MalList lst m):[]) = return $ l -do_seq (MalVector [] _:[]) = return $ Nil -do_seq (MalVector lst _:[]) = return $ MalList lst Nil -do_seq (MalString []:[]) = return $ Nil -do_seq (MalString s:[]) = return $ MalList [MalString [c] | c <- s] Nil -do_seq (Nil:[]) = return $ Nil -do_seq _ = throwStr $ "seq: called on non-sequence" - --- 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), - ("string?", _func $ run_1 $ _string_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), - ("apply", _func $ apply), - ("map", _func $ do_map), - - ("conj", _func $ conj), - ("seq", _func $ do_seq), - - ("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/Dockerfile b/haskell/Dockerfile deleted file mode 100644 index 022985be46..0000000000 --- a/haskell/Dockerfile +++ /dev/null @@ -1,25 +0,0 @@ -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 -########################################################## - -# Haskell -RUN apt-get -y install ghc haskell-platform libghc-readline-dev libghc-editline-dev 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 b5912c6927..0000000000 --- a/haskell/Makefile +++ /dev/null @@ -1,35 +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) - -dist: 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 $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*--|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*--|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" 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 c90a9bda29..0000000000 --- a/haskell/Reader.hs +++ /dev/null @@ -1,163 +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 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 = do - x <- many1 digit - return $ MalNumber $ read x - -read_negative_number :: Parser MalVal -read_negative_number = do - sign <- char '-' - rest <- many1 digit - return $ MalNumber $ read $ sign:rest - -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 - <|> try read_negative_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 077f26f6b6..0000000000 --- a/haskell/Readline.hs +++ /dev/null @@ -1,38 +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 Control.Monad (when) -import System.Directory (getHomeDirectory, doesFileExist) - -import System.IO (hGetLine, hFlush, hIsEOF, stdin, stdout) -import System.IO.Error (tryIOError) - -history_file = do - home <- getHomeDirectory - return $ home ++ "/.mal-history" - -load_history = do - hfile <- history_file - fileExists <- doesFileExist hfile - when fileExists $ do - content <- readFile hfile - mapM RL.addHistory (lines content) - return () - return () - -readline prompt = do - hfile <- history_file - maybeLine <- RL.readline prompt - case maybeLine of - Just line -> do - RL.addHistory line - res <- tryIOError (appendFile hfile (line ++ "\n")) - return maybeLine - _ -> return maybeLine diff --git a/haskell/Types.hs b/haskell/Types.hs deleted file mode 100644 index fb9812bb1c..0000000000 --- a/haskell/Types.hs +++ /dev/null @@ -1,141 +0,0 @@ -module Types -(MalVal (..), MalError (..), IOThrows (..), Fn (..), EnvData (..), Env, - throwStr, throwMalVal, _get_call, _to_list, - _func, _malfunc, - _nil_Q, _true_Q, _false_Q, _string_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 (MalVector a _) (MalVector 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 - -_string_Q (MalString ('\x029e':_)) = MalFalse -_string_Q (MalString _) = MalTrue -_string_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/run b/haskell/run deleted file mode 100755 index 8ba68a5484..0000000000 --- a/haskell/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec $(dirname $0)/${STEP:-stepA_mal} "${@}" 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 bc40f17833..0000000000 --- a/haskell/step2_eval.hs +++ /dev/null @@ -1,95 +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 - return ast -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 428027fdd2..0000000000 --- a/haskell/step3_env.hs +++ /dev/null @@ -1,115 +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 [] _) env = do - return ast -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 5624716f5a..0000000000 --- a/haskell/step4_if_fn_do.hs +++ /dev/null @@ -1,142 +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 [] _) env = do - return ast -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 4e9def5c38..0000000000 --- a/haskell/step5_tco.hs +++ /dev/null @@ -1,146 +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 [] _) env = do - return ast -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 bc2897cf33..0000000000 --- a/haskell/step6_file.hs +++ /dev/null @@ -1,156 +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 [] _) env = do - return ast -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 60158c30f8..0000000000 --- a/haskell/step7_quote.hs +++ /dev/null @@ -1,185 +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 [] _) env = do - return ast -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 64a42d539c..0000000000 --- a/haskell/step8_macros.hs +++ /dev/null @@ -1,240 +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 [] _) env = do - return ast -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 ddcabdca87..0000000000 --- a/haskell/step9_try.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 [] _) env = do - return ast -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 42fb67819b..0000000000 --- a/haskell/stepA_mal.hs +++ /dev/null @@ -1,259 +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 [] _) env = do - return ast -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 "(def! *gensym-counter* (atom 0))" - runErrorT $ rep repl_env "(def! gensym (fn* [] (symbol (str \"G__\" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))" - runErrorT $ rep repl_env "(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 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/haxe/Dockerfile b/haxe/Dockerfile deleted file mode 100644 index 545c7a612a..0000000000 --- a/haxe/Dockerfile +++ /dev/null @@ -1,55 +0,0 @@ -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 -########################################################## - -### -# Node - -# For building node modules -RUN apt-get -y install g++ - -# Add nodesource apt repo config for 0.12 stable -RUN curl -sL https://deb.nodesource.com/setup_0.12 | bash - - -# Install nodejs -RUN apt-get -y install nodejs - -# Link common name -RUN ln -sf nodejs /usr/bin/node - -ENV NPM_CONFIG_CACHE /mal/.npm - - -### -# Haxe - -RUN apt-get -y install software-properties-common && \ - add-apt-repository -y ppa:haxe/releases && \ - apt-get -y update - -ENV HOME / -RUN apt-get install -y haxe && \ - mkdir /haxelib && haxelib setup /haxelib - -# Install support for C++ compilation -RUN haxelib install hxcpp - diff --git a/haxe/Makefile b/haxe/Makefile deleted file mode 100644 index 30ad30088e..0000000000 --- a/haxe/Makefile +++ /dev/null @@ -1,116 +0,0 @@ -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 -SOURCES = $(STEP4_DEPS) StepA_mal.hx -SOURCES_LISP = env/Env.hx core/Core.hx StepA_mal.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_DIST_MODE = neko -dist_neko = mal.n -dist_python = mal.py -dist_cpp = cpp/mal - -all: all-neko all-python all-cpp all-js - -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_DIST_MODE)) - $(if $(filter cpp,$(HAXE_DIST_MODE)),\ - cp $< $@;,\ - $(if $(filter neko,$(HAXE_DIST_MODE)),\ - nekotools boot $<;,\ - $(if $(filter js,$(HAXE_DIST_MODE)),\ - echo "#!/usr/bin/env node" > $@;\ - cat $< >> $@;,\ - $(if $(filter python,$(HAXE_DIST_MODE)),\ - echo "#!/usr/bin/env python3" > $@;\ - cat $< >> $@;,\ - $(error Invalid HAXE_DIST_MODE: $(HAXE_DIST_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 - -.PHONY: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" - diff --git a/haxe/Step2_eval.hx b/haxe/Step2_eval.hx deleted file mode 100644 index a61239ade1..0000000000 --- a/haxe/Step2_eval.hx +++ /dev/null @@ -1,92 +0,0 @@ -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(ast:MalType, env:Map) { - return switch (ast) { - case MalSymbol(s): - if (env.exists(s)) { - env.get(s); - } else { - throw "'" + s + "' not found"; - } - case MalList(l): - MalList(l.map(function(x) { return EVAL(x, env); })); - case MalVector(l): - 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); - } - MalHashMap(new_map); - case _: ast; - } - } - - static function EVAL(ast:MalType, env:Map):MalType { - if (!list_Q(ast)) { return eval_ast(ast, env); } - - // apply - var alst = switch (ast) { case MalList(lst): lst; case _: []; } - if (alst.length == 0) { return ast; } - - var el = eval_ast(ast, env); - var lst = switch (el) { case MalList(lst): lst; case _: []; } - var a0 = lst[0], args = lst.slice(1); - switch (a0) { - case MalFunc(f,_,_,_,_,_): 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(exc); - } - } - } -} diff --git a/haxe/Step4_if_fn_do.hx b/haxe/Step4_if_fn_do.hx deleted file mode 100644 index 064df794cb..0000000000 --- a/haxe/Step4_if_fn_do.hx +++ /dev/null @@ -1,114 +0,0 @@ -import Compat; -import types.Types.MalType; -import types.Types.*; -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(ast:MalType, env:Env) { - return switch (ast) { - case MalSymbol(s): env.get(ast); - case MalList(l): - MalList(l.map(function(x) { return EVAL(x, env); })); - case MalVector(l): - 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); - } - MalHashMap(new_map); - case _: ast; - } - } - - static function EVAL(ast:MalType, env:Env):MalType { - if (!list_Q(ast)) { return eval_ast(ast, env); } - - // apply - var alst = _list(ast); - 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"): - return last(eval_ast(MalList(alst.slice(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 _: - var el = eval_ast(ast, env); - var lst = _list(el); - switch (first(el)) { - case MalFunc(f,_,_,_,_,_): return f(_list(el).slice(1)); - 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) { - Compat.println(exc); - } - } - } -} diff --git a/haxe/Step7_quote.hx b/haxe/Step7_quote.hx deleted file mode 100644 index c1fe9ec7d7..0000000000 --- a/haxe/Step7_quote.hx +++ /dev/null @@ -1,177 +0,0 @@ -import Compat; -import types.Types.MalType; -import types.Types.*; -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 is_pair(ast:MalType) { - return switch (ast) { - case MalList(l) | MalVector(l): l.length > 0; - case _: false; - } - } - - static function quasiquote(ast:MalType) { - if (!is_pair(ast)) { - return MalList([MalSymbol("quote"), ast]); - } else { - var a0 = first(ast); - if (_equal_Q(a0, MalSymbol("unquote"))) { - return _nth(ast, 1); - } else if (is_pair(a0)) { - var a00 = first(a0); - if (_equal_Q(a00, MalSymbol("splice-unquote"))) { - return MalList([MalSymbol("concat"), - _nth(a0, 1), - quasiquote(rest(ast))]); - } - } - return MalList([MalSymbol("cons"), - quasiquote(a0), - quasiquote(rest(ast))]); - } - } - - static function eval_ast(ast:MalType, env:Env) { - return switch (ast) { - case MalSymbol(s): env.get(ast); - case MalList(l): - MalList(l.map(function(x) { return EVAL(x, env); })); - case MalVector(l): - 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); - } - MalHashMap(new_map); - case _: ast; - } - } - - static function EVAL(ast:MalType, env:Env):MalType { - while (true) { - if (!list_Q(ast)) { return eval_ast(ast, env); } - - // apply - var alst = _list(ast); - 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"): - var el = eval_ast(MalList(alst.slice(1, alst.length-1)), env); - ast = last(ast); - 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 _: - var el = eval_ast(ast, env); - var lst = _list(el); - switch (first(el)) { - case MalFunc(f,a,e,params,_,_): - var args = _list(el).slice(1); - 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) \")\")))))"); - - 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) { - Compat.println(exc); - } - } - } -} diff --git a/haxe/Step8_macros.hx b/haxe/Step8_macros.hx deleted file mode 100644 index 525b03be48..0000000000 --- a/haxe/Step8_macros.hx +++ /dev/null @@ -1,216 +0,0 @@ -import Compat; -import types.Types.MalType; -import types.Types.*; -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 is_pair(ast:MalType) { - return switch (ast) { - case MalList(l) | MalVector(l): l.length > 0; - case _: false; - } - } - - static function quasiquote(ast:MalType) { - if (!is_pair(ast)) { - return MalList([MalSymbol("quote"), ast]); - } else { - var a0 = first(ast); - if (_equal_Q(a0, MalSymbol("unquote"))) { - return _nth(ast, 1); - } else if (is_pair(a0)) { - var a00 = first(a0); - if (_equal_Q(a00, MalSymbol("splice-unquote"))) { - return MalList([MalSymbol("concat"), - _nth(a0, 1), - quasiquote(rest(ast))]); - } - } - return MalList([MalSymbol("cons"), - quasiquote(a0), - quasiquote(rest(ast))]); - } - } - - static function is_macro(ast:MalType, env:Env) { - return switch(ast) { - case MalList([]): false; - case MalList(a): - var a0 = a[0]; - return symbol_Q(a0) && - env.find(a0) != null && - _macro_Q(env.get(a0)); - case _: false; - } - } - - static function macroexpand(ast:MalType, env:Env) { - while (is_macro(ast, env)) { - var mac = env.get(first(ast)); - switch (mac) { - case MalFunc(f,_,_,_,_,_): - ast = f(_list(ast).slice(1)); - case _: break; - } - } - return ast; - } - - static function eval_ast(ast:MalType, env:Env) { - return switch (ast) { - case MalSymbol(s): env.get(ast); - case MalList(l): - MalList(l.map(function(x) { return EVAL(x, env); })); - case MalVector(l): - 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); - } - MalHashMap(new_map); - case _: ast; - } - } - - static function EVAL(ast:MalType, env:Env):MalType { - while (true) { - if (!list_Q(ast)) { return eval_ast(ast, env); } - - // apply - ast = macroexpand(ast, env); - if (!list_Q(ast)) { return eval_ast(ast, env); } - - var alst = _list(ast); - 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("macroexpand"): - return macroexpand(alst[1], env); - case MalSymbol("do"): - var el = eval_ast(MalList(alst.slice(1, alst.length-1)), env); - ast = last(ast); - 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 _: - var el = eval_ast(ast, env); - var lst = _list(el); - switch (first(el)) { - case MalFunc(f,a,e,params,_,_): - var args = _list(el).slice(1); - 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) \")\")))))"); - 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 (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) { - Compat.println(exc); - } - } - } -} diff --git a/haxe/Step9_try.hx b/haxe/Step9_try.hx deleted file mode 100644 index 52d7480fa9..0000000000 --- a/haxe/Step9_try.hx +++ /dev/null @@ -1,239 +0,0 @@ -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 is_pair(ast:MalType) { - return switch (ast) { - case MalList(l) | MalVector(l): l.length > 0; - case _: false; - } - } - - static function quasiquote(ast:MalType) { - if (!is_pair(ast)) { - return MalList([MalSymbol("quote"), ast]); - } else { - var a0 = first(ast); - if (_equal_Q(a0, MalSymbol("unquote"))) { - return _nth(ast, 1); - } else if (is_pair(a0)) { - var a00 = first(a0); - if (_equal_Q(a00, MalSymbol("splice-unquote"))) { - return MalList([MalSymbol("concat"), - _nth(a0, 1), - quasiquote(rest(ast))]); - } - } - return MalList([MalSymbol("cons"), - quasiquote(a0), - quasiquote(rest(ast))]); - } - } - - static function is_macro(ast:MalType, env:Env) { - return switch(ast) { - case MalList([]): false; - case MalList(a): - var a0 = a[0]; - return symbol_Q(a0) && - env.find(a0) != null && - _macro_Q(env.get(a0)); - case _: false; - } - } - - static function macroexpand(ast:MalType, env:Env) { - while (is_macro(ast, env)) { - var mac = env.get(first(ast)); - switch (mac) { - case MalFunc(f,_,_,_,_,_): - ast = f(_list(ast).slice(1)); - case _: break; - } - } - return ast; - } - - static function eval_ast(ast:MalType, env:Env) { - return switch (ast) { - case MalSymbol(s): env.get(ast); - case MalList(l): - MalList(l.map(function(x) { return EVAL(x, env); })); - case MalVector(l): - 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); - } - MalHashMap(new_map); - case _: ast; - } - } - - static function EVAL(ast:MalType, env:Env):MalType { - while (true) { - if (!list_Q(ast)) { return eval_ast(ast, env); } - - // apply - ast = macroexpand(ast, env); - if (!list_Q(ast)) { return eval_ast(ast, env); } - - var alst = _list(ast); - 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("macroexpand"): - return macroexpand(alst[1], env); - 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"): - var el = eval_ast(MalList(alst.slice(1, alst.length-1)), env); - ast = last(ast); - 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 _: - var el = eval_ast(ast, env); - var lst = _list(el); - switch (first(el)) { - case MalFunc(f,a,e,params,_,_): - var args = _list(el).slice(1); - 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) \")\")))))"); - 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 (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) { - Compat.println(exc); - } - } - } -} diff --git a/haxe/StepA_mal.hx b/haxe/StepA_mal.hx deleted file mode 100644 index 2d00764806..0000000000 --- a/haxe/StepA_mal.hx +++ /dev/null @@ -1,243 +0,0 @@ -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 is_pair(ast:MalType) { - return switch (ast) { - case MalList(l) | MalVector(l): l.length > 0; - case _: false; - } - } - - static function quasiquote(ast:MalType) { - if (!is_pair(ast)) { - return MalList([MalSymbol("quote"), ast]); - } else { - var a0 = first(ast); - if (_equal_Q(a0, MalSymbol("unquote"))) { - return _nth(ast, 1); - } else if (is_pair(a0)) { - var a00 = first(a0); - if (_equal_Q(a00, MalSymbol("splice-unquote"))) { - return MalList([MalSymbol("concat"), - _nth(a0, 1), - quasiquote(rest(ast))]); - } - } - return MalList([MalSymbol("cons"), - quasiquote(a0), - quasiquote(rest(ast))]); - } - } - - static function is_macro(ast:MalType, env:Env) { - return switch(ast) { - case MalList([]): false; - case MalList(a): - var a0 = a[0]; - return symbol_Q(a0) && - env.find(a0) != null && - _macro_Q(env.get(a0)); - case _: false; - } - } - - static function macroexpand(ast:MalType, env:Env) { - while (is_macro(ast, env)) { - var mac = env.get(first(ast)); - switch (mac) { - case MalFunc(f,_,_,_,_,_): - ast = f(_list(ast).slice(1)); - case _: break; - } - } - return ast; - } - - static function eval_ast(ast:MalType, env:Env) { - return switch (ast) { - case MalSymbol(s): env.get(ast); - case MalList(l): - MalList(l.map(function(x) { return EVAL(x, env); })); - case MalVector(l): - 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); - } - MalHashMap(new_map); - case _: ast; - } - } - - static function EVAL(ast:MalType, env:Env):MalType { - while (true) { - if (!list_Q(ast)) { return eval_ast(ast, env); } - - // apply - ast = macroexpand(ast, env); - if (!list_Q(ast)) { return eval_ast(ast, env); } - - var alst = _list(ast); - 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("macroexpand"): - return macroexpand(alst[1], env); - 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"): - var el = eval_ast(MalList(alst.slice(1, alst.length-1)), env); - ast = last(ast); - 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 _: - var el = eval_ast(ast, env); - var lst = _list(el); - switch (first(el)) { - case MalFunc(f,a,e,params,_,_): - var args = _list(el).slice(1); - 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) \")\")))))"); - 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! *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)))))))))"); - - - 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) { - Compat.println(exc); - } - } - } -} diff --git a/haxe/env/Env.hx b/haxe/env/Env.hx deleted file mode 100644 index ce60fa89a5..0000000000 --- a/haxe/env/Env.hx +++ /dev/null @@ -1,62 +0,0 @@ -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 find(key:MalType):Env { - return switch (key) { - case MalSymbol(s): - if (data.exists(s)) { this; } - else if (outer != null) { outer.find(key); } - else { null; } - case _: throw "Invalid Env.find call"; - } - } - - public function get(key:MalType):MalType { - return switch (key) { - case MalSymbol(s): - var e = find(key); - if (e == null) { throw "'" + s + "' not found"; } - return e.data.get(s); - case _: throw "Invalid Env.get call"; - } - } -} diff --git a/haxe/node_readline.js b/haxe/node_readline.js deleted file mode 100644 index 2045d66632..0000000000 --- a/haxe/node_readline.js +++ /dev/null @@ -1,46 +0,0 @@ -// 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'), - 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 + +########################################################## +# 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/ada/core.ads b/impls/ada/core.ads similarity index 100% rename from ada/core.ads rename to impls/ada/core.ads diff --git a/ada/envs.adb b/impls/ada/envs.adb similarity index 100% rename from ada/envs.adb rename to impls/ada/envs.adb diff --git a/ada/envs.ads b/impls/ada/envs.ads similarity index 100% rename from ada/envs.ads rename to impls/ada/envs.ads diff --git a/ada/eval_callback.ads b/impls/ada/eval_callback.ads similarity index 100% rename from ada/eval_callback.ads rename to impls/ada/eval_callback.ads diff --git a/ada/printer.adb b/impls/ada/printer.adb similarity index 100% rename from ada/printer.adb rename to impls/ada/printer.adb diff --git a/ada/printer.ads b/impls/ada/printer.ads similarity index 100% rename from ada/printer.ads rename to impls/ada/printer.ads 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/ada/smart_pointers.adb b/impls/ada/smart_pointers.adb similarity index 100% rename from ada/smart_pointers.adb rename to impls/ada/smart_pointers.adb diff --git a/ada/smart_pointers.ads b/impls/ada/smart_pointers.ads similarity index 100% rename from ada/smart_pointers.ads rename to impls/ada/smart_pointers.ads 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/ada/types-hash_map.adb b/impls/ada/types-hash_map.adb similarity index 100% rename from ada/types-hash_map.adb rename to impls/ada/types-hash_map.adb diff --git a/ada/types-hash_map.ads b/impls/ada/types-hash_map.ads similarity index 100% rename from ada/types-hash_map.ads rename to impls/ada/types-hash_map.ads diff --git a/ada/types-vector.adb b/impls/ada/types-vector.adb similarity index 98% rename from ada/types-vector.adb rename to impls/ada/types-vector.adb index 3d1ae0403a..b4dc70f56e 100644 --- a/ada/types-vector.adb +++ b/impls/ada/types-vector.adb @@ -91,7 +91,7 @@ package body Types.Vector is overriding function Nth (L : Vector_Mal_Type; N : Natural) return Mal_Handle is begin if N >= L.Length then - raise Mal_Exception with "Nth (vector): Index out of range"; + raise Runtime_Exception with "Nth (vector): Index out of range"; else return Mal_Vectors.Element (L.Vec, Vec_Index (N)); end if; diff --git a/ada/types-vector.ads b/impls/ada/types-vector.ads similarity index 100% rename from ada/types-vector.ads rename to impls/ada/types-vector.ads 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/awk/core.awk b/impls/awk/core.awk similarity index 95% rename from awk/core.awk rename to impls/awk/core.awk index f7c03de989..93a18ec759 100644 --- a/awk/core.awk +++ b/impls/awk/core.awk @@ -19,11 +19,14 @@ function core_eq_sub(lhs, rhs, i, len) } else if (lhs ~ /^\{/ && rhs ~ /^\{/) { lhs = substr(lhs, 2) rhs = substr(rhs, 2) - if (length(types_heap[lhs]) != length(types_heap[rhs])) { + 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 (types_heap[lhs][i] ~ /^["':+#([{?&$%]/ && + if ( i != "meta" && + types_heap[lhs][i] ~ /^["':+#([{?&$%]/ && !core_eq_sub(types_heap[lhs][i], types_heap[rhs][i])) { return 0 } @@ -127,6 +130,32 @@ function core_keywordp(idx) 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) @@ -602,6 +631,24 @@ function core_concat(idx, new_idx, new_len, len, i, lst, lst_idx, lst_len, j) 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) { @@ -1028,6 +1075,9 @@ function core_init() 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" @@ -1049,6 +1099,7 @@ function core_init() 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" diff --git a/awk/env.awk b/impls/awk/env.awk similarity index 99% rename from awk/env.awk rename to impls/awk/env.awk index 078f4558a4..8f5b6d7812 100644 --- a/awk/env.awk +++ b/impls/awk/env.awk @@ -43,7 +43,7 @@ function env_set(env, key, val) if (key in env_heap[env]) { types_release(env_heap[env][key]) } - if (val ~ /^\&/) { + if (val ~ /^&/) { env_builtinnames[substr(val, 2)] = substr(key, 2) } env_heap[env][key] = val diff --git a/awk/printer.awk b/impls/awk/printer.awk similarity index 100% rename from awk/printer.awk rename to impls/awk/printer.awk diff --git a/awk/reader.awk b/impls/awk/reader.awk similarity index 91% rename from awk/reader.awk rename to impls/awk/reader.awk index 95824ee549..66295c9ea2 100644 --- a/awk/reader.awk +++ b/impls/awk/reader.awk @@ -1,9 +1,10 @@ function reader_read_string(token, v, r) { token = substr(token, 1, length(token) - 1) - gsub(/\\\\/, "\\", token) + gsub(/\\\\/, "\xf7", token) gsub(/\\"/, "\"", token) gsub(/\\n/, "\n", token) + gsub("\xf7", "\\", token) return token } @@ -17,7 +18,11 @@ function reader_read_atom(token) case /^:/: return ":" token case /^"/: - return reader_read_string(token) + if (token ~ /^"(\\.|[^\\"])*"$/) { + return reader_read_string(token) + } else { + return "!\"Expected '\"', got EOF." + } case /^-?[0-9]+$/: return "+" token default: @@ -45,7 +50,7 @@ function reader_read_list(reader, type, end, idx, len, ret) } types_heap[idx]["len"] = len types_release(type idx) - return "!\"expect " end ", got EOF" + return "!\"expected '" end "', got EOF" } function reader_read_hash(reader, idx, key, val) @@ -78,7 +83,7 @@ function reader_read_hash(reader, idx, key, val) types_heap[idx][key] = val } types_release("{" idx) - return "!\"expect }, got EOF" + return "!\"expected '}', got EOF" } function reader_read_abbrev(reader, symbol, val, idx) @@ -146,7 +151,7 @@ function reader_read_from(reader, current) function reader_tokenizer(str, reader, len, r) { - for (len = 0; match(str, /^[ \t\r\n,]*(~@|[\[\]{}()'`~^@]|\"(\\[^\r\n]|[^\\"\r\n])*\"|;[^\r\n]*|[^ \t\r\n\[\]{}('"`,;)^~@][^ \t\r\n\[\]{}('"`,;)]*)/, 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] } 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/awk/step0_repl.awk b/impls/awk/step0_repl.awk similarity index 100% rename from awk/step0_repl.awk rename to impls/awk/step0_repl.awk diff --git a/awk/step1_read_print.awk b/impls/awk/step1_read_print.awk similarity index 100% rename from awk/step1_read_print.awk rename to impls/awk/step1_read_print.awk diff --git a/awk/step2_eval.awk b/impls/awk/step2_eval.awk similarity index 85% rename from awk/step2_eval.awk rename to impls/awk/step2_eval.awk index 145a7cf44c..8b56497d46 100644 --- a/awk/step2_eval.awk +++ b/impls/awk/step2_eval.awk @@ -8,18 +8,20 @@ function READ(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) { - switch (ast) { - case /^'/: - if (ast in env) { - return types_addref(env[ast]) - } - return "!\"'" substr(ast, 2) "' not found" - case /^[([]/: idx = substr(ast, 2) len = types_heap[idx]["len"] new_idx = types_allocate() - for (i = 0; i < len; ++i) { + 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 @@ -30,7 +32,10 @@ function eval_ast(ast, env, i, idx, len, new_idx, ret) } types_heap[new_idx]["len"] = len return substr(ast, 1, 1) new_idx - case /^\{/: +} + +function eval_map(ast, env, i, idx, new_idx, ret) +{ idx = substr(ast, 2) new_idx = types_allocate() for (i in types_heap[idx]) { @@ -44,29 +49,48 @@ function eval_ast(ast, env, i, idx, len, new_idx, ret) } } return "{" new_idx - default: - return ast - } } function EVAL(ast, env, new_ast, ret, idx, f, f_idx) { - if (ast !~ /^\(/) { + # 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) - f = types_heap[idx][0] if (f ~ /^&/) { f_idx = substr(f, 2) ret = @f_idx(idx) diff --git a/awk/step3_env.awk b/impls/awk/step3_env.awk similarity index 87% rename from awk/step3_env.awk rename to impls/awk/step3_env.awk index 203ef50a45..c4c09d9c8a 100644 --- a/awk/step3_env.awk +++ b/impls/awk/step3_env.awk @@ -9,19 +9,20 @@ function READ(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) { - switch (ast) { - case /^'/: - ret = env_get(env, ast) - if (ret !~ /^!/) { - types_addref(ret) - } - return ret - case /^[([]/: idx = substr(ast, 2) len = types_heap[idx]["len"] new_idx = types_allocate() - for (i = 0; i < len; ++i) { + 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 @@ -32,7 +33,10 @@ function eval_ast(ast, env, i, idx, len, new_idx, ret) } types_heap[new_idx]["len"] = len return substr(ast, 1, 1) new_idx - case /^\{/: +} + +function eval_map(ast, env, i, idx, new_idx, ret) +{ idx = substr(ast, 2) new_idx = types_allocate() for (i in types_heap[idx]) { @@ -46,9 +50,6 @@ function eval_ast(ast, env, i, idx, len, new_idx, ret) } } return "{" new_idx - default: - return ast - } } function EVAL_def(ast, env, idx, sym, ret, len) @@ -125,11 +126,39 @@ function EVAL_let(ast, env, idx, params, params_idx, params_len, new_env, i, function EVAL(ast, env, new_ast, ret, idx, f, f_idx) { env_addref(env) - if (ast !~ /^\(/) { + + 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) { @@ -142,6 +171,12 @@ function EVAL(ast, env, new_ast, ret, idx, f, f_idx) 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) @@ -149,13 +184,13 @@ function EVAL(ast, env, new_ast, ret, idx, f, f_idx) return new_ast } idx = substr(new_ast, 2) - f = types_heap[idx][0] - if (f ~ /^&/) { - f_idx = substr(f, 2) + f_idx = substr(f, 2) + switch (f) { + case /^&/: ret = @f_idx(idx) types_release(new_ast) return ret - } else { + default: types_release(new_ast) return "!\"First element of list must be function, supplied " types_typename(f) "." } @@ -271,7 +306,7 @@ function main(str, ret) BEGIN { main() env_check(0) - env_dump() - types_dump() + #env_dump() + #types_dump() exit(0) } diff --git a/awk/step4_if_fn_do.awk b/impls/awk/step4_if_fn_do.awk similarity index 89% rename from awk/step4_if_fn_do.awk rename to impls/awk/step4_if_fn_do.awk index f05112a415..57bd7c07f7 100644 --- a/awk/step4_if_fn_do.awk +++ b/impls/awk/step4_if_fn_do.awk @@ -10,19 +10,20 @@ function READ(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) { - switch (ast) { - case /^'/: - ret = env_get(env, ast) - if (ret !~ /^!/) { - types_addref(ret) - } - return ret - case /^[([]/: idx = substr(ast, 2) len = types_heap[idx]["len"] new_idx = types_allocate() - for (i = 0; i < len; ++i) { + 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 @@ -33,7 +34,10 @@ function eval_ast(ast, env, i, idx, len, new_idx, ret) } types_heap[new_idx]["len"] = len return substr(ast, 1, 1) new_idx - case /^\{/: +} + +function eval_map(ast, env, i, idx, new_idx, ret) +{ idx = substr(ast, 2) new_idx = types_allocate() for (i in types_heap[idx]) { @@ -47,9 +51,6 @@ function eval_ast(ast, env, i, idx, len, new_idx, ret) } } return "{" new_idx - default: - return ast - } } function EVAL_def(ast, env, idx, sym, ret, len) @@ -225,11 +226,39 @@ function EVAL_fn(ast, env, idx, params, params_idx, params_len, i, sym, f_idx function EVAL(ast, env, new_ast, ret, idx, f, f_idx) { env_addref(env) - if (ast !~ /^\(/) { + + 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) { @@ -248,6 +277,12 @@ function EVAL(ast, env, new_ast, ret, idx, f, f_idx) 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) @@ -255,7 +290,6 @@ function EVAL(ast, env, new_ast, ret, idx, f, f_idx) return new_ast } idx = substr(new_ast, 2) - f = types_heap[idx][0] f_idx = substr(f, 2) switch (f) { case /^\$/: @@ -326,7 +360,7 @@ function main(str, ret, i) BEGIN { main() env_check(0) - env_dump() - types_dump() + #env_dump() + #types_dump() exit(0) } diff --git a/awk/step5_tco.awk b/impls/awk/step5_tco.awk similarity index 85% rename from awk/step5_tco.awk rename to impls/awk/step5_tco.awk index 43810458bc..de864fe99a 100644 --- a/awk/step5_tco.awk +++ b/impls/awk/step5_tco.awk @@ -10,19 +10,20 @@ function READ(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) { - switch (ast) { - case /^'/: - ret = env_get(env, ast) - if (ret !~ /^!/) { - types_addref(ret) - } - return ret - case /^[([]/: idx = substr(ast, 2) len = types_heap[idx]["len"] new_idx = types_allocate() - for (i = 0; i < len; ++i) { + 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 @@ -33,7 +34,10 @@ function eval_ast(ast, env, i, idx, len, new_idx, ret) } types_heap[new_idx]["len"] = len return substr(ast, 1, 1) new_idx - case /^\{/: +} + +function eval_map(ast, env, i, idx, new_idx, ret) +{ idx = substr(ast, 2) new_idx = types_allocate() for (i in types_heap[idx]) { @@ -47,9 +51,6 @@ function eval_ast(ast, env, i, idx, len, new_idx, ret) } } return "{" new_idx - default: - return ast - } } function EVAL_def(ast, env, idx, sym, ret, len) @@ -214,15 +215,43 @@ function EVAL_fn(ast, env, idx, params, params_idx, params_len, i, sym, f_idx return "$" f_idx } -function EVAL(ast, env, new_ast, ret, idx, len, f, f_idx, ret_env) +function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret_env) { env_addref(env) for (;;) { - if (ast !~ /^\(/) { + + 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"] @@ -256,6 +285,12 @@ function EVAL(ast, env, new_ast, ret, idx, len, f, f_idx, ret_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) @@ -263,7 +298,6 @@ function EVAL(ast, env, new_ast, ret, idx, len, f, f_idx, ret_env) return new_ast } idx = substr(new_ast, 2) - f = types_heap[idx][0] f_idx = substr(f, 2) switch (f) { case /^\$/: @@ -273,6 +307,7 @@ function EVAL(ast, env, new_ast, ret, idx, len, f, f_idx, ret_env) return env } types_addref(ast = types_heap[f_idx]["body"]) + types_release(f) types_release(new_ast) continue case /^&/: @@ -281,7 +316,9 @@ function EVAL(ast, env, new_ast, ret, idx, len, f, f_idx, ret_env) return ret default: types_release(new_ast) - return "!\"First element of list must be function, supplied " types_typename(f) "." + ret = "!\"First element of list must be function, supplied " types_typename(f) "." + types_release(f) + return ret } } } @@ -333,7 +370,7 @@ function main(str, ret, i) BEGIN { main() env_check(0) - env_dump() - types_dump() + #env_dump() + #types_dump() exit(0) } diff --git a/awk/step6_file.awk b/impls/awk/step6_file.awk similarity index 85% rename from awk/step6_file.awk rename to impls/awk/step6_file.awk index fec4250ff7..2ffa833b6d 100644 --- a/awk/step6_file.awk +++ b/impls/awk/step6_file.awk @@ -10,19 +10,20 @@ function READ(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) { - switch (ast) { - case /^'/: - ret = env_get(env, ast) - if (ret !~ /^!/) { - types_addref(ret) - } - return ret - case /^[([]/: idx = substr(ast, 2) len = types_heap[idx]["len"] new_idx = types_allocate() - for (i = 0; i < len; ++i) { + 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 @@ -33,7 +34,10 @@ function eval_ast(ast, env, i, idx, len, new_idx, ret) } types_heap[new_idx]["len"] = len return substr(ast, 1, 1) new_idx - case /^\{/: +} + +function eval_map(ast, env, i, idx, new_idx, ret) +{ idx = substr(ast, 2) new_idx = types_allocate() for (i in types_heap[idx]) { @@ -47,9 +51,6 @@ function eval_ast(ast, env, i, idx, len, new_idx, ret) } } return "{" new_idx - default: - return ast - } } function EVAL_def(ast, env, idx, sym, ret, len) @@ -214,15 +215,43 @@ function EVAL_fn(ast, env, idx, params, params_idx, params_len, i, sym, f_idx return "$" f_idx } -function EVAL(ast, env, new_ast, ret, idx, len, f, f_idx, ret_env) +function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret_env) { env_addref(env) for (;;) { - if (ast !~ /^\(/) { + + 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"] @@ -256,6 +285,12 @@ function EVAL(ast, env, new_ast, ret, idx, len, f, f_idx, ret_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) @@ -263,7 +298,6 @@ function EVAL(ast, env, new_ast, ret, idx, len, f, f_idx, ret_env) return new_ast } idx = substr(new_ast, 2) - f = types_heap[idx][0] f_idx = substr(f, 2) switch (f) { case /^\$/: @@ -273,6 +307,7 @@ function EVAL(ast, env, new_ast, ret, idx, len, f, f_idx, ret_env) return env } types_addref(ast = types_heap[f_idx]["body"]) + types_release(f) types_release(new_ast) continue case /^&/: @@ -281,7 +316,9 @@ function EVAL(ast, env, new_ast, ret, idx, len, f, f_idx, ret_env) return ret default: types_release(new_ast) - return "!\"First element of list must be function, supplied " types_typename(f) "." + ret = "!\"First element of list must be function, supplied " types_typename(f) "." + types_release(f) + return ret } } } @@ -325,7 +362,7 @@ function main(str, ret, i, idx) 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) \")\")))))") + rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))") idx = types_allocate() env_set(repl_env, "'*ARGV*", "(" idx) @@ -357,7 +394,7 @@ function main(str, ret, i, idx) BEGIN { main() env_check(0) - env_dump() - types_dump() + #env_dump() + #types_dump() exit(0) } diff --git a/awk/step7_quote.awk b/impls/awk/step7_quote.awk similarity index 77% rename from awk/step7_quote.awk rename to impls/awk/step7_quote.awk index f199442af5..ae4e3328d2 100644 --- a/awk/step7_quote.awk +++ b/impls/awk/step7_quote.awk @@ -9,86 +9,100 @@ function READ(str) return reader_read_str(str) } -function is_pair(ast) +# Return 0, an error or the unquote argument (second element of ast). +function starts_with(ast, sym, idx, len) { - return ast ~ /^[([]/ && types_heap[substr(ast, 2)]["len"] != 0 + 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, i, len, new_idx, idx, lst_idx, first, first_idx, verb, ret) +function quasiquote(ast, new_idx, ret, ast_idx, elt_i, elt, previous) { - if (!is_pair(ast)) { + 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 } - idx = substr(ast, 2) - first = types_heap[idx][0] - if (first == "'unquote") { - if (types_heap[idx]["len"] != 2) { - len = types_heap[idx]["len"] - types_release(ast) - return "!\"Invalid argument length for 'unquote'. Expects exactly 1 argument, supplied " (len - 1) "." - } - types_addref(ret = types_heap[idx][1]) + ret = starts_with(ast, "'unquote") + if (ret ~ /^!/) { types_release(ast) return ret } - - first_idx = substr(first, 2) - if (is_pair(first) && types_heap[first_idx][0] == "'splice-unquote") { - if (types_heap[first_idx]["len"] != 2) { - len = types_heap[first_idx]["len"] + 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 "!\"Invalid argument length for 'splice-unquote'. Expects exactly 1 argument, supplied " (len - 1) "." + return ret } - types_addref(first = types_heap[first_idx][1]) - verb = "'concat" - } else { - types_addref(first) - first = quasiquote(first) - if (first ~ /^!/) { - types_release(ast) - return first + 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 } - verb = "'cons" } - lst_idx = types_allocate() - len = types_heap[idx]["len"] - for (i = 1; i < len; ++i) { - types_addref(types_heap[lst_idx][i - 1] = types_heap[idx][i]) + 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_heap[lst_idx]["len"] = len - 1 types_release(ast) - ret = quasiquote("(" lst_idx) - if (ret ~ /^!/) { - types_release(first) - return ret - } - - new_idx = types_allocate() - types_heap[new_idx][0] = verb - types_heap[new_idx][1] = first - types_heap[new_idx][2] = ret - types_heap[new_idx]["len"] = 3 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) { - switch (ast) { - case /^'/: - ret = env_get(env, ast) - if (ret !~ /^!/) { - types_addref(ret) - } - return ret - case /^[([]/: idx = substr(ast, 2) len = types_heap[idx]["len"] new_idx = types_allocate() - for (i = 0; i < len; ++i) { + 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 @@ -99,7 +113,10 @@ function eval_ast(ast, env, i, idx, len, new_idx, ret) } types_heap[new_idx]["len"] = len return substr(ast, 1, 1) new_idx - case /^\{/: +} + +function eval_map(ast, env, i, idx, new_idx, ret) +{ idx = substr(ast, 2) new_idx = types_allocate() for (i in types_heap[idx]) { @@ -113,9 +130,6 @@ function eval_ast(ast, env, i, idx, len, new_idx, ret) } } return "{" new_idx - default: - return ast - } } function EVAL_def(ast, env, idx, sym, ret, len) @@ -280,15 +294,43 @@ function EVAL_fn(ast, env, idx, params, params_idx, params_len, i, sym, f_idx return "$" f_idx } -function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_env) +function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret_env) { env_addref(env) for (;;) { - if (ast !~ /^\(/) { + + 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"] @@ -346,6 +388,12 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_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) @@ -353,7 +401,6 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_env) return new_ast } idx = substr(new_ast, 2) - f = types_heap[idx][0] f_idx = substr(f, 2) switch (f) { case /^\$/: @@ -363,6 +410,7 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_env) return env } types_addref(ast = types_heap[f_idx]["body"]) + types_release(f) types_release(new_ast) continue case /^&/: @@ -371,7 +419,9 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_env) return ret default: types_release(new_ast) - return "!\"First element of list must be function, supplied " types_typename(f) "." + ret = "!\"First element of list must be function, supplied " types_typename(f) "." + types_release(f) + return ret } } } @@ -415,7 +465,7 @@ function main(str, ret, i, idx) 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) \")\")))))") + rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))") idx = types_allocate() env_set(repl_env, "'*ARGV*", "(" idx) @@ -447,7 +497,7 @@ function main(str, ret, i, idx) BEGIN { main() env_check(0) - env_dump() - types_dump() + #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/awk/step9_try.awk b/impls/awk/step9_try.awk similarity index 75% rename from awk/step9_try.awk rename to impls/awk/step9_try.awk index 23fee5221f..72c6b5c42e 100644 --- a/awk/step9_try.awk +++ b/impls/awk/step9_try.awk @@ -9,119 +9,100 @@ function READ(str) return reader_read_str(str) } -function is_pair(ast) +# Return 0, an error or the unquote argument (second element of ast). +function starts_with(ast, sym, idx, len) { - return ast ~ /^[([]/ && types_heap[substr(ast, 2)]["len"] != 0 + 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, i, len, new_idx, idx, lst_idx, first, first_idx, verb, ret) +function quasiquote(ast, new_idx, ret, ast_idx, elt_i, elt, previous) { - if (!is_pair(ast)) { + 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 } - idx = substr(ast, 2) - first = types_heap[idx][0] - if (first == "'unquote") { - if (types_heap[idx]["len"] != 2) { - len = types_heap[idx]["len"] - types_release(ast) - return "!\"Invalid argument length for 'unquote'. Expects exactly 1 argument, supplied " (len - 1) "." - } - types_addref(ret = types_heap[idx][1]) + ret = starts_with(ast, "'unquote") + if (ret ~ /^!/) { types_release(ast) return ret } - - first_idx = substr(first, 2) - if (is_pair(first) && types_heap[first_idx][0] == "'splice-unquote") { - if (types_heap[first_idx]["len"] != 2) { - len = types_heap[first_idx]["len"] + 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 "!\"Invalid argument length for 'splice-unquote'. Expects exactly 1 argument, supplied " (len - 1) "." + return ret } - types_addref(first = types_heap[first_idx][1]) - verb = "'concat" - } else { - types_addref(first) - first = quasiquote(first) - if (first ~ /^!/) { - types_release(ast) - return first + 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 } - verb = "'cons" } - lst_idx = types_allocate() - len = types_heap[idx]["len"] - for (i = 1; i < len; ++i) { - types_addref(types_heap[lst_idx][i - 1] = types_heap[idx][i]) + 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_heap[lst_idx]["len"] = len - 1 types_release(ast) - ret = quasiquote("(" lst_idx) - if (ret ~ /^!/) { - types_release(first) - return ret - } - - new_idx = types_allocate() - types_heap[new_idx][0] = verb - types_heap[new_idx][1] = first - types_heap[new_idx][2] = ret - types_heap[new_idx]["len"] = 3 return "(" new_idx } -function is_macro_call(ast, env, sym, ret, f) -{ - if (!is_pair(ast)) { - return 0 - } - sym = types_heap[substr(ast, 2)][0] - if (sym !~ /^'/) { - return 0 - } - f = env_get(env, sym) - return f ~ /^\$/ && types_heap[substr(f, 2)]["is_macro"] -} - -function macroexpand(ast, env, idx, f_idx, new_env) -{ - while (is_macro_call(ast, env)) { - idx = substr(ast, 2) - f_idx = substr(env_get(env, types_heap[idx][0]), 2) - new_env = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], idx) - types_release(ast) - if (new_env ~ /^!/) { - return new_env - } - types_addref(ast = types_heap[f_idx]["body"]) - ast = EVAL(ast, new_env) - env_release(new_env) - if (ast ~ /^!/) { - return ast - } - } - return ast -} - 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) { - switch (ast) { - case /^'/: - ret = env_get(env, ast) - if (ret !~ /^!/) { - types_addref(ret) - } - return ret - case /^[([]/: idx = substr(ast, 2) len = types_heap[idx]["len"] new_idx = types_allocate() - for (i = 0; i < len; ++i) { + 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 @@ -132,7 +113,10 @@ function eval_ast(ast, env, i, idx, len, new_idx, ret) } types_heap[new_idx]["len"] = len return substr(ast, 1, 1) new_idx - case /^\{/: +} + +function eval_map(ast, env, i, idx, new_idx, ret) +{ idx = substr(ast, 2) new_idx = types_allocate() for (i in types_heap[idx]) { @@ -146,9 +130,6 @@ function eval_ast(ast, env, i, idx, len, new_idx, ret) } } return "{" new_idx - default: - return ast - } } function EVAL_def(ast, env, idx, sym, ret, len) @@ -221,7 +202,7 @@ function EVAL_let(ast, env, ret_env, idx, params, params_idx, params_len, return body } -function EVAL_defmacro(ast, env, idx, sym, ret, len) +function EVAL_defmacro(ast, env, idx, sym, ret, len, fun_idx, mac_idx) { idx = substr(ast, 2) if (types_heap[idx]["len"] != 3) { @@ -247,7 +228,17 @@ function EVAL_defmacro(ast, env, idx, sym, ret, len) env_release(env) return "!\"Incompatible type for argument 2 of 'defmacro!'. Expects function, supplied " types_typename(ret) "." } - types_heap[substr(ret, 2)]["is_macro"] = 1 + + # 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) @@ -257,11 +248,17 @@ function EVAL_defmacro(ast, env, idx, sym, ret, len) function EVAL_try(ast, env, catch_body, catch_env, idx, catch, catch_idx, catch_sym, ret, len, str) { idx = substr(ast, 2) - if (types_heap[idx]["len"] != 3) { - len = types_heap[idx]["len"] + len = types_heap[idx]["len"] + if (len != 2 && len != 3) { types_release(ast) env_release(env) - return "!\"Invalid argument length for 'try*'. Expects exactly 2 arguments, supplied" (len - 1) "." + 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 !~ /^\(/) { @@ -398,29 +395,46 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret { env_addref(env) for (;;) { - if (ast !~ /^\(/) { - ret = eval_ast(ast, 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 - } - if (types_heap[substr(ast, 2)]["len"] == 0) { - env_release(env) - return ast - } - ast = macroexpand(ast, env) - if (ast ~ /^!/) { - env_release(env) - return ast - } - if (ast !~ /^\(/) { + 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) @@ -457,17 +471,6 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret continue case "'defmacro!": return EVAL_defmacro(ast, env) - case "'macroexpand": - if (len != 2) { - types_release(ast) - env_release(env) - return "!\"Invalid argument length for 'macroexpand'. Expects exactly 1 argument, supplied " (len - 1) "." - } - types_addref(body = types_heap[idx][1]) - types_release(ast) - ret = macroexpand(body, env) - env_release(env) - return ret case "'try*": ret = EVAL_try(ast, env, ret_body, ret_env) if (ret != "") { @@ -492,32 +495,61 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret case "'fn*": return EVAL_fn(ast, env) default: - new_ast = eval_ast(ast, env) - types_release(ast) - env_release(env) - if (new_ast ~ /^!/) { - return new_ast + f = EVAL(types_addref(types_heap[idx][0]), env) + if (f ~ /^!/) { + types_release(ast) + env_release(env) + return f } - idx = substr(new_ast, 2) - f = types_heap[idx][0] 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) - return "!\"First element of list must be function, supplied " types_typename(f) "." + ret = "!\"First element of list must be function, supplied " types_typename(f) "." + types_release(f) + return ret } } } @@ -561,9 +593,8 @@ function main(str, ret, i, idx) 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) \")\")))))") + 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))))))))") idx = types_allocate() env_set(repl_env, "'*ARGV*", "(" idx) @@ -595,7 +626,7 @@ function main(str, ret, i, idx) BEGIN { main() env_check(0) - env_dump() - types_dump() + #env_dump() + #types_dump() exit(0) } diff --git a/awk/stepA_mal.awk b/impls/awk/stepA_mal.awk similarity index 75% rename from awk/stepA_mal.awk rename to impls/awk/stepA_mal.awk index 06cebcef27..de455ddaf4 100644 --- a/awk/stepA_mal.awk +++ b/impls/awk/stepA_mal.awk @@ -9,119 +9,100 @@ function READ(str) return reader_read_str(str) } -function is_pair(ast) +# Return 0, an error or the unquote argument (second element of ast). +function starts_with(ast, sym, idx, len) { - return ast ~ /^[([]/ && types_heap[substr(ast, 2)]["len"] != 0 + 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, i, len, new_idx, idx, lst_idx, first, first_idx, verb, ret) +function quasiquote(ast, new_idx, ret, ast_idx, elt_i, elt, previous) { - if (!is_pair(ast)) { + 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 } - idx = substr(ast, 2) - first = types_heap[idx][0] - if (first == "'unquote") { - if (types_heap[idx]["len"] != 2) { - len = types_heap[idx]["len"] - types_release(ast) - return "!\"Invalid argument length for 'unquote'. Expects exactly 1 argument, supplied " (len - 1) "." - } - types_addref(ret = types_heap[idx][1]) + ret = starts_with(ast, "'unquote") + if (ret ~ /^!/) { types_release(ast) return ret } - - first_idx = substr(first, 2) - if (is_pair(first) && types_heap[first_idx][0] == "'splice-unquote") { - if (types_heap[first_idx]["len"] != 2) { - len = types_heap[first_idx]["len"] + 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 "!\"Invalid argument length for 'splice-unquote'. Expects exactly 1 argument, supplied " (len - 1) "." + return ret } - types_addref(first = types_heap[first_idx][1]) - verb = "'concat" - } else { - types_addref(first) - first = quasiquote(first) - if (first ~ /^!/) { - types_release(ast) - return first + 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 } - verb = "'cons" } - lst_idx = types_allocate() - len = types_heap[idx]["len"] - for (i = 1; i < len; ++i) { - types_addref(types_heap[lst_idx][i - 1] = types_heap[idx][i]) + 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_heap[lst_idx]["len"] = len - 1 types_release(ast) - ret = quasiquote("(" lst_idx) - if (ret ~ /^!/) { - types_release(first) - return ret - } - - new_idx = types_allocate() - types_heap[new_idx][0] = verb - types_heap[new_idx][1] = first - types_heap[new_idx][2] = ret - types_heap[new_idx]["len"] = 3 return "(" new_idx } -function is_macro_call(ast, env, sym, ret, f) -{ - if (!is_pair(ast)) { - return 0 - } - sym = types_heap[substr(ast, 2)][0] - if (sym !~ /^'/) { - return 0 - } - f = env_get(env, sym) - return f ~ /^\$/ && types_heap[substr(f, 2)]["is_macro"] -} - -function macroexpand(ast, env, idx, f_idx, new_env) -{ - while (is_macro_call(ast, env)) { - idx = substr(ast, 2) - f_idx = substr(env_get(env, types_heap[idx][0]), 2) - new_env = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], idx) - types_release(ast) - if (new_env ~ /^!/) { - return new_env - } - types_addref(ast = types_heap[f_idx]["body"]) - ast = EVAL(ast, new_env) - env_release(new_env) - if (ast ~ /^!/) { - return ast - } - } - return ast -} - 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) { - switch (ast) { - case /^'/: - ret = env_get(env, ast) - if (ret !~ /^!/) { - types_addref(ret) - } - return ret - case /^[([]/: idx = substr(ast, 2) len = types_heap[idx]["len"] new_idx = types_allocate() - for (i = 0; i < len; ++i) { + 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 @@ -132,7 +113,10 @@ function eval_ast(ast, env, i, idx, len, new_idx, ret) } types_heap[new_idx]["len"] = len return substr(ast, 1, 1) new_idx - case /^\{/: +} + +function eval_map(ast, env, i, idx, new_idx, ret) +{ idx = substr(ast, 2) new_idx = types_allocate() for (i in types_heap[idx]) { @@ -146,9 +130,6 @@ function eval_ast(ast, env, i, idx, len, new_idx, ret) } } return "{" new_idx - default: - return ast - } } function EVAL_def(ast, env, idx, sym, ret, len) @@ -221,7 +202,7 @@ function EVAL_let(ast, env, ret_env, idx, params, params_idx, params_len, return body } -function EVAL_defmacro(ast, env, idx, sym, ret, len) +function EVAL_defmacro(ast, env, idx, sym, ret, len, fun_idx, mac_idx) { idx = substr(ast, 2) if (types_heap[idx]["len"] != 3) { @@ -247,7 +228,17 @@ function EVAL_defmacro(ast, env, idx, sym, ret, len) env_release(env) return "!\"Incompatible type for argument 2 of 'defmacro!'. Expects function, supplied " types_typename(ret) "." } - types_heap[substr(ret, 2)]["is_macro"] = 1 + + # 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) @@ -257,11 +248,17 @@ function EVAL_defmacro(ast, env, idx, sym, ret, len) function EVAL_try(ast, env, catch_body, catch_env, idx, catch, catch_idx, catch_sym, ret, len, str) { idx = substr(ast, 2) - if (types_heap[idx]["len"] != 3) { - len = types_heap[idx]["len"] + len = types_heap[idx]["len"] + if (len != 2 && len != 3) { types_release(ast) env_release(env) - return "!\"Invalid argument length for 'try*'. Expects exactly 2 arguments, supplied" (len - 1) "." + 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 !~ /^\(/) { @@ -398,29 +395,46 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret { env_addref(env) for (;;) { - if (ast !~ /^\(/) { - ret = eval_ast(ast, 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 - } - if (types_heap[substr(ast, 2)]["len"] == 0) { - env_release(env) - return ast - } - ast = macroexpand(ast, env) - if (ast ~ /^!/) { - env_release(env) - return ast - } - if (ast !~ /^\(/) { + 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) @@ -457,17 +471,6 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret continue case "'defmacro!": return EVAL_defmacro(ast, env) - case "'macroexpand": - if (len != 2) { - types_release(ast) - env_release(env) - return "!\"Invalid argument length for 'macroexpand'. Expects exactly 1 argument, supplied " (len - 1) "." - } - types_addref(body = types_heap[idx][1]) - types_release(ast) - ret = macroexpand(body, env) - env_release(env) - return ret case "'try*": ret = EVAL_try(ast, env, ret_body, ret_env) if (ret != "") { @@ -492,34 +495,64 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret case "'fn*": return EVAL_fn(ast, env) default: - new_ast = eval_ast(ast, env) - types_release(ast) - env_release(env) - if (new_ast ~ /^!/) { - return new_ast + f = EVAL(types_addref(types_heap[idx][0]), env) + if (f ~ /^!/) { + types_release(ast) + env_release(env) + return f } - idx = substr(new_ast, 2) - f = types_heap[idx][0] 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) - return "!\"First element of list must be function, supplied " types_typename(f) "." + ret = "!\"First element of list must be function, supplied " types_typename(f) "." + types_release(f) + return ret } } } @@ -564,11 +597,8 @@ function main(str, ret, i, idx) 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) \")\")))))") + 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! *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)))))))))") idx = types_allocate() env_set(repl_env, "'*ARGV*", "(" idx) @@ -601,7 +631,7 @@ function main(str, ret, i, idx) BEGIN { main() env_check(0) - env_dump() - types_dump() + #env_dump() + #types_dump() exit(0) } diff --git a/awk/tests/step5_tco.mal b/impls/awk/tests/step5_tco.mal similarity index 100% rename from awk/tests/step5_tco.mal rename to impls/awk/tests/step5_tco.mal diff --git a/awk/types.awk b/impls/awk/types.awk similarity index 100% rename from awk/types.awk rename to impls/awk/types.awk 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 94% rename from bash/core.sh rename to impls/bash/core.sh index 0a4d07c97a..28119cc7ab 100644 --- a/bash/core.sh +++ b/impls/bash/core.sh @@ -74,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="" @@ -92,14 +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 echo "${res:1}" - r="${__nil}"; + r="${__nil}"; } readline () { @@ -119,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 @@ -364,6 +365,9 @@ declare -A core_ns=( [symbol?]=symbol? [keyword]=keyword [keyword?]=keyword? + [number?]=number? + [fn?]=function? + [macro?]=macro? [pr-str]=pr_str [str]=str @@ -372,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 @@ -398,6 +402,7 @@ declare -A core_ns=( [sequential?]=sequential? [cons]=cons [concat]=concat + [vec]=vec [nth]=nth [first]=_first [rest]=_rest 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 100% rename from bash/printer.sh rename to impls/bash/printer.sh diff --git a/bash/reader.sh b/impls/bash/reader.sh similarity index 86% rename from bash/reader.sh rename to impls/bash/reader.sh index 688fc8b442..6e1ed362c0 100644 --- a/bash/reader.sh +++ b/impls/bash/reader.sh @@ -13,10 +13,15 @@ READ_ATOM () { case "${token}" in [0-9]*) _number "${token}" ;; -[0-9]*) _number "${token}" ;; - \"*) token="${token:1:-1}" + \"*) if [[ ! "${token}" =~ ^\"(\\.|[^\\\"])*\"$ ]]; then + _error "expected '\"', got EOF" + return + fi + token="${token:1:-1}" + token="${token//\\\\/${__keyw}}" token="${token//\\\"/\"}" token="${token//\\n/$'\n'}" - token="${token//\\\\/\\}" + token="${token//${__keyw}/\\}" _string "${token}" ;; :*) _keyword "${token:1}" ;; nil) r="${__nil}" ;; @@ -45,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 @@ -98,6 +103,8 @@ READ_FORM () { esac } +TOKEN_PAT=$'^^([][{}\\(\\)^@])|^(~@)|^("(\\\\.|[^\\"])*"?)|^(;[^\n]*)|^([~\'`])|^([^][ ~`\'";{}\\(\\)^@,\n]+)|^(,)|^([[:space:]]+)' + # Returns __reader_tokens as an indexed array of tokens TOKENIZE () { local data="${*}" @@ -105,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 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 100% rename from bash/step0_repl.sh rename to impls/bash/step0_repl.sh 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 77% rename from bash/step2_eval.sh rename to impls/bash/step2_eval.sh index de8054fb11..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,11 +18,13 @@ 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="" key= val="" hm="${ANON["${ast}"]}" _hash_map; local new_hm="${r}" @@ -32,26 +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 _empty? "${ast}" && r="${ast}" && return - # apply list - EVAL_AST "${ast}" "${env}" + _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 82% rename from bash/step3_env.sh rename to impls/bash/step3_env.sh index 850ec0354b..ba46e54306 100755 --- a/bash/step3_env.sh +++ b/impls/bash/step3_env.sh @@ -11,18 +11,28 @@ 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="" key= val="" hm="${ANON["${ast}"]}" _hash_map; local new_hm="${r}" @@ -32,25 +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 - # apply list _nth "${ast}" 0; local a0="${r}" _nth "${ast}" 1; local a1="${r}" _nth "${ast}" 2; local a2="${r}" @@ -59,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}" @@ -70,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 83% rename from bash/step4_if_fn_do.sh rename to impls/bash/step4_if_fn_do.sh index 16e745f75a..24b45965fd 100755 --- a/bash/step4_if_fn_do.sh +++ b/impls/bash/step4_if_fn_do.sh @@ -12,18 +12,28 @@ 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="" key= val="" hm="${ANON["${ast}"]}" _hash_map; local new_hm="${r}" @@ -33,25 +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 - # apply list _nth "${ast}" 0; local a0="${r}" _nth "${ast}" 1; local a1="${r}" _nth "${ast}" 2; local a2="${r}" @@ -60,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}" @@ -72,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 ;; @@ -91,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 85% rename from bash/step5_tco.sh rename to impls/bash/step5_tco.sh index fa5c7b8b68..5e30751000 100755 --- a/bash/step5_tco.sh +++ b/impls/bash/step5_tco.sh @@ -12,18 +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}'" + 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="" key= val="" hm="${ANON["${ast}"]}" _hash_map; local new_hm="${r}" @@ -33,26 +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 - # apply list _nth "${ast}" 0; local a0="${r}" _nth "${ast}" 1; local a1="${r}" _nth "${ast}" 2; local a2="${r}" @@ -61,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}" @@ -76,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}" @@ -99,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 85% rename from bash/step6_file.sh rename to impls/bash/step6_file.sh index 1fe855b326..b87cbc1986 100755 --- a/bash/step6_file.sh +++ b/impls/bash/step6_file.sh @@ -12,18 +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}'" + 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="" key= val="" hm="${ANON["${ast}"]}" _hash_map; local new_hm="${r}" @@ -33,26 +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 - # apply list _nth "${ast}" 0; local a0="${r}" _nth "${ast}" 1; local a1="${r}" _nth "${ast}" 2; local a2="${r}" @@ -61,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}" @@ -76,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}" @@ -99,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}"]}" @@ -160,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 98% rename from bash/types.sh rename to impls/bash/types.sh index f171b17c8c..556cca0436 100644 --- a/bash/types.sh +++ b/impls/bash/types.sh @@ -209,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/c/Dockerfile b/impls/c/Dockerfile similarity index 100% rename from c/Dockerfile rename to impls/c/Dockerfile 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 100% rename from c/interop.c rename to impls/c/interop.c 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/c/printer.c b/impls/c/printer.c similarity index 100% rename from c/printer.c rename to impls/c/printer.c 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/c/readline.c b/impls/c/readline.c similarity index 100% rename from c/readline.c rename to impls/c/readline.c 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/c/tests/step5_tco.mal b/impls/c/tests/step5_tco.mal similarity index 100% rename from c/tests/step5_tco.mal rename to impls/c/tests/step5_tco.mal 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/c/types.c b/impls/c/types.c similarity index 100% rename from c/types.c rename to impls/c/types.c 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 98% rename from clojure/src/readline.clj rename to impls/clojure/src/mal/readline.clj index 7c12ac1532..c5a4cab8ae 100644 --- a/clojure/src/readline.clj +++ b/impls/clojure/src/mal/readline.clj @@ -1,4 +1,4 @@ -(ns readline +(ns mal.readline (:require [clojure.string :refer [split]] [clojure.java.io :refer [file]] [net.n01se.clojure-jna :as jna])) 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/clojure/tests/step5_tco.mal b/impls/clojure/tests/step5_tco.mal similarity index 100% rename from clojure/tests/step5_tco.mal rename to impls/clojure/tests/step5_tco.mal 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 92% rename from coffee/core.coffee rename to impls/coffee/core.coffee index bbe8c38c17..37b379c097 100644 --- a/coffee/core.coffee +++ b/impls/coffee/core.coffee @@ -1,4 +1,4 @@ -readline = require "./node_readline" +readline = require "./node_readline.coffee" types = require "./types.coffee" reader = require "./reader.coffee" printer = require "./printer.coffee" @@ -38,7 +38,7 @@ 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, @@ -47,6 +47,9 @@ exports.ns = { '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(""), @@ -81,6 +84,7 @@ 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 != null and a.length > 0 then a[0] else 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 1c9ab3e6d0..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,11 +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, "\\") + .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/coffee/step1_read_print.coffee b/impls/coffee/step1_read_print.coffee similarity index 86% rename from coffee/step1_read_print.coffee rename to impls/coffee/step1_read_print.coffee index d5ab6b7a1b..df5cf74855 100644 --- a/coffee/step1_read_print.coffee +++ b/impls/coffee/step1_read_print.coffee @@ -23,7 +23,7 @@ while (line = readline.readline("user> ")) != null 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 console.log exc + 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/coffee/step6_file.coffee b/impls/coffee/step6_file.coffee similarity index 76% rename from coffee/step6_file.coffee rename to impls/coffee/step6_file.coffee index ed6481f7f7..87226b6268 100644 --- a/coffee/step6_file.coffee +++ b/impls/coffee/step6_file.coffee @@ -9,21 +9,24 @@ core = require("./core.coffee") 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)) +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) - types._vector(ast.map((a) -> EVAL(a, env))...) + return 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 + new_hm[k] = EVAL(v, env) for k,v of ast + return new_hm + else return ast -EVAL = (ast, env) -> - loop - #console.log "EVAL:", printer._pr_str ast - if !types._list_Q ast then return eval_ast ast, env if ast.length == 0 then return ast # apply list @@ -38,7 +41,7 @@ EVAL = (ast, env) -> ast = a2 env = let_env when "do" - eval_ast(ast[1..-2], env) + ast[1..-2].map((a) -> EVAL(a, env)) ast = ast[ast.length-1] when "if" cond = EVAL(a1, env) @@ -49,7 +52,7 @@ EVAL = (ast, env) -> when "fn*" return types._function(EVAL, a2, env, a1) else - [f, args...] = eval_ast ast, env + [f, args...] = ast.map((a) -> EVAL(a, env)) if types._function_Q(f) ast = f.__ast__ env = f.__gen_env__(args) @@ -71,7 +74,7 @@ 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("(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..] @@ -87,7 +90,7 @@ while (line = readline.readline("user> ")) != null 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 console.log exc + 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/coffee/tests/step5_tco.mal b/impls/coffee/tests/step5_tco.mal similarity index 100% rename from coffee/tests/step5_tco.mal rename to impls/coffee/tests/step5_tco.mal 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 98% rename from coffee/types.coffee rename to impls/coffee/types.coffee index 0f5666c7c0..5252281762 100644 --- a/coffee/types.coffee +++ b/impls/coffee/types.coffee @@ -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/cpp/.gitignore b/impls/cpp/.gitignore similarity index 100% rename from cpp/.gitignore rename to impls/cpp/.gitignore diff --git a/cpp/Core.cpp b/impls/cpp/Core.cpp similarity index 84% rename from cpp/Core.cpp rename to impls/cpp/Core.cpp index 0e02cf8096..9e91edcec1 100644 --- a/cpp/Core.cpp +++ b/impls/cpp/Core.cpp @@ -64,6 +64,7 @@ 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); @@ -99,6 +100,33 @@ BUILTIN("<=") 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); @@ -241,6 +269,19 @@ BUILTIN("first") 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); @@ -266,8 +307,42 @@ BUILTIN("keys") BUILTIN("keyword") { CHECK_ARGS_IS(1); - ARG(malString, token); - return mal::keyword(":" + token->value()); + 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") @@ -438,6 +513,13 @@ BUILTIN("vals") 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); diff --git a/cpp/Debug.h b/impls/cpp/Debug.h similarity index 100% rename from cpp/Debug.h rename to impls/cpp/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/cpp/Environment.cpp b/impls/cpp/Environment.cpp similarity index 100% rename from cpp/Environment.cpp rename to impls/cpp/Environment.cpp diff --git a/cpp/Environment.h b/impls/cpp/Environment.h similarity index 100% rename from cpp/Environment.h rename to impls/cpp/Environment.h diff --git a/cpp/MAL.h b/impls/cpp/MAL.h similarity index 100% rename from cpp/MAL.h rename to impls/cpp/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/cpp/ReadLine.cpp b/impls/cpp/ReadLine.cpp similarity index 97% rename from cpp/ReadLine.cpp rename to impls/cpp/ReadLine.cpp index ffcff6fee5..f4b76609b2 100644 --- a/cpp/ReadLine.cpp +++ b/impls/cpp/ReadLine.cpp @@ -29,6 +29,7 @@ bool ReadLine::get(const String& prompt, String& out) append_history(1, m_historyPath.c_str()); out = line; + free(line); return true; } diff --git a/cpp/ReadLine.h b/impls/cpp/ReadLine.h similarity index 100% rename from cpp/ReadLine.h rename to impls/cpp/ReadLine.h diff --git a/cpp/Reader.cpp b/impls/cpp/Reader.cpp similarity index 94% rename from cpp/Reader.cpp rename to impls/cpp/Reader.cpp index cdb4e91078..dbcb6c9c83 100644 --- a/cpp/Reader.cpp +++ b/impls/cpp/Reader.cpp @@ -98,10 +98,10 @@ void Tokeniser::nextToken() String mismatch(m_iter, m_end); if (mismatch[0] == '"') { - MAL_CHECK(false, "Expected \", got EOF"); + MAL_CHECK(false, "expected '\"', got EOF"); } else { - MAL_CHECK(false, "Unexpected \"%s\"", mismatch.c_str()); + MAL_CHECK(false, "unexpected '%s'", mismatch.c_str()); } } @@ -129,11 +129,11 @@ malValuePtr readStr(const String& input) static malValuePtr readForm(Tokeniser& tokeniser) { - MAL_CHECK(!tokeniser.eof(), "Expected form, got EOF"); + MAL_CHECK(!tokeniser.eof(), "expected form, got EOF"); String token = tokeniser.peek(); MAL_CHECK(!std::regex_match(token, closeRegex), - "Unexpected \"%s\"", token.c_str()); + "unexpected '%s'", token.c_str()); if (token == "(") { tokeniser.next(); @@ -213,7 +213,7 @@ static void readList(Tokeniser& tokeniser, malValueVec* items, const String& end) { while (1) { - MAL_CHECK(!tokeniser.eof(), "Expected \"%s\", got EOF", end.c_str()); + MAL_CHECK(!tokeniser.eof(), "expected '%s', got EOF", end.c_str()); if (tokeniser.peek() == end) { tokeniser.next(); return; diff --git a/cpp/RefCountedPtr.h b/impls/cpp/RefCountedPtr.h similarity index 100% rename from cpp/RefCountedPtr.h rename to impls/cpp/RefCountedPtr.h diff --git a/cpp/StaticList.h b/impls/cpp/StaticList.h similarity index 100% rename from cpp/StaticList.h rename to impls/cpp/StaticList.h diff --git a/cpp/String.cpp b/impls/cpp/String.cpp similarity index 100% rename from cpp/String.cpp rename to impls/cpp/String.cpp diff --git a/cpp/String.h b/impls/cpp/String.h similarity index 100% rename from cpp/String.h rename to impls/cpp/String.h diff --git a/cpp/Types.cpp b/impls/cpp/Types.cpp similarity index 100% rename from cpp/Types.cpp rename to impls/cpp/Types.cpp diff --git a/cpp/Types.h b/impls/cpp/Types.h similarity index 100% rename from cpp/Types.h rename to impls/cpp/Types.h diff --git a/cpp/Validation.cpp b/impls/cpp/Validation.cpp similarity index 100% rename from cpp/Validation.cpp rename to impls/cpp/Validation.cpp diff --git a/cpp/Validation.h b/impls/cpp/Validation.h similarity index 100% rename from cpp/Validation.h rename to impls/cpp/Validation.h diff --git a/cpp/docker.sh b/impls/cpp/docker.sh similarity index 95% rename from cpp/docker.sh rename to impls/cpp/docker.sh index 4fb261dcf6..2714989f4a 100755 --- a/cpp/docker.sh +++ b/impls/cpp/docker.sh @@ -1,4 +1,4 @@ -#!/bin/bash +#!/usr/bin/env bash IMAGE_NAME=mal-cpp CONTAINER_NAME=mal-cpp-running 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/cpp/step0_repl.cpp b/impls/cpp/step0_repl.cpp similarity index 100% rename from cpp/step0_repl.cpp rename to impls/cpp/step0_repl.cpp diff --git a/cpp/step1_read_print.cpp b/impls/cpp/step1_read_print.cpp similarity index 100% rename from cpp/step1_read_print.cpp rename to impls/cpp/step1_read_print.cpp diff --git a/cpp/step2_eval.cpp b/impls/cpp/step2_eval.cpp similarity index 98% rename from cpp/step2_eval.cpp rename to impls/cpp/step2_eval.cpp index dcd9461174..9b64f5ea5c 100644 --- a/cpp/step2_eval.cpp +++ b/impls/cpp/step2_eval.cpp @@ -51,6 +51,8 @@ malValuePtr READ(const String& input) malValuePtr EVAL(malValuePtr ast, malEnvPtr env) { + // std::cout << "EVAL: " << PRINT(ast) << "\n"; + return ast->eval(env); } diff --git a/cpp/step3_env.cpp b/impls/cpp/step3_env.cpp similarity index 94% rename from cpp/step3_env.cpp rename to impls/cpp/step3_env.cpp index 26b2bc4b85..fe76214a71 100644 --- a/cpp/step3_env.cpp +++ b/impls/cpp/step3_env.cpp @@ -50,6 +50,12 @@ 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); diff --git a/cpp/step4_if_fn_do.cpp b/impls/cpp/step4_if_fn_do.cpp similarity index 96% rename from cpp/step4_if_fn_do.cpp rename to impls/cpp/step4_if_fn_do.cpp index df6f1dbc4e..cef3c4ed99 100644 --- a/cpp/step4_if_fn_do.cpp +++ b/impls/cpp/step4_if_fn_do.cpp @@ -52,6 +52,12 @@ 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); @@ -145,11 +151,7 @@ malValuePtr APPLY(malValuePtr op, malValueIter argsBegin, malValueIter argsEnd) } static const char* malFunctionTable[] = { - "(def! list (fn* (& items) items))", "(def! not (fn* (cond) (if cond false true)))", - "(def! >= (fn* (a b) (<= b a)))", - "(def! < (fn* (a b) (not (<= b a))))", - "(def! > (fn* (a b) (not (<= a b))))", }; static void installFunctions(malEnvPtr env) { diff --git a/cpp/step5_tco.cpp b/impls/cpp/step5_tco.cpp similarity index 96% rename from cpp/step5_tco.cpp rename to impls/cpp/step5_tco.cpp index 9cd66ca059..0766d53f02 100644 --- a/cpp/step5_tco.cpp +++ b/impls/cpp/step5_tco.cpp @@ -53,6 +53,12 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr 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); @@ -152,11 +158,7 @@ malValuePtr APPLY(malValuePtr op, malValueIter argsBegin, malValueIter argsEnd) } static const char* malFunctionTable[] = { - "(def! list (fn* (& items) items))", "(def! not (fn* (cond) (if cond false true)))", - "(def! >= (fn* (a b) (<= b a)))", - "(def! < (fn* (a b) (not (<= b a))))", - "(def! > (fn* (a b) (not (<= a b))))", }; static void installFunctions(malEnvPtr env) { diff --git a/cpp/step6_file.cpp b/impls/cpp/step6_file.cpp similarity index 95% rename from cpp/step6_file.cpp rename to impls/cpp/step6_file.cpp index d9364868b1..e0c15e6109 100644 --- a/cpp/step6_file.cpp +++ b/impls/cpp/step6_file.cpp @@ -76,6 +76,12 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr 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); @@ -175,13 +181,9 @@ malValuePtr APPLY(malValuePtr op, malValueIter argsBegin, malValueIter argsEnd) } static const char* malFunctionTable[] = { - "(def! list (fn* (& items) items))", "(def! not (fn* (cond) (if cond false true)))", - "(def! >= (fn* (a b) (<= b a)))", - "(def! < (fn* (a b) (not (<= b a))))", - "(def! > (fn* (a b) (not (<= a b))))", "(def! load-file (fn* (filename) \ - (eval (read-string (str \"(do \" (slurp filename) \")\")))))", + (eval (read-string (str \"(do \" (slurp filename) \"\nnil)\")))))", }; static void installFunctions(malEnvPtr env) { diff --git a/cpp/step7_quote.cpp b/impls/cpp/step7_quote.cpp similarity index 82% rename from cpp/step7_quote.cpp rename to impls/cpp/step7_quote.cpp index 005c920a2d..1ced69952a 100644 --- a/cpp/step7_quote.cpp +++ b/impls/cpp/step7_quote.cpp @@ -77,6 +77,12 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr 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); @@ -192,54 +198,47 @@ static bool isSymbol(malValuePtr obj, const String& text) return sym && (sym->value() == text); } -static const malSequence* isPair(malValuePtr obj) +// Return arg when ast matches ('sym, arg), else NULL. +static malValuePtr starts_with(const malValuePtr ast, const char* sym) { - const malSequence* list = DYNAMIC_CAST(malSequence, obj); - return list && !list->isEmpty() ? list : NULL; + 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) { - const malSequence* seq = isPair(obj); - if (!seq) { + if (DYNAMIC_CAST(malSymbol, obj) || DYNAMIC_CAST(malHash, obj)) return mal::list(mal::symbol("quote"), obj); - } - if (isSymbol(seq->item(0), "unquote")) { - // (qq (uq form)) -> form - checkArgsIs("unquote", 1, seq->count() - 1); - return seq->item(1); - } - - const malSequence* innerSeq = isPair(seq->item(0)); - if (innerSeq && isSymbol(innerSeq->item(0), "splice-unquote")) { - checkArgsIs("splice-unquote", 1, innerSeq->count() - 1); - // (qq (sq '(a b c))) -> a b c - return mal::list( - mal::symbol("concat"), - innerSeq->item(1), - quasiquote(seq->rest()) - ); - } - else { - // (qq (a b c)) -> (list (qq a) (qq b) (qq c)) - // (qq xs ) -> (cons (qq (car xs)) (qq (cdr xs))) - return mal::list( - mal::symbol("cons"), - quasiquote(seq->first()), - quasiquote(seq->rest()) - ); + 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! list (fn* (& items) items))", "(def! not (fn* (cond) (if cond false true)))", - "(def! >= (fn* (a b) (<= b a)))", - "(def! < (fn* (a b) (not (<= b a))))", - "(def! > (fn* (a b) (not (<= a b))))", "(def! load-file (fn* (filename) \ - (eval (read-string (str \"(do \" (slurp filename) \")\")))))", + (eval (read-string (str \"(do \" (slurp filename) \"\nnil)\")))))", }; static void installFunctions(malEnvPtr env) { 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/cpp/tests/step5_tco.mal b/impls/cpp/tests/step5_tco.mal similarity index 100% rename from cpp/tests/step5_tco.mal rename to impls/cpp/tests/step5_tco.mal 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/crystal/env.cr b/impls/crystal/env.cr similarity index 81% rename from crystal/env.cr rename to impls/crystal/env.cr index 572ceea34a..4bb83d7cda 100644 --- a/crystal/env.cr +++ b/impls/crystal/env.cr @@ -2,7 +2,6 @@ require "./types" require "./error" module Mal - class Env property data @@ -23,10 +22,10 @@ module Mal if sym.str == "&" eval_error "missing variable parameter name" if binds.size == idx - next_param = binds[idx+1].unwrap + 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 + exprs[idx..-1].each { |e| var_args << e } if idx < exprs.size @data[next_param.str] = Mal::Type.new var_args break end @@ -47,22 +46,16 @@ module Mal @data[key] = value end - def find(key) - return self if @data.has_key? key + def get(key) + return @data[key] if @data.has_key? key o = @outer if o - o.find key + o.get key else nil end end - def get(key) - e = find key - eval_error "'#{key}' not found" unless e - e.data[key] - end end - end diff --git a/crystal/error.cr b/impls/crystal/error.cr similarity index 99% rename from crystal/error.cr rename to impls/crystal/error.cr index b308a8a2c3..fb8f56c623 100644 --- a/crystal/error.cr +++ b/impls/crystal/error.cr @@ -9,6 +9,7 @@ module Mal class RuntimeException < Exception getter :thrown + def initialize(@thrown : Type) super() 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/crystal/reader.cr b/impls/crystal/reader.cr similarity index 80% rename from crystal/reader.cr rename to impls/crystal/reader.cr index e26a646dd4..dd7d62f56e 100644 --- a/crystal/reader.cr +++ b/impls/crystal/reader.cr @@ -30,7 +30,7 @@ class Reader 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 + parse_error "expected '#{open}', got #{token}" unless token[0] == open loop do token = peek @@ -77,15 +77,17 @@ class Reader parse_error "expected Atom but got EOF" unless token Mal::Type.new case - when token =~ /^-?\d+$/ then token.to_i + when token =~ /^-?\d+$/ then token.to_i64 when token == "true" then true when token == "false" then false when token == "nil" then nil - when token[0] == '"' then token[1..-2].gsub(/\\"/, "\"") - .gsub(/\\n/, "\n") - .gsub(/\\\\/, "\\") - when token[0] == ':' then "\u029e#{token[1..-1]}" - else Mal::Symbol.new token + 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 @@ -118,12 +120,11 @@ class Reader else read_atom end end - end def tokenize(str) - regex = /[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"|;.*|[^\s\[\]{}('"`,;)]*)/ - str.scan(regex).map{|m| m[1]}.reject(&.empty?) + regex = /[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)]*)/ + str.scan(regex).map { |m| m[1] }.reject(&.empty?) end def read_str(str) @@ -136,4 +137,3 @@ def read_str(str) 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/crystal/tests/step5_tco.mal b/impls/crystal/tests/step5_tco.mal similarity index 100% rename from crystal/tests/step5_tco.mal rename to impls/crystal/tests/step5_tco.mal diff --git a/crystal/types.cr b/impls/crystal/types.cr similarity index 80% rename from crystal/types.cr rename to impls/crystal/types.cr index 4c3590ac61..a65a9f1a43 100644 --- a/crystal/types.cr +++ b/impls/crystal/types.cr @@ -1,50 +1,15 @@ require "./printer" module Mal - 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 : List | Vector, @env : Env, @fn : Func) - end - end - class Type alias Func = (Array(Type) -> Type) - alias ValueType = Nil | Bool | Int32 | String | Symbol | List | Vector | HashMap | Func | Closure | Atom + # 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? + @meta = nil.as(Type | Nil) end def initialize(other : Type) @@ -80,7 +45,7 @@ module Mal {% for op in ops %} def {{op.id}}(other : Mal::Type) l, r = @val, other.unwrap - {% for t in [Int32, String] %} + {% for t in [Int64, String] %} if l.is_a?({{t}}) && r.is_a?({{t}}) return (l) {{op.id}} (r) end @@ -96,6 +61,45 @@ module Mal 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 @@ -105,7 +109,6 @@ end class Array def to_mal(t = Mal::List) - each_with_object(t.new){|e, l| l << e} + 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 96% rename from cs/core.cs rename to impls/cs/core.cs index 590a0de13b..16eb0564c2 100644 --- a/cs/core.cs +++ b/impls/cs/core.cs @@ -65,6 +65,15 @@ public class core { } } ); + 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( @@ -325,6 +334,9 @@ public class core { {"string?", string_Q}, {"keyword", keyword}, {"keyword?", keyword_Q}, + {"number?", number_Q}, + {"fn?", function_Q}, + {"macro?", macro_Q}, {"pr-str", pr_str}, {"str", str}, @@ -359,6 +371,7 @@ 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}, 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 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,14 +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("\\\\", "\\"); + .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 100% rename from cs/step0_repl.cs rename to impls/cs/step0_repl.cs 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 78% rename from cs/step6_file.cs rename to impls/cs/step6_file.cs index 361de6baa0..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; } @@ -154,7 +156,7 @@ static void Main(string[] args) { // 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/cs/tests/step5_tco.mal b/impls/cs/tests/step5_tco.mal similarity index 100% rename from cs/tests/step5_tco.mal rename to impls/cs/tests/step5_tco.mal diff --git a/cs/types.cs b/impls/cs/types.cs similarity index 100% rename from cs/types.cs rename to impls/cs/types.cs 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/d/main.di b/impls/d/main.di similarity index 100% rename from d/main.di rename to impls/d/main.di diff --git a/d/mal_core.d b/impls/d/mal_core.d similarity index 90% rename from d/mal_core.d rename to impls/d/mal_core.d index 561b4571b5..86d681b33c 100644 --- a/d/mal_core.d +++ b/impls/d/mal_core.d @@ -42,6 +42,7 @@ 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); } @@ -53,6 +54,24 @@ static MalType mal_keyword_q(MalType[] a ...) 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)); @@ -195,6 +214,12 @@ static MalType mal_concat(MalType[] a ...) 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); @@ -301,15 +326,15 @@ static MalType mal_meta(MalType[] a ...) return metaobj.meta(); } -static MalType mal_with_meta(MalType[] a ...) +static MalType mal_with_meta(return MalType[] a ...) { verify_args_count(a, 2); - auto metaobj = cast(MalMeta) a[0]; - if (metaobj is null) return a[0]; - return metaobj.with_meta(a[1]); + if (auto metaobj = cast(MalMeta) a[0]) + return metaobj.with_meta(a[1]); + return a[0]; } -static MalType mal_reset_bang(MalType[] a ...) +static MalType mal_reset_bang(return MalType[] a ...) { verify_args_count(a, 2); verify_cast!MalAtom(a[0]).val = a[1]; @@ -341,6 +366,9 @@ static this() "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, @@ -376,6 +404,7 @@ static this() "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, diff --git a/d/printer.d b/impls/d/printer.d similarity index 100% rename from d/printer.d rename to impls/d/printer.d diff --git a/d/reader.d b/impls/d/reader.d similarity index 86% rename from d/reader.d rename to impls/d/reader.d index 9cd39653f1..c2ffe2c69a 100644 --- a/d/reader.d +++ b/impls/d/reader.d @@ -44,7 +44,7 @@ class Reader } } -auto tokenize_ctr = ctRegex!(r"[\s,]*(~@|[\[\]{}()'`~^@]|" `"` `(?:\\.|[^\\"])*"|;.*|[^\s\[\]{}('"` r"`,;)]*)"); +auto tokenize_ctr = ctRegex!(r"[\s,]*(~@|[\[\]{}()'`~^@]|" ~ `"` ~ `(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"` ~ r"`,;)]*)"); string[] tokenize(string str) { @@ -61,15 +61,19 @@ string[] tokenize(string str) MalString parse_string(string token) { - string unescaped = + // 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("\\\\", "\\"); + .replace("\u029e", "\\"); return new MalString(unescaped); } auto integer_ctr = ctRegex!(r"^-?[0-9]+$"); +auto string_ctr = ctRegex!(`^"(?:\\.|[^\\"])*"$`); MalType read_atom(Reader reader) { @@ -84,6 +88,11 @@ MalType read_atom(Reader reader) 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); @@ -100,7 +109,7 @@ MalType read_atom(Reader reader) MalType[] read_items(Reader reader, string start, string end) { auto open_paren = reader.next(); - if (open_paren != start) throw new Exception("expected '" ~ start ~ "'"); + if (open_paren != start) throw new Exception("expected '" ~ start ~ "', got EOF"); string token; MalType[] res; @@ -108,7 +117,7 @@ MalType[] read_items(Reader reader, string start, string end) { if (token is null) { - throw new Exception("expected '" ~ end ~ "'"); + throw new Exception("expected '" ~ end ~ "', got EOF"); } res ~= read_form(reader); } diff --git a/d/readline.d b/impls/d/readline.d similarity index 95% rename from d/readline.d rename to impls/d/readline.d index 1907def82c..37a5e73321 100644 --- a/d/readline.d +++ b/impls/d/readline.d @@ -1,5 +1,9 @@ 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); 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/d/step0_repl.d b/impls/d/step0_repl.d similarity index 100% rename from d/step0_repl.d rename to impls/d/step0_repl.d diff --git a/d/step1_read_print.d b/impls/d/step1_read_print.d similarity index 100% rename from d/step1_read_print.d rename to impls/d/step1_read_print.d 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/d/tests/step5_tco.mal b/impls/d/tests/step5_tco.mal similarity index 100% rename from d/tests/step5_tco.mal rename to impls/d/tests/step5_tco.mal diff --git a/d/types.d b/impls/d/types.d similarity index 98% rename from d/types.d rename to impls/d/types.d index 82e8dbae78..b140eb7fe3 100644 --- a/d/types.d +++ b/impls/d/types.d @@ -425,9 +425,8 @@ class MalException : Exception T verify_cast(T)(in MalType v) { - T res = cast(T) v; - if (res is null) throw new Exception("Expected " ~ typeid(T).name); - return res; + if (T res = cast(T) v) return res; + throw new Exception("Expected " ~ typeid(T).name); } MalType mal_type_q(T)(in MalType[] a) 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/elisp/reader.el b/impls/elisp/mal/reader.el similarity index 87% rename from elisp/reader.el rename to impls/elisp/mal/reader.el index 26d8361199..8253cd98f1 100644 --- a/elisp/reader.el +++ b/impls/elisp/mal/reader.el @@ -1,13 +1,20 @@ -(defvar tokens nil) +(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 tokens)) + (car reader--tokens)) (defun next () - (pop tokens)) + (pop reader--tokens)) (defun read-str (input) - (setq tokens (tokenizer input)) + (setq reader--tokens (tokenizer input)) (read-form)) (defun tokenizer (input) @@ -28,29 +35,28 @@ (nreverse output)))) (defun read-form () - (let ((token (peek))) - (cond - ((string= token "'") + (pcase (peek) + ("'" (read-quote)) - ((string= token "`") + ("`" (read-quasiquote)) - ((string= token "~") + ("~" (read-unquote)) - ((string= token "~@") + ("~@" (read-splice-unquote)) - ((string= token "@") + ("@" (read-deref)) - ((string= token "^") + ("^" (read-with-meta)) - ((string= token "(") + ("(" (read-list)) - ((string= token "[") + ("[" (read-vector)) - ((string= token "{") + ("{" (read-map)) - (t + (_ ;; assume anything else is an atom - (read-atom))))) + (read-atom)))) (defun read-simple-reader-macro (symbol) (next) ; pop reader macro token @@ -143,8 +149,10 @@ (mal-string (read token)) (signal 'unterminated-sequence '(string)))) ((= (aref token 0) ?:) - (mal-keyword (intern token))) + (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/elisp/tests/step5_tco.mal b/impls/elisp/tests/step5_tco.mal similarity index 100% rename from elisp/tests/step5_tco.mal rename to impls/elisp/tests/step5_tco.mal 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/elixir/lib/mal.ex b/impls/elixir/lib/mal.ex similarity index 100% rename from elixir/lib/mal.ex rename to impls/elixir/lib/mal.ex diff --git a/elixir/lib/mal/atom.ex b/impls/elixir/lib/mal/atom.ex similarity index 100% rename from elixir/lib/mal/atom.ex rename to impls/elixir/lib/mal/atom.ex diff --git a/elixir/lib/mal/core.ex b/impls/elixir/lib/mal/core.ex similarity index 90% rename from elixir/lib/mal/core.ex rename to impls/elixir/lib/mal/core.ex index 1af6581d32..f8074c6de0 100644 --- a/elixir/lib/mal/core.ex +++ b/impls/elixir/lib/mal/core.ex @@ -30,6 +30,7 @@ defmodule Mal.Core do "keyword" => &keyword/1, "symbol?" => &symbol?/1, "cons" => &cons/1, + "vec" => &vec/1, "vector?" => &vector?/1, "assoc" => &assoc/1, "dissoc" => &dissoc/1, @@ -47,6 +48,8 @@ defmodule Mal.Core do "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, @@ -55,6 +58,7 @@ defmodule Mal.Core do "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, @@ -75,7 +79,7 @@ defmodule Mal.Core do def readline(prompt) do IO.write(:stdio, prompt) IO.read(:stdio, :line) - |> String.strip(?\n) + |> String.trim("\n") end defp convert_vector({type, ast, meta}) when type == :map do @@ -182,6 +186,11 @@ defmodule Mal.Core do |> 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} @@ -200,6 +209,7 @@ defmodule Mal.Core do 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) @@ -223,11 +233,17 @@ defmodule Mal.Core do end defp seq([nil]), do: nil - defp seq([{:list, [], meta}]), 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, [], _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/elixir/lib/mal/env.ex b/impls/elixir/lib/mal/env.ex similarity index 100% rename from elixir/lib/mal/env.ex rename to impls/elixir/lib/mal/env.ex diff --git a/elixir/lib/mal/printer.ex b/impls/elixir/lib/mal/printer.ex similarity index 100% rename from elixir/lib/mal/printer.ex rename to impls/elixir/lib/mal/printer.ex diff --git a/elixir/lib/mal/reader.ex b/impls/elixir/lib/mal/reader.ex similarity index 89% rename from elixir/lib/mal/reader.ex rename to impls/elixir/lib/mal/reader.ex index 59365c7f78..07f3719c9a 100644 --- a/elixir/lib/mal/reader.ex +++ b/impls/elixir/lib/mal/reader.ex @@ -11,7 +11,7 @@ defmodule Mal.Reader do end def tokenize(input) do - regex = ~r/[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"|;.*|[^\s\[\]{}('"`,;)]*)/ + 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 @@ -83,12 +83,13 @@ defmodule Mal.Reader do defp read_atom(":" <> rest), do: String.to_atom(rest) defp read_atom(token) do cond do - String.starts_with?(token, "\"") and String.ends_with?(token, "\"") -> + String.match?(token, ~r/^"(?:\\.|[^\\"])*"$/) -> token - |> String.slice(1..-2) - |> String.replace("\\\"", "\"") - |> String.replace("\\n", "\n") - |> String.replace("\\\\", "\\") + |> Code.string_to_quoted + |> elem(1) + + String.starts_with?(token, "\"") -> + throw({:error, "expected '\"', got EOF"}) integer?(token) -> Integer.parse(token) diff --git a/elixir/lib/mal/types.ex b/impls/elixir/lib/mal/types.ex similarity index 100% rename from elixir/lib/mal/types.ex rename to impls/elixir/lib/mal/types.ex diff --git a/elixir/lib/mix/tasks/step0_repl.ex b/impls/elixir/lib/mix/tasks/step0_repl.ex similarity index 91% rename from elixir/lib/mix/tasks/step0_repl.ex rename to impls/elixir/lib/mix/tasks/step0_repl.ex index 437e787021..4cd3efec2a 100644 --- a/elixir/lib/mix/tasks/step0_repl.ex +++ b/impls/elixir/lib/mix/tasks/step0_repl.ex @@ -1,12 +1,12 @@ defmodule Mix.Tasks.Step0Repl do - def run(_), do: loop + def run(_), do: loop() defp loop do Mal.Core.readline("user> ") |> read_eval_print |> IO.puts - loop + loop() end defp read(input) do diff --git a/elixir/lib/mix/tasks/step1_read_print.ex b/impls/elixir/lib/mix/tasks/step1_read_print.ex similarity index 93% rename from elixir/lib/mix/tasks/step1_read_print.ex rename to impls/elixir/lib/mix/tasks/step1_read_print.ex index 25399b08df..9569e68fb6 100644 --- a/elixir/lib/mix/tasks/step1_read_print.ex +++ b/impls/elixir/lib/mix/tasks/step1_read_print.ex @@ -1,12 +1,12 @@ defmodule Mix.Tasks.Step1ReadPrint do - def run(_), do: loop + def run(_), do: loop() defp loop do Mal.Core.readline("user> ") |> read_eval_print |> IO.puts - loop + loop() end defp read(input) do 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/elixir/lib/mix/tasks/step3_env.ex b/impls/elixir/lib/mix/tasks/step3_env.ex similarity index 78% rename from elixir/lib/mix/tasks/step3_env.ex rename to impls/elixir/lib/mix/tasks/step3_env.ex index 8c49e50972..786861f399 100644 --- a/elixir/lib/mix/tasks/step3_env.ex +++ b/impls/elixir/lib/mix/tasks/step3_env.ex @@ -22,12 +22,12 @@ defmodule Mix.Tasks.Step3Env do end defp eval_ast({:list, ast, meta}, env) when is_list(ast) do - {:list, Enum.map(ast, fn elem -> eval(elem, env) end), meta} + eval_list(ast, env, meta) end defp eval_ast({:map, ast, meta}, env) do map = for {key, value} <- ast, into: %{} do - {eval(key, env), eval(value, env)} + {key, eval(value, env)} end {:map, map, meta} @@ -50,7 +50,7 @@ defmodule Mix.Tasks.Step3Env do Mal.Reader.read_str(input) end - defp eval_bindings([], _env), do: _env + 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) @@ -58,9 +58,15 @@ defmodule Mix.Tasks.Step3Env do end defp eval_bindings(_bindings, _env), do: throw({:error, "Unbalanced let* bindings"}) - defp eval({:list, [], _} = empty_ast, env), do: empty_ast - defp eval({:list, ast, meta}, env), do: eval_list(ast, env, meta) - defp eval(ast, env), do: eval_ast(ast, env) + 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) @@ -75,11 +81,14 @@ defmodule Mix.Tasks.Step3Env do eval(body, let_env) end - defp eval_list(ast, env, meta) do - {:list, [func | args], _} = eval_ast({:list, ast, meta}, env) + 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 diff --git a/elixir/lib/mix/tasks/step4_if_fn_do.ex b/impls/elixir/lib/mix/tasks/step4_if_fn_do.ex similarity index 83% rename from elixir/lib/mix/tasks/step4_if_fn_do.ex rename to impls/elixir/lib/mix/tasks/step4_if_fn_do.ex index 25ef00ef81..c0c5232b1a 100644 --- a/elixir/lib/mix/tasks/step4_if_fn_do.ex +++ b/impls/elixir/lib/mix/tasks/step4_if_fn_do.ex @@ -31,12 +31,12 @@ defmodule Mix.Tasks.Step4IfFnDo do end defp eval_ast({:list, ast, meta}, env) when is_list(ast) do - {:list, Enum.map(ast, fn elem -> eval(elem, env) end), meta} + eval_list(ast, env, meta) end defp eval_ast({:map, ast, meta}, env) do map = for {key, value} <- ast, into: %{} do - {eval(key, env), eval(value, env)} + {key, eval(value, env)} end {:map, map, meta} @@ -59,7 +59,7 @@ defmodule Mix.Tasks.Step4IfFnDo do Mal.Reader.read_str(input) end - defp eval_bindings([], _env), do: _env + 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) @@ -67,9 +67,15 @@ defmodule Mix.Tasks.Step4IfFnDo do end defp eval_bindings(_bindings, _env), do: throw({:error, "Unbalanced let* bindings"}) - defp eval({:list, [], _} = empty_ast, env), do: empty_ast - defp eval({:list, ast, meta}, env), do: eval_list(ast, env, meta) - defp eval(ast, env), do: eval_ast(ast, env) + 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) @@ -86,8 +92,7 @@ defmodule Mix.Tasks.Step4IfFnDo do defp eval_list([{:symbol, "do"} | ast], env, _) do ast |> List.delete_at(-1) - |> list - |> eval_ast(env) + |> Enum.map(fn elem -> eval(elem, env) end) eval(List.last(ast), env) end @@ -116,11 +121,14 @@ defmodule Mix.Tasks.Step4IfFnDo do %Function{value: closure} end - defp eval_list(ast, env, meta) do - {:list, [func | args], _} = eval_ast({:list, ast, meta}, env) + 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 diff --git a/elixir/lib/mix/tasks/step5_tco.ex b/impls/elixir/lib/mix/tasks/step5_tco.ex similarity index 83% rename from elixir/lib/mix/tasks/step5_tco.ex rename to impls/elixir/lib/mix/tasks/step5_tco.ex index f5ca80fa14..8ad7d9be33 100644 --- a/elixir/lib/mix/tasks/step5_tco.ex +++ b/impls/elixir/lib/mix/tasks/step5_tco.ex @@ -31,12 +31,12 @@ defmodule Mix.Tasks.Step5Tco do end defp eval_ast({:list, ast, meta}, env) when is_list(ast) do - {:list, Enum.map(ast, fn elem -> eval(elem, env) end), meta} + eval_list(ast, env, meta) end defp eval_ast({:map, ast, meta}, env) do map = for {key, value} <- ast, into: %{} do - {eval(key, env), eval(value, env)} + {key, eval(value, env)} end {:map, map, meta} @@ -59,7 +59,7 @@ defmodule Mix.Tasks.Step5Tco do Mal.Reader.read_str(input) end - defp eval_bindings([], _env), do: _env + 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) @@ -67,9 +67,15 @@ defmodule Mix.Tasks.Step5Tco do end defp eval_bindings(_bindings, _env), do: throw({:error, "Unbalanced let* bindings"}) - defp eval({:list, [], _} = empty_ast, env), do: empty_ast - defp eval({:list, ast, meta}, env), do: eval_list(ast, env, meta) - defp eval(ast, env), do: eval_ast(ast, env) + 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) @@ -86,8 +92,7 @@ defmodule Mix.Tasks.Step5Tco do defp eval_list([{:symbol, "do"} | ast], env, _) do ast |> List.delete_at(-1) - |> list - |> eval_ast(env) + |> Enum.map(fn elem -> eval(elem, env) end) eval(List.last(ast), env) end @@ -116,14 +121,17 @@ defmodule Mix.Tasks.Step5Tco do %Function{value: closure} end - defp eval_list(ast, env, meta) do - {:list, [func | args], _} = eval_ast({:list, ast, meta}, env) + 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 diff --git a/elixir/lib/mix/tasks/step6_file.ex b/impls/elixir/lib/mix/tasks/step6_file.ex similarity index 83% rename from elixir/lib/mix/tasks/step6_file.ex rename to impls/elixir/lib/mix/tasks/step6_file.ex index 7ddcefae5f..0503ea32ac 100644 --- a/elixir/lib/mix/tasks/step6_file.ex +++ b/impls/elixir/lib/mix/tasks/step6_file.ex @@ -27,7 +27,7 @@ defmodule Mix.Tasks.Step6File do read_eval_print(""" (def! load-file (fn* (f) - (eval (read-string (str "(do " (slurp f) ")"))))) + (eval (read-string (str "(do " (slurp f) "\nnil)"))))) """, env) Mal.Env.set(env, "eval", %Function{value: fn [ast] -> @@ -54,12 +54,12 @@ defmodule Mix.Tasks.Step6File do end defp eval_ast({:list, ast, meta}, env) when is_list(ast) do - {:list, Enum.map(ast, fn elem -> eval(elem, env) end), meta} + eval_list(ast, env, meta) end defp eval_ast({:map, ast, meta}, env) do map = for {key, value} <- ast, into: %{} do - {eval(key, env), eval(value, env)} + {key, eval(value, env)} end {:map, map, meta} @@ -82,7 +82,7 @@ defmodule Mix.Tasks.Step6File do Mal.Reader.read_str(input) end - defp eval_bindings([], _env), do: _env + 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) @@ -90,9 +90,15 @@ defmodule Mix.Tasks.Step6File do end defp eval_bindings(_bindings, _env), do: throw({:error, "Unbalanced let* bindings"}) - defp eval({:list, [], _} = empty_ast, env), do: empty_ast - defp eval({:list, ast, meta}, env), do: eval_list(ast, env, meta) - defp eval(ast, env), do: eval_ast(ast, env) + 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) @@ -109,8 +115,7 @@ defmodule Mix.Tasks.Step6File do defp eval_list([{:symbol, "do"} | ast], env, _) do ast |> List.delete_at(-1) - |> list - |> eval_ast(env) + |> Enum.map(fn elem -> eval(elem, env) end) eval(List.last(ast), env) end @@ -139,11 +144,14 @@ defmodule Mix.Tasks.Step6File do %Function{value: closure} end - defp eval_list(ast, env, meta) do - {:list, [func | args], _} = eval_ast({:list, ast, meta}, env) + 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 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/elixir/mix.exs b/impls/elixir/mix.exs similarity index 91% rename from elixir/mix.exs rename to impls/elixir/mix.exs index aba14e7b0c..5d768f6e0a 100644 --- a/elixir/mix.exs +++ b/impls/elixir/mix.exs @@ -4,12 +4,12 @@ defmodule Mal.Mixfile do def project do [app: :mal, version: "0.0.1", - elixir: "~> 1.0", + elixir: "~> 1.5", build_embedded: Mix.env == :prod, start_permanent: Mix.env == :prod, - deps: deps, + deps: deps(), default_task: "stepA_mal", - escript: escript] + escript: escript()] end def escript do 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/elixir/tests/step5_tco.mal b/impls/elixir/tests/step5_tco.mal similarity index 100% rename from elixir/tests/step5_tco.mal rename to impls/elixir/tests/step5_tco.mal 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/erlang/rebar.config b/impls/erlang/rebar.config similarity index 92% rename from erlang/rebar.config rename to impls/erlang/rebar.config index f18253f3d9..80e028cbac 100644 --- a/erlang/rebar.config +++ b/impls/erlang/rebar.config @@ -2,8 +2,6 @@ %% rebar configuration file (https://github.com/rebar/rebar) %% -{require_otp_vsn, "17|18"}. - {erl_opts, [debug_info, fail_on_warning]}. {clean_files, [ diff --git a/erlang/rebar.config.script b/impls/erlang/rebar.config.script similarity index 100% rename from erlang/rebar.config.script rename to impls/erlang/rebar.config.script 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/erlang/src/atom.erl b/impls/erlang/src/atom.erl similarity index 100% rename from erlang/src/atom.erl rename to impls/erlang/src/atom.erl diff --git a/erlang/src/core.erl b/impls/erlang/src/core.erl similarity index 92% rename from erlang/src/core.erl rename to impls/erlang/src/core.erl index 154ddb1045..c074248ab2 100644 --- a/erlang/src/core.erl +++ b/impls/erlang/src/core.erl @@ -20,6 +20,29 @@ false_p([Arg]) -> 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]) -> @@ -246,6 +269,11 @@ concat(Args) -> 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(_) -> @@ -278,6 +306,10 @@ 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(_) -> @@ -324,6 +356,7 @@ ns() -> "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, @@ -331,11 +364,13 @@ ns() -> "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, @@ -355,6 +390,7 @@ ns() -> "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 diff --git a/erlang/src/env.erl b/impls/erlang/src/env.erl similarity index 100% rename from erlang/src/env.erl rename to impls/erlang/src/env.erl diff --git a/erlang/src/mal.app.src b/impls/erlang/src/mal.app.src similarity index 100% rename from erlang/src/mal.app.src rename to impls/erlang/src/mal.app.src diff --git a/erlang/src/printer.erl b/impls/erlang/src/printer.erl similarity index 97% rename from erlang/src/printer.erl rename to impls/erlang/src/printer.erl index 9c008d4964..a43c397837 100644 --- a/erlang/src/printer.erl +++ b/impls/erlang/src/printer.erl @@ -28,7 +28,7 @@ pr_str(Value, Readably) -> BodyStr = pr_str(Body, Readably), io_lib:format("(fn* ~s ~s)", [BindsStr, BodyStr]); {function, _Func, _Meta} -> "#"; - {macro, _Binds, _Body, _Env} -> "#"; + {macro, _Eval, _Binds, _Body, _Env} -> "#"; {error, Reason} -> io_lib:format("error: ~s", [Reason]) end. diff --git a/erlang/src/reader.erl b/impls/erlang/src/reader.erl similarity index 100% rename from erlang/src/reader.erl rename to impls/erlang/src/reader.erl diff --git a/erlang/src/step0_repl.erl b/impls/erlang/src/step0_repl.erl similarity index 100% rename from erlang/src/step0_repl.erl rename to impls/erlang/src/step0_repl.erl diff --git a/erlang/src/step1_read_print.erl b/impls/erlang/src/step1_read_print.erl similarity index 100% rename from erlang/src/step1_read_print.erl rename to impls/erlang/src/step1_read_print.erl 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/erlang/src/types.erl b/impls/erlang/src/types.erl similarity index 93% rename from erlang/src/types.erl rename to impls/erlang/src/types.erl index 61db367863..0dcc902076 100644 --- a/erlang/src/types.erl +++ b/impls/erlang/src/types.erl @@ -47,10 +47,10 @@ keyword_p([_A]) -> keyword_p(_) -> {error, "keyword? takes a single argument"}. -keyword([{string, Name}]) -> - {keyword, Name}; -keyword(_) -> - {error, "keyword expects a single string 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; diff --git a/erlang/tests/step5_tco.mal b/impls/erlang/tests/step5_tco.mal similarity index 100% rename from erlang/tests/step5_tco.mal rename to impls/erlang/tests/step5_tco.mal 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/es6/tests/step5_tco.mal b/impls/es6/tests/step5_tco.mal similarity index 100% rename from es6/tests/step5_tco.mal rename to impls/es6/tests/step5_tco.mal 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/factor/lib/core/core-tests.factor b/impls/factor/lib/core/core-tests.factor similarity index 100% rename from factor/lib/core/core-tests.factor rename to impls/factor/lib/core/core-tests.factor diff --git a/factor/lib/core/core.factor b/impls/factor/lib/core/core.factor similarity index 90% rename from factor/lib/core/core.factor rename to impls/factor/lib/core/core.factor index 906be6553b..1c0cf6671a 100644 --- a/factor/lib/core/core.factor +++ b/impls/factor/lib/core/core.factor @@ -3,7 +3,7 @@ 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 readline sequences sets +lib.reader lib.types math namespaces quotations readline sequences sets strings system vectors ; IN: lib.core @@ -36,6 +36,7 @@ CONSTANT: ns H{ { "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 ] } @@ -48,8 +49,11 @@ CONSTANT: ns H{ { "symbol" [ first ] } { "symbol?" [ first malsymbol? ] } { "string?" [ first string? ] } - { "keyword" [ first ] } + { "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 ] } diff --git a/factor/lib/env/env-tests.factor b/impls/factor/lib/env/env-tests.factor similarity index 100% rename from factor/lib/env/env-tests.factor rename to impls/factor/lib/env/env-tests.factor diff --git a/factor/lib/env/env.factor b/impls/factor/lib/env/env.factor similarity index 100% rename from factor/lib/env/env.factor rename to impls/factor/lib/env/env.factor diff --git a/factor/lib/printer/printer-tests.factor b/impls/factor/lib/printer/printer-tests.factor similarity index 100% rename from factor/lib/printer/printer-tests.factor rename to impls/factor/lib/printer/printer-tests.factor diff --git a/factor/lib/printer/printer.factor b/impls/factor/lib/printer/printer.factor similarity index 95% rename from factor/lib/printer/printer.factor rename to impls/factor/lib/printer/printer.factor index 8ff4266afe..0739f473ef 100644 --- a/factor/lib/printer/printer.factor +++ b/impls/factor/lib/printer/printer.factor @@ -5,7 +5,7 @@ lib.types math math.parser sequences splitting strings summary vectors ; IN: lib.printer -GENERIC# (pr-str) 1 ( maltype readably? -- str ) +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 "#" ; diff --git a/factor/lib/reader/reader-tests.factor b/impls/factor/lib/reader/reader-tests.factor similarity index 100% rename from factor/lib/reader/reader-tests.factor rename to impls/factor/lib/reader/reader-tests.factor 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/factor/lib/types/types.factor b/impls/factor/lib/types/types.factor similarity index 90% rename from factor/lib/types/types.factor rename to impls/factor/lib/types/types.factor index d018042320..da00d8ba9e 100644 --- a/factor/lib/types/types.factor +++ b/impls/factor/lib/types/types.factor @@ -15,9 +15,12 @@ TUPLE: malfn { env malenv read-only } { binds sequence read-only } { exprs read-only } - { macro? boolean } + { 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 ; 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/factor/step0_repl/deploy.factor b/impls/factor/step0_repl/deploy.factor similarity index 100% rename from factor/step0_repl/deploy.factor rename to impls/factor/step0_repl/deploy.factor diff --git a/factor/step0_repl/step0_repl.factor b/impls/factor/step0_repl/step0_repl.factor similarity index 100% rename from factor/step0_repl/step0_repl.factor rename to impls/factor/step0_repl/step0_repl.factor diff --git a/factor/step1_read_print/deploy.factor b/impls/factor/step1_read_print/deploy.factor similarity index 100% rename from factor/step1_read_print/deploy.factor rename to impls/factor/step1_read_print/deploy.factor diff --git a/factor/step1_read_print/step1_read_print.factor b/impls/factor/step1_read_print/step1_read_print.factor similarity index 82% rename from factor/step1_read_print/step1_read_print.factor rename to impls/factor/step1_read_print/step1_read_print.factor index fe42cad03d..3d23d9c31e 100755 --- a/factor/step1_read_print/step1_read_print.factor +++ b/impls/factor/step1_read_print/step1_read_print.factor @@ -11,7 +11,11 @@ IN: step1_read_print : PRINT ( maltype -- str ) pr-str ; : REP ( str -- str ) - [ READ EVAL ] [ nip ] recover PRINT ; + [ + READ EVAL PRINT + ] [ + nip pr-str "Error: " swap append + ] recover ; : REPL ( -- ) [ diff --git a/factor/step2_eval/deploy.factor b/impls/factor/step2_eval/deploy.factor similarity index 100% rename from factor/step2_eval/deploy.factor rename to impls/factor/step2_eval/deploy.factor 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/factor/step3_env/deploy.factor b/impls/factor/step3_env/deploy.factor similarity index 100% rename from factor/step3_env/deploy.factor rename to impls/factor/step3_env/deploy.factor 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/factor/step4_if_fn_do/deploy.factor b/impls/factor/step4_if_fn_do/deploy.factor similarity index 100% rename from factor/step4_if_fn_do/deploy.factor rename to impls/factor/step4_if_fn_do/deploy.factor 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/factor/step5_tco/deploy.factor b/impls/factor/step5_tco/deploy.factor similarity index 100% rename from factor/step5_tco/deploy.factor rename to impls/factor/step5_tco/deploy.factor diff --git a/factor/step5_tco/step5_tco.factor b/impls/factor/step5_tco/step5_tco.factor similarity index 76% rename from factor/step5_tco/step5_tco.factor rename to impls/factor/step5_tco/step5_tco.factor index face303a81..c7a3ab12bd 100755 --- a/factor/step5_tco/step5_tco.factor +++ b/impls/factor/step5_tco/step5_tco.factor @@ -3,21 +3,13 @@ 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 ; +splitting vectors ; IN: step5_tco SYMBOL: repl-env DEFER: EVAL -: eval-ast ( ast env -- ast ) - { - { [ over malsymbol? ] [ env-get ] } - { [ over sequence? ] [ '[ _ EVAL ] map ] } - { [ over assoc? ] [ '[ [ _ EVAL ] bi@ ] assoc-map ] } - [ drop ] - } cond ; - :: eval-def! ( key value env -- maltype ) value env EVAL [ key env env-set ] keep ; @@ -30,7 +22,7 @@ DEFER: EVAL exprs [ { } f ] [ - unclip-last [ env eval-ast drop ] dip env + unclip-last [ '[ env EVAL drop ] each ] dip env ] if-empty ; :: eval-if ( params env -- maltype env/f ) @@ -61,8 +53,9 @@ M: callable apply call( x -- y ) f ; : READ ( str -- maltype ) read-str ; -: EVAL ( maltype env -- maltype ) - over { [ array? ] [ empty? not ] } 1&& [ +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* ] } @@ -70,15 +63,30 @@ M: callable apply call( x -- y ) f ; { "if" [ [ rest ] dip eval-if ] } { "fn*" [ [ rest ] dip eval-fn* f ] } [ drop '[ _ EVAL ] map unclip apply ] - } case - ] [ - eval-ast f - ] if [ EVAL ] when* ; + } 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 ] [ nip ] recover PRINT ; + [ + READ repl-env get EVAL PRINT + ] [ + nip pr-str "Error: " swap append + ] recover ; : REPL ( -- ) [ diff --git a/factor/step6_file/deploy.factor b/impls/factor/step6_file/deploy.factor similarity index 100% rename from factor/step6_file/deploy.factor rename to impls/factor/step6_file/deploy.factor diff --git a/factor/step6_file/step6_file.factor b/impls/factor/step6_file/step6_file.factor similarity index 79% rename from factor/step6_file/step6_file.factor rename to impls/factor/step6_file/step6_file.factor index 4509ccf30d..d08691bce8 100755 --- a/factor/step6_file/step6_file.factor +++ b/impls/factor/step6_file/step6_file.factor @@ -3,21 +3,13 @@ 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 ; +readline sequences splitting vectors ; IN: step6_file SYMBOL: repl-env DEFER: EVAL -: eval-ast ( ast env -- ast ) - { - { [ over malsymbol? ] [ env-get ] } - { [ over sequence? ] [ '[ _ EVAL ] map ] } - { [ over assoc? ] [ '[ [ _ EVAL ] bi@ ] assoc-map ] } - [ drop ] - } cond ; - :: eval-def! ( key value env -- maltype ) value env EVAL [ key env env-set ] keep ; @@ -30,7 +22,7 @@ DEFER: EVAL exprs [ { } f ] [ - unclip-last [ env eval-ast drop ] dip env + unclip-last [ '[ env EVAL drop ] each ] dip env ] if-empty ; :: eval-if ( params env -- maltype env/f ) @@ -61,8 +53,9 @@ M: callable apply call( x -- y ) f ; : READ ( str -- maltype ) read-str ; -: EVAL ( maltype env -- maltype ) - over { [ array? ] [ empty? not ] } 1&& [ +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* ] } @@ -71,16 +64,31 @@ M: callable apply call( x -- y ) f ; { "fn*" [ [ rest ] dip eval-fn* f ] } [ drop '[ _ EVAL ] map unclip apply ] } case [ EVAL ] when* - ] [ - eval-ast ] 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 ] [ nip ] recover PRINT ; + [ + READ repl-env get EVAL PRINT + ] [ + nip pr-str "Error: " swap append + ] recover ; : REPL ( -- ) [ @@ -102,7 +110,7 @@ command-line get dup empty? [ rest ] unless "*ARGV*" pick set-at " (def! not (fn* (a) (if a false true))) -(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)\"))))) " string-lines harvest [ REP drop ] each MAIN: main diff --git a/factor/step7_quote/deploy.factor b/impls/factor/step7_quote/deploy.factor similarity index 100% rename from factor/step7_quote/deploy.factor rename to impls/factor/step7_quote/deploy.factor 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/factor/step8_macros/deploy.factor b/impls/factor/step8_macros/deploy.factor similarity index 100% rename from factor/step8_macros/deploy.factor rename to impls/factor/step8_macros/deploy.factor 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/factor/step9_try/deploy.factor b/impls/factor/step9_try/deploy.factor similarity index 100% rename from factor/step9_try/deploy.factor rename to impls/factor/step9_try/deploy.factor 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/factor/stepA_mal/deploy.factor b/impls/factor/stepA_mal/deploy.factor similarity index 100% rename from factor/stepA_mal/deploy.factor rename to impls/factor/stepA_mal/deploy.factor 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/factor/tests/step5_tco.mal b/impls/factor/tests/step5_tco.mal similarity index 100% rename from factor/tests/step5_tco.mal rename to impls/factor/tests/step5_tco.mal 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/forth/tests/step5_tco.mal b/impls/fantom/tests/step5_tco.mal similarity index 100% rename from forth/tests/step5_tco.mal rename to impls/fantom/tests/step5_tco.mal 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/forth/printer.fs b/impls/forth/printer.fs similarity index 100% rename from forth/printer.fs rename to impls/forth/printer.fs diff --git a/forth/reader.fs b/impls/forth/reader.fs similarity index 100% rename from forth/reader.fs rename to impls/forth/reader.fs 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/groovy/tests/step5_tco.mal b/impls/forth/tests/step5_tco.mal similarity index 100% rename from groovy/tests/step5_tco.mal rename to impls/forth/tests/step5_tco.mal 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/forth/types.fs b/impls/forth/types.fs similarity index 98% rename from forth/types.fs rename to impls/forth/types.fs index 5d3faec346..f5c823d8e5 100644 --- a/forth/types.fs +++ b/impls/forth/types.fs @@ -654,6 +654,15 @@ MalType% 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 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/fsharp/env.fs b/impls/fsharp/env.fs similarity index 88% rename from fsharp/env.fs rename to impls/fsharp/env.fs index 73f95afdc5..f505ba5917 100644 --- a/fsharp/env.fs +++ b/impls/fsharp/env.fs @@ -14,18 +14,13 @@ module Env | head::_ -> head.[key] <- node | _ -> raise <| Error.noEnvironment () - let rec find (chain : EnvChain) key = + let rec get (chain : EnvChain) key = match chain with | [] -> None | env::rest -> match env.TryGetValue(key) with | true, v -> Some(v) - | false, _ -> find rest key - - let get chain key = - match find chain key with - | Some(v) -> v - | None -> raise <| Error.symbolNotFound key + | false, _ -> get rest key let private getNextValue = let counter = ref 0 @@ -65,6 +60,7 @@ module Env 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 @@ -79,6 +75,9 @@ module Env 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 @@ -118,11 +117,3 @@ module Env | [], _ -> raise <| Error.tooManyValues () | _, _ -> raise <| Error.errExpectedX "symbol" loop symbols nodes - - (* Active Patterns to help with pattern matching nodes *) - let inline (|IsMacro|_|) env = function - | List(_, Symbol(sym)::rest) -> - match find env sym with - | Some(Macro(_, _, _, _, _, _) as m) -> Some(IsMacro m, rest) - | _ -> None - | _ -> None diff --git a/fsharp/error.fs b/impls/fsharp/error.fs similarity index 100% rename from fsharp/error.fs rename to impls/fsharp/error.fs diff --git a/fsharp/node.fs b/impls/fsharp/node.fs similarity index 100% rename from fsharp/node.fs rename to impls/fsharp/node.fs diff --git a/fsharp/printer.fs b/impls/fsharp/printer.fs similarity index 100% rename from fsharp/printer.fs rename to impls/fsharp/printer.fs diff --git a/fsharp/reader.fs b/impls/fsharp/reader.fs similarity index 100% rename from fsharp/reader.fs rename to impls/fsharp/reader.fs diff --git a/fsharp/readline.fs b/impls/fsharp/readline.fs similarity index 100% rename from fsharp/readline.fs rename to impls/fsharp/readline.fs 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/fsharp/step0_repl.fs b/impls/fsharp/step0_repl.fs similarity index 100% rename from fsharp/step0_repl.fs rename to impls/fsharp/step0_repl.fs 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/fsharp/terminal.cs b/impls/fsharp/terminal.cs similarity index 100% rename from fsharp/terminal.cs rename to impls/fsharp/terminal.cs diff --git a/fsharp/tests/step5_tco.mal b/impls/fsharp/tests/step5_tco.mal similarity index 100% rename from fsharp/tests/step5_tco.mal rename to impls/fsharp/tests/step5_tco.mal diff --git a/fsharp/tokenizer.fs b/impls/fsharp/tokenizer.fs similarity index 97% rename from fsharp/tokenizer.fs rename to impls/fsharp/tokenizer.fs index fb2834ce32..6bfbc74159 100644 --- a/fsharp/tokenizer.fs +++ b/impls/fsharp/tokenizer.fs @@ -102,7 +102,7 @@ module Tokenizer | '@' -> At, n | '"' -> accumulateString n | ':' -> accumulateKeyword n - | '-' when isDigit str.[n] -> accumulateWhile isDigit Number p 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 () diff --git a/fsharp/types.fs b/impls/fsharp/types.fs similarity index 100% rename from fsharp/types.fs rename to impls/fsharp/types.fs 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 6411d72ce2..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,13 +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( - strings.Replace(str, `\"`, `"`, -1), + strings.Replace( + strings.Replace(str, `\\`, "\u029e", -1), + `\"`, `"`, -1), `\n`, "\n", -1), - `\\`, "\\", -1), nil + "\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 84% rename from go/src/step2_eval/step2_eval.go rename to impls/go/src/step2_eval/step2_eval.go index 9517695613..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 { @@ -102,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 87% rename from go/src/step3_env/step3_env.go rename to impls/go/src/step3_env/step3_env.go index 2c0575c7ce..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 { @@ -164,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 }) @@ -195,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 ecacbe29ac..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 { 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 208ec7263e..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 { 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 1b78537c9a..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 { @@ -218,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 83% rename from go/src/step7_quote/step7_quote.go rename to impls/go/src/step7_quote/step7_quote.go index 42aab4d211..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 { @@ -163,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": @@ -253,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 85% rename from go/src/step8_macros/step8_macros.go rename to impls/go/src/step8_macros/step8_macros.go index 4b20938b92..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,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: + } + 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) } - return List{[]MalType{Symbol{"cons"}, - quasiquote(a0), - quasiquote(List{slc[1:], nil})}, nil} + default: + return ast } } @@ -120,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 { @@ -210,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!": @@ -309,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 86% rename from go/src/step9_try/step9_try.go rename to impls/go/src/step9_try/step9_try.go index 7902889e2a..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,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: + } + 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) } - return List{[]MalType{Symbol{"cons"}, - quasiquote(a0), - quasiquote(List{slc[1:], nil})}, nil} + default: + return ast } } @@ -120,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 { @@ -210,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!": @@ -337,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 80% rename from go/src/types/types.go rename to impls/go/src/types/types.go index 98aa654efd..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 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/go/tests/step5_tco.mal b/impls/go/tests/step5_tco.mal similarity index 100% rename from go/tests/step5_tco.mal rename to impls/go/tests/step5_tco.mal 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/groovy/GroovyWrapper.groovy b/impls/groovy/GroovyWrapper.groovy similarity index 100% rename from groovy/GroovyWrapper.groovy rename to impls/groovy/GroovyWrapper.groovy 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/groovy/core.groovy b/impls/groovy/core.groovy similarity index 93% rename from groovy/core.groovy rename to impls/groovy/core.groovy index 712cc08844..aaf05d4a58 100644 --- a/groovy/core.groovy +++ b/impls/groovy/core.groovy @@ -1,6 +1,7 @@ import types import types.MalException import types.MalSymbol +import types.MalFunc import reader import printer @@ -72,6 +73,10 @@ class core { "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, @@ -107,6 +112,7 @@ class core { "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) }, diff --git a/groovy/env.groovy b/impls/groovy/env.groovy similarity index 82% rename from groovy/env.groovy rename to impls/groovy/env.groovy index 8ff0e514b0..be3fabb5e0 100644 --- a/groovy/env.groovy +++ b/impls/groovy/env.groovy @@ -31,8 +31,8 @@ class env { data[key.value] = val } - def find(MalSymbol key) { - if (data.containsKey(key.value)) { + def find(String key) { + if (data.containsKey(key)) { this } else if (outer != null) { outer.find(key) @@ -41,12 +41,12 @@ class env { } } - def get(MalSymbol key) { + def get(String key) { def e = find(key) if (e == null) { - throw new MalException("'${key.value}' not found") + throw new MalException("'${key}' not found") } else { - e.data.get(key.value) + e.data.get(key) } } } diff --git a/groovy/printer.groovy b/impls/groovy/printer.groovy similarity index 100% rename from groovy/printer.groovy rename to impls/groovy/printer.groovy diff --git a/groovy/reader.groovy b/impls/groovy/reader.groovy similarity index 91% rename from groovy/reader.groovy rename to impls/groovy/reader.groovy index b47f357e50..40586adb52 100644 --- a/groovy/reader.groovy +++ b/impls/groovy/reader.groovy @@ -29,7 +29,7 @@ class reader { } def static tokenizer(String str) { - def m = str =~ /[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"|;.*|[^\s\[\]{}('"`,;)]*)/ + def m = str =~ /[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)]*)/ def tokens = [] while (m.find()) { String token = m.group(1) @@ -44,7 +44,7 @@ class reader { def static read_atom(Reader rdr) { def token = rdr.next() - def m = token =~ /(^-?[0-9]+$)|(^-?[0-9][0-9.]*$)|(^nil$)|(^true$)|(^false$)|^"(.*)"$|:(.*)|(^[^"]*$)/ + def m = token =~ /(^-?[0-9]+$)|(^-?[0-9][0-9.]*$)|(^nil$)|(^true$)|(^false$)|^"((?:\\.|[^\\"])*)"$|^"(.*)$|:(.*)|(^[^"]*$)/ if (!m.find()) { throw new MalException("unrecognized token '$token'") } @@ -57,11 +57,16 @@ class reader { } 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) { - "\u029e" + m.group(7) + throw new MalException("expected '\"', got EOF") } else if (m.group(8) != null) { - new MalSymbol(m.group(8)) + "\u029e" + m.group(8) + } else if (m.group(9) != null) { + new MalSymbol(m.group(9)) } else { throw new MalException("unrecognized '${m.group(0)}'") } 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/groovy/step0_repl.groovy b/impls/groovy/step0_repl.groovy similarity index 100% rename from groovy/step0_repl.groovy rename to impls/groovy/step0_repl.groovy diff --git a/groovy/step1_read_print.groovy b/impls/groovy/step1_read_print.groovy similarity index 90% rename from groovy/step1_read_print.groovy rename to impls/groovy/step1_read_print.groovy index f857c054ee..c9775a6a68 100644 --- a/groovy/step1_read_print.groovy +++ b/impls/groovy/step1_read_print.groovy @@ -30,7 +30,7 @@ while (true) { try { println REP(line) } catch(MalException ex) { - println "Error: ${ex.message}" + 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/groovy/step5_tco.groovy b/impls/groovy/step5_tco.groovy similarity index 77% rename from groovy/step5_tco.groovy rename to impls/groovy/step5_tco.groovy index 50f4673218..d83fcc4f90 100644 --- a/groovy/step5_tco.groovy +++ b/impls/groovy/step5_tco.groovy @@ -13,25 +13,30 @@ READ = { str -> } // EVAL -eval_ast = { ast, env -> +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); - case List: return types.vector_Q(ast) ? - types.vector(ast.collect { EVAL(it,env) }) : - ast.collect { EVAL(it,env) } + 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[EVAL(k, env)] = EVAL(v, env) + new_hm[k] = EVAL(v, env) } return new_hm default: return ast } -} -EVAL = { ast, env -> - while (true) { - //println("EVAL: ${printer.pr_str(ast,true)}") - if (! types.list_Q(ast)) return eval_ast(ast, env) if (ast.size() == 0) return ast switch (ast[0]) { @@ -46,7 +51,7 @@ EVAL = { ast, env -> ast = ast[2] break // TCO case { it instanceof MalSymbol && it.value == "do" }: - ast.size() > 2 ? eval_ast(ast[1..-2], env) : null + ast.size() > 2 ? ast[1..-2].collect { EVAL(it, env) } : null ast = ast[-1] break // TCO case { it instanceof MalSymbol && it.value == "if" }: @@ -65,7 +70,7 @@ EVAL = { ast, env -> case { it instanceof MalSymbol && it.value == "fn*" }: return new MalFunc(EVAL, ast[2], env, ast[1]) default: - def el = eval_ast(ast, env) + 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) @@ -106,7 +111,7 @@ while (true) { try { println REP(line) } catch(MalException ex) { - println "Error: ${ex.message}" + println "Error: ${printer.pr_str(ex.obj, true)}" } catch(StackOverflowError ex) { println "Error: ${ex}" } catch(ex) { diff --git a/groovy/step6_file.groovy b/impls/groovy/step6_file.groovy similarity index 79% rename from groovy/step6_file.groovy rename to impls/groovy/step6_file.groovy index 664a59af8c..a0536a80fa 100644 --- a/groovy/step6_file.groovy +++ b/impls/groovy/step6_file.groovy @@ -13,25 +13,30 @@ READ = { str -> } // EVAL -eval_ast = { ast, env -> +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); - case List: return types.vector_Q(ast) ? - types.vector(ast.collect { EVAL(it,env) }) : - ast.collect { EVAL(it,env) } + 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[EVAL(k, env)] = EVAL(v, env) + new_hm[k] = EVAL(v, env) } return new_hm default: return ast } -} -EVAL = { ast, env -> - while (true) { - //println("EVAL: ${printer.pr_str(ast,true)}") - if (! types.list_Q(ast)) return eval_ast(ast, env) if (ast.size() == 0) return ast switch (ast[0]) { @@ -46,7 +51,7 @@ EVAL = { ast, env -> ast = ast[2] break // TCO case { it instanceof MalSymbol && it.value == "do" }: - ast.size() > 2 ? eval_ast(ast[1..-2], env) : null + ast.size() > 2 ? ast[1..-2].collect { EVAL(it, env) } : null ast = ast[-1] break // TCO case { it instanceof MalSymbol && it.value == "if" }: @@ -65,7 +70,7 @@ EVAL = { ast, env -> case { it instanceof MalSymbol && it.value == "fn*" }: return new MalFunc(EVAL, ast[2], env, ast[1]) default: - def el = eval_ast(ast, env) + 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) @@ -98,7 +103,7 @@ 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) \")\")))))") +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) @@ -114,7 +119,7 @@ while (true) { try { println REP(line) } catch(MalException ex) { - println "Error: ${ex.message}" + println "Error: ${printer.pr_str(ex.obj, true)}" } catch(StackOverflowError ex) { println "Error: ${ex}" } catch(ex) { 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/guile/tests/step5_tco.mal b/impls/groovy/tests/step5_tco.mal similarity index 100% rename from guile/tests/step5_tco.mal rename to impls/groovy/tests/step5_tco.mal diff --git a/groovy/types.groovy b/impls/groovy/types.groovy similarity index 100% rename from groovy/types.groovy rename to impls/groovy/types.groovy diff --git a/impls/guile/Dockerfile b/impls/guile/Dockerfile new file mode 100644 index 0000000000..f8b8f0b7c4 --- /dev/null +++ b/impls/guile/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 +########################################################## + +# 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/guile/core.scm b/impls/guile/core.scm similarity index 97% rename from guile/core.scm rename to impls/guile/core.scm index f5b485eb13..4d86cc6de0 100644 --- a/guile/core.scm +++ b/impls/guile/core.scm @@ -19,6 +19,8 @@ (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) @@ -150,7 +152,7 @@ ((callable? c) (let ((cc (make-callable ht (callable-unbox c) - (and (hash-table? ht) (hash-ref ht "ismacro")) + #f (callable-closure c)))) cc)) (else @@ -188,8 +190,6 @@ #f str))) -(define (_not o) (or (_nil? o) (not o))) - (define (_true? x) (eq? x #t)) (define (_false? x) (eq? x #f)) @@ -218,7 +218,6 @@ (- ,-) (* ,*) (/ ,/) - (not ,_not) (pr-str ,pr-str) (str ,str) (prn ,prn) @@ -227,6 +226,7 @@ (slurp ,slurp) (cons ,_cons) (concat ,concat) + (vec ,vec) (nth ,_nth) (first ,_first) (rest ,_rest) @@ -235,6 +235,7 @@ (nil? ,_nil?) (true? ,_true?) (false? ,_false?) + (number? ,number?) (symbol? ,symbol?) (symbol ,->symbol) (string? ,_string?) @@ -251,6 +252,8 @@ (vals ,_vals) (contains? ,_contains?) (sequential? ,_sequential?) + (fn? ,is-func?) + (macro? ,is-macro?) (readline ,__readline) (meta ,_meta) (with-meta ,_with-meta) diff --git a/guile/env.scm b/impls/guile/env.scm similarity index 100% rename from guile/env.scm rename to impls/guile/env.scm diff --git a/guile/pcre.scm b/impls/guile/pcre.scm similarity index 100% rename from guile/pcre.scm rename to impls/guile/pcre.scm diff --git a/guile/printer.scm b/impls/guile/printer.scm similarity index 100% rename from guile/printer.scm rename to impls/guile/printer.scm diff --git a/guile/reader.scm b/impls/guile/reader.scm similarity index 90% rename from guile/reader.scm rename to impls/guile/reader.scm index c734759e03..0769e09a34 100644 --- a/guile/reader.scm +++ b/impls/guile/reader.scm @@ -31,6 +31,9 @@ (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))) @@ -38,7 +41,7 @@ (define (delim-read reader delim) (let lp((next (reader 'peek)) (ret '())) (cond - ((null? next) (throw 'mal-error (format #f "expected '~a'" delim))) + ((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)) @@ -78,21 +81,14 @@ (lp (cddr next))))))))) (define (read_atom reader) - (define (->str s) - (string-sub - (string-sub - (string-sub s "\\\\\"" "\"") - "\\\\n" "\n") - "\\\\\\\\" "\\")) (let ((token (reader 'next))) (cond ((string-match "^-?[0-9][0-9.]*$" token) => (lambda (m) (string->number (match:substring m 0)))) - ((string-match "^\"(.*)(.)$" token) - => (lambda (m) - (if (string=? "\"" (match:substring m 2)) - (->str (match:substring m 1)) - (throw 'mal-error "expected '\"'")))) + ((> (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) diff --git a/guile/readline.scm b/impls/guile/readline.scm similarity index 100% rename from guile/readline.scm rename to impls/guile/readline.scm 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/guile/types.scm b/impls/guile/types.scm similarity index 88% rename from guile/types.scm rename to impls/guile/types.scm index 90ab01c41c..1e51bc8bc6 100644 --- a/guile/types.scm +++ b/impls/guile/types.scm @@ -20,8 +20,8 @@ cond-true? make-anonymous-func make-atom atom? atom-val atom-val-set! make-callable callable? callable-is_macro - callable-is_macro-set! callable-closure - is-func? is-macro? make-func callable-apply + 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) @@ -77,8 +77,12 @@ (eq? (callable-is_macro c) b) c)) -(define (is-func? c) (callable-check c #f)) -(define (is-macro? c) (callable-check c #t)) +(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))) 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/haskell/tests/step5_tco.mal b/impls/haskell/tests/step5_tco.mal similarity index 100% rename from haskell/tests/step5_tco.mal rename to impls/haskell/tests/step5_tco.mal diff --git a/haxe/Compat.hx b/impls/haxe/Compat.hx similarity index 95% rename from haxe/Compat.hx rename to impls/haxe/Compat.hx index 7882a683d4..720593ac82 100644 --- a/haxe/Compat.hx +++ b/impls/haxe/Compat.hx @@ -57,10 +57,10 @@ class Compat { public static function readline(prompt:String) { #if js - var line = RL.readline("user> "); + var line = RL.readline(prompt); if (line == null) { throw new haxe.io.Eof(); } #else - Sys.print("user> "); + 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/haxe/Step0_repl.hx b/impls/haxe/Step0_repl.hx similarity index 93% rename from haxe/Step0_repl.hx rename to impls/haxe/Step0_repl.hx index 9f5dbcb749..d34806a8e3 100644 --- a/haxe/Step0_repl.hx +++ b/impls/haxe/Step0_repl.hx @@ -29,7 +29,7 @@ class Step0_repl { } catch (exc:haxe.io.Eof) { Compat.exit(0); } catch (exc:Dynamic) { - Compat.println(exc); + Compat.println("Error: " + exc); } } } diff --git a/haxe/Step1_read_print.hx b/impls/haxe/Step1_read_print.hx similarity index 95% rename from haxe/Step1_read_print.hx rename to impls/haxe/Step1_read_print.hx index 3be96f66c3..dd22fb95b2 100644 --- a/haxe/Step1_read_print.hx +++ b/impls/haxe/Step1_read_print.hx @@ -35,7 +35,7 @@ class Step1_read_print { } catch (exc:haxe.io.Eof) { Compat.exit(0); } catch (exc:Dynamic) { - Compat.println(exc); + 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/haxe/Step3_env.hx b/impls/haxe/Step3_env.hx similarity index 76% rename from haxe/Step3_env.hx rename to impls/haxe/Step3_env.hx index 805b984e6d..eec34d028f 100644 --- a/haxe/Step3_env.hx +++ b/impls/haxe/Step3_env.hx @@ -12,30 +12,30 @@ class Step3_env { } // EVAL - static function eval_ast(ast:MalType, env:Env) { - return switch (ast) { - case MalSymbol(s): env.get(ast); + 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): - MalList(l.map(function(x) { return EVAL(x, env); })); + alst = l; case MalVector(l): - MalVector(l.map(function(x) { return EVAL(x, env); })); + 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); } - MalHashMap(new_map); - case _: ast; + return MalHashMap(new_map); + case _: return ast; } - } - - static function EVAL(ast:MalType, env:Env):MalType { - if (!list_Q(ast)) { return eval_ast(ast, env); } - // apply - var alst = switch (ast) { case MalList(lst): lst; case _: []; } if (alst.length == 0) { return ast; } - switch (alst[0]) { case MalSymbol("def!"): return env.set(alst[1], EVAL(alst[2], env)); @@ -51,10 +51,10 @@ class Step3_env { } return EVAL(alst[2], let_env); case _: - var el = eval_ast(ast, env); - var lst = _list(el); - switch (first(el)) { - case MalFunc(f,_,_,_,_,_): return f(_list(el).slice(1)); + 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"; } } @@ -96,7 +96,7 @@ class Step3_env { } catch (exc:haxe.io.Eof) { Compat.exit(0); } catch (exc:Dynamic) { - Compat.println(exc); + 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/haxe/Step5_tco.hx b/impls/haxe/Step5_tco.hx similarity index 75% rename from haxe/Step5_tco.hx rename to impls/haxe/Step5_tco.hx index 190e3e8704..7176aca768 100644 --- a/haxe/Step5_tco.hx +++ b/impls/haxe/Step5_tco.hx @@ -1,6 +1,7 @@ import Compat; import types.Types.MalType; import types.Types.*; +import types.MalException; import reader.*; import printer.*; import env.*; @@ -13,31 +14,31 @@ class Step5_tco { } // EVAL - static function eval_ast(ast:MalType, env:Env) { - return switch (ast) { - case MalSymbol(s): env.get(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): - MalList(l.map(function(x) { return EVAL(x, env); })); + alst = l; case MalVector(l): - MalVector(l.map(function(x) { return EVAL(x, env); })); + 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); } - MalHashMap(new_map); - case _: ast; + return MalHashMap(new_map); + case _: return ast; } - } - - static function EVAL(ast:MalType, env:Env):MalType { - while (true) { - if (!list_Q(ast)) { return eval_ast(ast, env); } - // apply - var alst = _list(ast); if (alst.length == 0) { return ast; } - switch (alst[0]) { case MalSymbol("def!"): return env.set(alst[1], EVAL(alst[2], env)); @@ -55,8 +56,9 @@ class Step5_tco { env = let_env; continue; // TCO case MalSymbol("do"): - var el = eval_ast(MalList(alst.slice(1, alst.length-1)), env); - ast = last(ast); + 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); @@ -73,11 +75,9 @@ class Step5_tco { return EVAL(alst[2], new Env(env, _list(alst[1]), args)); },alst[2],env,alst[1],false,nil); case _: - var el = eval_ast(ast, env); - var lst = _list(el); - switch (first(el)) { + switch ( EVAL(alst[0], env)) { case MalFunc(f,a,e,params,_,_): - var args = _list(el).slice(1); + var args = alst.slice(1).map(function(x) { return EVAL(x, env); }); if (a != null) { ast = a; env = new Env(e, _list(params), args); @@ -122,7 +122,11 @@ class Step5_tco { } catch (exc:haxe.io.Eof) { Compat.exit(0); } catch (exc:Dynamic) { - Compat.println(exc); + if (Type.getClass(exc) == MalException) { + Compat.println("Error: " + Printer.pr_str(exc.obj, true)); + } else { + Compat.println("Error: " + exc); + }; } } } diff --git a/haxe/Step6_file.hx b/impls/haxe/Step6_file.hx similarity index 77% rename from haxe/Step6_file.hx rename to impls/haxe/Step6_file.hx index 93513a928f..fab62295c6 100644 --- a/haxe/Step6_file.hx +++ b/impls/haxe/Step6_file.hx @@ -1,6 +1,7 @@ import Compat; import types.Types.MalType; import types.Types.*; +import types.MalException; import reader.*; import printer.*; import env.*; @@ -13,31 +14,31 @@ class Step6_file { } // EVAL - static function eval_ast(ast:MalType, env:Env) { - return switch (ast) { - case MalSymbol(s): env.get(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): - MalList(l.map(function(x) { return EVAL(x, env); })); + alst = l; case MalVector(l): - MalVector(l.map(function(x) { return EVAL(x, env); })); + 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); } - MalHashMap(new_map); - case _: ast; + return MalHashMap(new_map); + case _: return ast; } - } - - static function EVAL(ast:MalType, env:Env):MalType { - while (true) { - if (!list_Q(ast)) { return eval_ast(ast, env); } - // apply - var alst = _list(ast); if (alst.length == 0) { return ast; } - switch (alst[0]) { case MalSymbol("def!"): return env.set(alst[1], EVAL(alst[2], env)); @@ -55,8 +56,9 @@ class Step6_file { env = let_env; continue; // TCO case MalSymbol("do"): - var el = eval_ast(MalList(alst.slice(1, alst.length-1)), env); - ast = last(ast); + 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); @@ -73,11 +75,9 @@ class Step6_file { return EVAL(alst[2], new Env(env, _list(alst[1]), args)); },alst[2],env,alst[1],false,nil); case _: - var el = eval_ast(ast, env); - var lst = _list(el); - switch (first(el)) { + switch ( EVAL(alst[0], env)) { case MalFunc(f,a,e,params,_,_): - var args = _list(el).slice(1); + var args = alst.slice(1).map(function(x) { return EVAL(x, env); }); if (a != null) { ast = a; env = new Env(e, _list(params), args); @@ -120,7 +120,7 @@ class 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 (cmdargs.length > 0) { rep('(load-file "${cmdargs[0]}")'); @@ -137,7 +137,11 @@ class Step6_file { } catch (exc:haxe.io.Eof) { Compat.exit(0); } catch (exc:Dynamic) { - Compat.println(exc); + 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/haxe/core/Core.hx b/impls/haxe/core/Core.hx similarity index 95% rename from haxe/core/Core.hx rename to impls/haxe/core/Core.hx index a990af97bd..99eae9b7d2 100644 --- a/haxe/core/Core.hx +++ b/impls/haxe/core/Core.hx @@ -140,6 +140,17 @@ class Core { 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)]: @@ -328,6 +339,9 @@ class Core { "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, @@ -363,6 +377,8 @@ class Core { "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]); }, 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(); var pos = 0; while (re.matchSub(str, pos)) { @@ -44,7 +44,8 @@ class Reader { static function read_atom(rdr:Reader) { var re_int = ~/^-?[0-9][0-9]*$/; - var re_str = ~/^".*"$/; + var re_str = ~/^"(?:\\.|[^\\"])*"$/; + var re_str_bad = ~/^".*$/; var token = rdr.next(); return switch (token) { case "nil": @@ -58,15 +59,22 @@ class Reader { case _ if (re_int.match(token)): MalInt(Std.parseInt(token)); case _ if (re_str.match(token)): - var re1 = ~/\\"/g, + var re1 = ~/\\\\/g, re2 = ~/\\n/g, - re3 = ~/\\\\/g, + re3 = ~/\\"/g, + re4 = ~/\x7f/g, s = token.substr(1, token.length-2); - MalString(re3.replace( - re2.replace( - re1.replace(s, "\""), - "\n"), - "\\")); + 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); } 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/haxe/types/MalException.hx b/impls/haxe/types/MalException.hx similarity index 100% rename from haxe/types/MalException.hx rename to impls/haxe/types/MalException.hx diff --git a/haxe/types/Types.hx b/impls/haxe/types/Types.hx similarity index 95% rename from haxe/types/Types.hx rename to impls/haxe/types/Types.hx index 5c25cce416..669e29b466 100644 --- a/haxe/types/Types.hx +++ b/impls/haxe/types/Types.hx @@ -73,6 +73,13 @@ class Types { } } + 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; @@ -124,6 +131,14 @@ class Types { } } + 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) { 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/haxe/tests/step5_tco.mal b/impls/hy/tests/step5_tco.mal similarity index 100% rename from haxe/tests/step5_tco.mal rename to impls/hy/tests/step5_tco.mal 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/io/Env.io b/impls/io/Env.io similarity index 100% rename from io/Env.io rename to impls/io/Env.io 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/io/MalCore.io b/impls/io/MalCore.io similarity index 91% rename from io/MalCore.io rename to impls/io/MalCore.io index 2a99470981..740e2c6187 100644 --- a/io/MalCore.io +++ b/impls/io/MalCore.io @@ -12,6 +12,13 @@ MalCore := Object clone do( 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)), @@ -83,6 +90,10 @@ MalCore := Object clone do( "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("")), @@ -118,6 +129,7 @@ MalCore := Object clone do( "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), diff --git a/io/MalReader.io b/impls/io/MalReader.io similarity index 85% rename from io/MalReader.io rename to impls/io/MalReader.io index 6192cb52fc..16cc3bd414 100644 --- a/io/MalReader.io +++ b/impls/io/MalReader.io @@ -16,7 +16,7 @@ MalReader := Object clone do ( ) ) - tokenizerRegex := Regex with("[\\s ,]*(~@|[\\[\\]{}()'`~@]|\"(?:[\\\\].|[^\\\\\"])*\"|;.*|[^\\s \\[\\]{}()'\"`~@,;]*)") + tokenizerRegex := Regex with("[\\s ,]*(~@|[\\[\\]{}()'`~@]|\"(?:[\\\\].|[^\\\\\"])*\"?|;.*|[^\\s \\[\\]{}()'\"`~@,;]*)") tokenize := method(str, tokenizerRegex matchesIn(str) \ @@ -26,9 +26,11 @@ MalReader := Object clone do ( ) numberRegex := Regex with("^-?[0-9]+$") + stringRegex := Regex with("^\"(?:[\\\\].|[^\\\\\"])*\"$") read_string := method(token, - token exSlice(1, -1) replaceSeq("\\\"", "\"") replaceSeq("\\n", "\n") replaceSeq("\\\\", "\\") + placeholder := 127 asCharacter + token exSlice(1, -1) replaceSeq("\\\\", placeholder) replaceSeq("\\\"", "\"") replaceSeq("\\n", "\n") replaceSeq(placeholder, "\\") ) read_atom := method(rdr, @@ -38,7 +40,8 @@ MalReader := Object clone do ( (token == "false") ifTrue(return(false)) (token == "nil") ifTrue(return(nil)) (token beginsWithSeq(":")) ifTrue(return(MalKeyword with(token exSlice(1)))) - (token beginsWithSeq("\"")) ifTrue(return(read_string(token))) + (token hasMatchOfRegex(stringRegex)) ifTrue(return(read_string(token))) + (token beginsWithSeq("\"")) ifTrue(Exception raise("expected '\"', got EOF")) MalSymbol with(token) ) diff --git a/io/MalReadline.io b/impls/io/MalReadline.io similarity index 100% rename from io/MalReadline.io rename to impls/io/MalReadline.io diff --git a/io/MalTypes.io b/impls/io/MalTypes.io similarity index 82% rename from io/MalTypes.io rename to impls/io/MalTypes.io index 975696339c..a5b7c0c644 100644 --- a/io/MalTypes.io +++ b/impls/io/MalTypes.io @@ -7,7 +7,9 @@ Number malPrint := method(readable, self asString) // Io strings are of type Sequence Sequence malPrint := method(readable, - if(readable, self asString asJson, self asString) + if(readable, + "\"" .. (self asString asMutable replaceSeq("\\", "\\\\") replaceSeq("\"", "\\\"") replaceSeq("\n", "\\n")) .. "\"", + self asString) ) MalMeta := Object clone do( @@ -16,20 +18,28 @@ MalMeta := Object clone do( MalSymbol := Object clone appendProto(MalMeta) do ( val ::= nil - with := method(str, self clone setVal(str)) + 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(str)) + 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 ( @@ -39,6 +49,7 @@ MalList := List clone appendProto(MalSequential) appendProto(MalMeta) do ( ) rest := method(MalList with(resend)) slice := method(MalList with(resend)) + == := method(other, equalSequence(other)) ) MalVector := List clone appendProto(MalSequential) appendProto(MalMeta) do ( @@ -48,6 +59,7 @@ MalVector := List clone appendProto(MalSequential) appendProto(MalMeta) do ( ) rest := method(MalList with(resend)) slice := method(MalList with(resend)) + == := method(other, equalSequence(other)) ) MalMap := Map clone appendProto(MalMeta) do ( @@ -109,7 +121,7 @@ MalFunc := Object clone appendProto(MalMeta) do ( call := method(args, blk call(args)) ) -MalAtom := Object clone do ( +MalAtom := Object clone appendProto(MalMeta) do ( val ::= nil with := method(str, self clone setVal(str)) malPrint := method(readable, "(atom " .. (val malPrint(true)) .. ")") 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/io/step0_repl.io b/impls/io/step0_repl.io similarity index 100% rename from io/step0_repl.io rename to impls/io/step0_repl.io diff --git a/io/step1_read_print.io b/impls/io/step1_read_print.io similarity index 100% rename from io/step1_read_print.io rename to impls/io/step1_read_print.io diff --git a/io/step2_eval.io b/impls/io/step2_eval.io similarity index 90% rename from io/step2_eval.io rename to impls/io/step2_eval.io index 7f60d134f1..3f43a124dd 100644 --- a/io/step2_eval.io +++ b/impls/io/step2_eval.io @@ -11,8 +11,7 @@ eval_ast := method(ast, env, "MalMap", m := MalMap clone ast foreach(k, v, - keyObj := MalMap keyToObj(k) - m atPut(MalMap objToKey(EVAL(keyObj, env)), EVAL(v, env)) + m atPut(k, EVAL(v, env)) ) m, ast @@ -20,6 +19,9 @@ eval_ast := method(ast, env, ) 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) diff --git a/io/step3_env.io b/impls/io/step3_env.io similarity index 87% rename from io/step3_env.io rename to impls/io/step3_env.io index c8d0c07dc4..2be8c67fa5 100644 --- a/io/step3_env.io +++ b/impls/io/step3_env.io @@ -11,15 +11,21 @@ eval_ast := method(ast, env, "MalMap", m := MalMap clone ast foreach(k, v, - keyObj := MalMap keyToObj(k) - m atPut(MalMap objToKey(EVAL(keyObj, env)), EVAL(v, env)) + 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", diff --git a/io/step4_if_fn_do.io b/impls/io/step4_if_fn_do.io similarity index 82% rename from io/step4_if_fn_do.io rename to impls/io/step4_if_fn_do.io index 9f1644d542..dbd37ce85d 100644 --- a/io/step4_if_fn_do.io +++ b/impls/io/step4_if_fn_do.io @@ -11,15 +11,21 @@ eval_ast := method(ast, env, "MalMap", m := MalMap clone ast foreach(k, v, - keyObj := MalMap keyToObj(k) - m atPut(MalMap objToKey(EVAL(keyObj, env)), EVAL(v, env)) + 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", @@ -70,6 +76,9 @@ loop( if(line isEmpty, continue) e := try(REP(line) println) e catch(Exception, - ("Error: " .. (e error)) println + if(e type == "MalException", + ("Error: " .. ((e val) malPrint(true))) println, + ("Error: " .. (e error)) println + ) ) ) diff --git a/io/step5_tco.io b/impls/io/step5_tco.io similarity index 85% rename from io/step5_tco.io rename to impls/io/step5_tco.io index 944bf6d716..ead709d186 100644 --- a/io/step5_tco.io +++ b/impls/io/step5_tco.io @@ -11,16 +11,22 @@ eval_ast := method(ast, env, "MalMap", m := MalMap clone ast foreach(k, v, - keyObj := MalMap keyToObj(k) - m atPut(MalMap objToKey(EVAL(keyObj, env)), EVAL(v, env)) + 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", @@ -85,6 +91,9 @@ loop( if(line isEmpty, continue) e := try(REP(line) println) e catch(Exception, - ("Error: " .. (e error)) println + if(e type == "MalException", + ("Error: " .. ((e val) malPrint(true))) println, + ("Error: " .. (e error)) println + ) ) ) diff --git a/io/step6_file.io b/impls/io/step6_file.io similarity index 86% rename from io/step6_file.io rename to impls/io/step6_file.io index cf985b7d7c..517b59aaa9 100644 --- a/io/step6_file.io +++ b/impls/io/step6_file.io @@ -11,16 +11,22 @@ eval_ast := method(ast, env, "MalMap", m := MalMap clone ast foreach(k, v, - keyObj := MalMap keyToObj(k) - m atPut(MalMap objToKey(EVAL(keyObj, env)), EVAL(v, env)) + 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", @@ -81,7 +87,7 @@ 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) \")\")))))") +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)) .. "\")") @@ -94,6 +100,9 @@ loop( if(line isEmpty, continue) e := try(REP(line) println) e catch(Exception, - ("Error: " .. (e error)) println + 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/io/tests/step5_tco.mal b/impls/io/tests/step5_tco.mal similarity index 100% rename from io/tests/step5_tco.mal rename to impls/io/tests/step5_tco.mal 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 98% rename from java/pom.xml rename to impls/java/pom.xml index 5ee5b7c73b..63621f87b5 100644 --- a/java/pom.xml +++ b/impls/java/pom.xml @@ -29,6 +29,7 @@ maven-compiler-plugin + 3.0 1.7 1.7 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 94% rename from java/src/main/java/mal/core.java rename to impls/java/src/main/java/mal/core.java index 3ac6cce292..977d5ab844 100644 --- a/java/src/main/java/mal/core.java +++ b/impls/java/src/main/java/mal/core.java @@ -49,6 +49,11 @@ 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; } @@ -87,6 +92,18 @@ public MalVal apply(MalList args) throws MalThrowable { 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 @@ -378,6 +395,12 @@ 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 { MalVal exp = a.nth(0); @@ -545,11 +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) @@ -584,6 +610,7 @@ 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) 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/java/src/main/java/mal/step0_repl.java b/impls/java/src/main/java/mal/step0_repl.java similarity index 100% rename from java/src/main/java/mal/step0_repl.java rename to impls/java/src/main/java/mal/step0_repl.java 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 100% rename from java/src/main/java/mal/types.java rename to impls/java/src/main/java/mal/types.java diff --git a/java/tests/step5_tco.mal b/impls/java/tests/step5_tco.mal similarity index 100% rename from java/tests/step5_tco.mal rename to impls/java/tests/step5_tco.mal 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/impls/js/core.js b/impls/js/core.js new file mode 100644 index 0000000000..2df84831aa --- /dev/null +++ b/impls/js/core.js @@ -0,0 +1,272 @@ +// Node vs browser behavior +var core = {}; +if (typeof module === 'undefined') { + var exports = core; +} else { + var types = require('./types'), + readline = require('./node_readline'), + reader = require('./reader'), + printer = require('./printer'), + interop = require('./interop'); +} + +// Errors/Exceptions +function mal_throw(exc) { throw exc; } + + +// String functions +function pr_str() { + return Array.prototype.map.call(arguments,function(exp) { + return printer._pr_str(exp, true); + }).join(" "); +} + +function str() { + return Array.prototype.map.call(arguments,function(exp) { + return printer._pr_str(exp, false); + }).join(""); +} + +function prn() { + printer.println.apply({}, Array.prototype.map.call(arguments,function(exp) { + return printer._pr_str(exp, true); + })); +} + +function println() { + printer.println.apply({}, Array.prototype.map.call(arguments,function(exp) { + return printer._pr_str(exp, false); + })); +} + +function slurp(f) { + if (typeof require !== 'undefined') { + return require('fs').readFileSync(f, 'utf-8'); + } else { + var req = new XMLHttpRequest(); + req.open("GET", f, false); + req.send(); + if (req.status == 200) { + return req.responseText; + } else { + throw new Error("Failed to slurp file: " + f); + } + } +} + + +// Number functions +function time_ms() { return new Date().getTime(); } + + +// Hash Map functions +function assoc(src_hm) { + var hm = types._clone(src_hm); + var args = [hm].concat(Array.prototype.slice.call(arguments, 1)); + return types._assoc_BANG.apply(null, args); +} + +function dissoc(src_hm) { + var hm = types._clone(src_hm); + var args = [hm].concat(Array.prototype.slice.call(arguments, 1)); + return types._dissoc_BANG.apply(null, args); +} + +function get(hm, key) { + if (hm != null && key in hm) { + return hm[key]; + } else { + return null; + } +} + +function contains_Q(hm, key) { + if (key in hm) { return true; } else { return false; } +} + +function keys(hm) { return Object.keys(hm); } +function vals(hm) { return Object.keys(hm).map(function(k) { return hm[k]; }); } + + +// Sequence functions +function cons(a, b) { return [a].concat(b); } + +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 === null) ? null : lst[0]; } + +function rest(lst) { return (lst == null) ? [] : lst.slice(1); } + +function empty_Q(lst) { return lst.length === 0; } + +function count(s) { + if (Array.isArray(s)) { return s.length; } + else if (s === null) { return 0; } + else { return Object.keys(s).length; } +} + +function conj(lst) { + if (types._list_Q(lst)) { + return Array.prototype.slice.call(arguments, 1).reverse().concat(lst); + } else { + var v = lst.concat(Array.prototype.slice.call(arguments, 1)); + v.__isvector__ = true; + return v; + } +} + +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])); +} + +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, + 'vec': vec, + '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; 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/impls/js/step1_read_print.js b/impls/js/step1_read_print.js new file mode 100644 index 0000000000..d712a2f2bd --- /dev/null +++ b/impls/js/step1_read_print.js @@ -0,0 +1,41 @@ +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) { + return ast; +} + +// print +function PRINT(exp) { + return printer._pr_str(exp, true); +} + +// repl +var re = function(str) { return EVAL(READ(str), {}); }; +var rep = function(str) { return PRINT(EVAL(READ(str), {})); }; + +// 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/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/js/tests/step5_tco.mal b/impls/js/tests/step5_tco.mal similarity index 100% rename from js/tests/step5_tco.mal rename to impls/js/tests/step5_tco.mal 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/impls/js/types.js b/impls/js/types.js new file mode 100644 index 0000000000..0fb324e711 --- /dev/null +++ b/impls/js/types.js @@ -0,0 +1,230 @@ +// 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 (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),""), @@ -114,6 +117,7 @@ ns = Dict{Any,Any}( 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]...], diff --git a/julia/env.jl b/impls/julia/env.jl similarity index 100% rename from julia/env.jl rename to impls/julia/env.jl diff --git a/julia/printer.jl b/impls/julia/printer.jl similarity index 100% rename from julia/printer.jl rename to impls/julia/printer.jl diff --git a/julia/reader.jl b/impls/julia/reader.jl similarity index 85% rename from julia/reader.jl rename to impls/julia/reader.jl index 487dfe8211..2a46cc4f57 100644 --- a/julia/reader.jl +++ b/impls/julia/reader.jl @@ -26,7 +26,7 @@ end function tokenize(str) - re = r"[\s,]*(~@|[\[\]{}()'`~^@]|\"(?:\\.|[^\\\"])*\"|;.*|[^\s\[\]{}('\"`,;)]*)" + re = r"[\s,]*(~@|[\[\]{}()'`~^@]|\"(?:\\.|[^\\\"])*\"?|;.*|[^\s\[\]{}('\"`,;)]*)" tokens = map((m) -> m.captures[1], eachmatch(re, str)) filter((t) -> t != "" && t[1] != ';', tokens) end @@ -37,13 +37,12 @@ function read_atom(rdr) parse(Int,token) elseif ismatch(r"^-?[0-9][0-9.]*$", token) float(token) - elseif ismatch(r"^\".*\"$", token) - replace( - replace( - replace(token[2:end-1], - "\\\"", "\""), - "\\n", "\n"), - "\\\\", "\\") + 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" diff --git a/julia/readline_mod.jl b/impls/julia/readline_mod.jl similarity index 100% rename from julia/readline_mod.jl rename to impls/julia/readline_mod.jl 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/julia/step0_repl.jl b/impls/julia/step0_repl.jl similarity index 100% rename from julia/step0_repl.jl rename to impls/julia/step0_repl.jl diff --git a/julia/step1_read_print.jl b/impls/julia/step1_read_print.jl similarity index 100% rename from julia/step1_read_print.jl rename to impls/julia/step1_read_print.jl diff --git a/julia/step2_eval.jl b/impls/julia/step2_eval.jl similarity index 77% rename from julia/step2_eval.jl rename to impls/julia/step2_eval.jl index f685e730d9..b64ca9e17c 100755 --- a/julia/step2_eval.jl +++ b/impls/julia/step2_eval.jl @@ -11,24 +11,23 @@ function READ(str) end # EVAL -function eval_ast(ast, env) +function EVAL(ast, env) + # println("EVAL: $(printer.pr_str(ast,true))") + if typeof(ast) == Symbol - env[ast] - elseif isa(ast, Array) || isa(ast, Tuple) - map((x) -> EVAL(x,env), ast) + return env[ast] + elseif isa(ast, Tuple) + return map((x) -> EVAL(x,env), ast) elseif isa(ast, Dict) - [EVAL(x[1],env) => EVAL(x[2], env) for x=ast] - else - ast + return [x[1] => EVAL(x[2], env) for x=ast] + elseif !isa(ast, Array) + return ast end -end -function EVAL(ast, env) - if !isa(ast, Array) return eval_ast(ast, env) end if isempty(ast) return ast end # apply - el = eval_ast(ast, env) + el = map((x) -> EVAL(x,env), ast) f, args = el[1], el[2:end] f(args...) 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/julia/step4_if_fn_do.jl b/impls/julia/step4_if_fn_do.jl similarity index 77% rename from julia/step4_if_fn_do.jl rename to impls/julia/step4_if_fn_do.jl index 0e33713e31..70334f4337 100755 --- a/julia/step4_if_fn_do.jl +++ b/impls/julia/step4_if_fn_do.jl @@ -13,20 +13,25 @@ function READ(str) end # EVAL -function eval_ast(ast, env) +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 - env_get(env,ast) - elseif isa(ast, Array) || isa(ast, Tuple) - map((x) -> EVAL(x,env), ast) + return env_get(env,ast) + elseif isa(ast, Tuple) + return map((x) -> EVAL(x,env), ast) elseif isa(ast, Dict) - [EVAL(x[1],env) => EVAL(x[2], env) for x=ast] - else - ast + return [x[1] => EVAL(x[2], env) for x=ast] + elseif !isa(ast, Array) + return ast end -end -function EVAL(ast, env) - if !isa(ast, Array) return eval_ast(ast, env) end if isempty(ast) return ast end # apply @@ -39,7 +44,7 @@ function EVAL(ast, env) end EVAL(ast[3], let_env) elseif :do == ast[1] - eval_ast(ast[2:end], env)[end] + map((x) -> EVAL(x,env), ast[2:end])[end] elseif :if == ast[1] cond = EVAL(ast[2], env) if cond === nothing || cond === false @@ -54,7 +59,7 @@ function EVAL(ast, env) elseif symbol("fn*") == ast[1] (args...) -> EVAL(ast[3], Env(env, ast[2], Any[args...])) else - el = eval_ast(ast, env) + el = map((x) -> EVAL(x,env), ast) f, args = el[1], el[2:end] f(args...) end diff --git a/julia/step5_tco.jl b/impls/julia/step5_tco.jl similarity index 80% rename from julia/step5_tco.jl rename to impls/julia/step5_tco.jl index 6869048cda..08ed0659cf 100755 --- a/julia/step5_tco.jl +++ b/impls/julia/step5_tco.jl @@ -14,22 +14,27 @@ function READ(str) end # EVAL -function eval_ast(ast, env) +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 - env_get(env,ast) - elseif isa(ast, Array) || isa(ast, Tuple) - map((x) -> EVAL(x,env), ast) + return env_get(env,ast) + elseif isa(ast, Tuple) + return map((x) -> EVAL(x,env), ast) elseif isa(ast, Dict) - [EVAL(x[1],env) => EVAL(x[2], env) for x=ast] - else - ast + return [x[1] => EVAL(x[2], env) for x=ast] + elseif !isa(ast, Array) + return ast end -end -function EVAL(ast, env) - while true - #println("EVAL: $(printer.pr_str(ast,true))") - if !isa(ast, Array) return eval_ast(ast, env) end if isempty(ast) return ast end # apply @@ -44,7 +49,7 @@ function EVAL(ast, env) ast = ast[3] # TCO loop elseif :do == ast[1] - eval_ast(ast[2:end-1], env) + map((x) -> EVAL(x,env), ast[2:end-1]) ast = ast[end] # TCO loop elseif :if == ast[1] @@ -65,7 +70,7 @@ function EVAL(ast, env) (args...) -> EVAL(ast[3], Env(env, ast[2], Any[args...])), ast[3], env, ast[2]) else - el = eval_ast(ast, env) + el = map((x) -> EVAL(x,env), ast) f, args = el[1], el[2:end] if isa(f, MalFunc) ast = f.ast diff --git a/julia/step6_file.jl b/impls/julia/step6_file.jl similarity index 81% rename from julia/step6_file.jl rename to impls/julia/step6_file.jl index 83246ffba8..0c39d0516e 100755 --- a/julia/step6_file.jl +++ b/impls/julia/step6_file.jl @@ -14,22 +14,27 @@ function READ(str) end # EVAL -function eval_ast(ast, env) +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 - env_get(env,ast) - elseif isa(ast, Array) || isa(ast, Tuple) - map((x) -> EVAL(x,env), ast) + return env_get(env,ast) + elseif isa(ast, Tuple) + return map((x) -> EVAL(x,env), ast) elseif isa(ast, Dict) - [EVAL(x[1],env) => EVAL(x[2], env) for x=ast] - else - ast + return [x[1] => EVAL(x[2], env) for x=ast] + elseif !isa(ast, Array) + return ast end -end -function EVAL(ast, env) - while true - #println("EVAL: $(printer.pr_str(ast,true))") - if !isa(ast, Array) return eval_ast(ast, env) end if isempty(ast) return ast end # apply @@ -44,7 +49,7 @@ function EVAL(ast, env) ast = ast[3] # TCO loop elseif :do == ast[1] - eval_ast(ast[2:end-1], env) + map((x) -> EVAL(x,env), ast[2:end-1]) ast = ast[end] # TCO loop elseif :if == ast[1] @@ -65,7 +70,7 @@ function EVAL(ast, env) (args...) -> EVAL(ast[3], Env(env, ast[2], Any[args...])), ast[3], env, ast[2]) else - el = eval_ast(ast, env) + el = map((x) -> EVAL(x,env), ast) f, args = el[1], el[2:end] if isa(f, MalFunc) ast = f.ast @@ -96,7 +101,7 @@ 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) \")\")))))") +REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") if length(ARGS) > 0 REP("(load-file \"$(ARGS[1])\")") 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/julia/types.jl b/impls/julia/types.jl similarity index 100% rename from julia/types.jl rename to impls/julia/types.jl 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/kotlin/src/mal/core.kt b/impls/kotlin/src/mal/core.kt similarity index 95% rename from kotlin/src/mal/core.kt rename to impls/kotlin/src/mal/core.kt index addacd8d06..e14b41502e 100644 --- a/kotlin/src/mal/core.kt +++ b/impls/kotlin/src/mal/core.kt @@ -54,7 +54,10 @@ val ns = hashMapOf( 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") @@ -117,6 +120,10 @@ val ns = hashMapOf( 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 }), diff --git a/kotlin/src/mal/env.kt b/impls/kotlin/src/mal/env.kt similarity index 84% rename from kotlin/src/mal/env.kt rename to impls/kotlin/src/mal/env.kt index fa7b599124..b95fba2a49 100644 --- a/kotlin/src/mal/env.kt +++ b/impls/kotlin/src/mal/env.kt @@ -30,7 +30,5 @@ class Env(val outer: Env?, binds: Sequence?, exprs: Sequence return value } - fun find(key: MalSymbol): MalType? = data[key.value] ?: outer?.find(key) - - fun get(key: MalSymbol): MalType = find(key) ?: throw MalException("'${key.value}' not found") + fun get(key: String): MalType? = data[key] ?: outer?.get(key) } diff --git a/kotlin/src/mal/printer.kt b/impls/kotlin/src/mal/printer.kt similarity index 100% rename from kotlin/src/mal/printer.kt rename to impls/kotlin/src/mal/printer.kt diff --git a/kotlin/src/mal/reader.kt b/impls/kotlin/src/mal/reader.kt similarity index 89% rename from kotlin/src/mal/reader.kt rename to impls/kotlin/src/mal/reader.kt index 2adddcbeb0..0d03f4aa02 100644 --- a/kotlin/src/mal/reader.kt +++ b/impls/kotlin/src/mal/reader.kt @@ -2,8 +2,8 @@ package mal import kotlin.text.Regex -val TOKEN_REGEX = Regex("[\\s,]*(~@|[\\[\\]{}()'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"|;.*|[^\\s\\[\\]{}('\"`,;)]*)") -val ATOM_REGEX = Regex("(^-?[0-9]+$)|(^nil$)|(^true$)|(^false$)|^\"(.*)\"$|:(.*)|(^[^\"]*$)") +val TOKEN_REGEX = Regex("[\\s,]*(~@|[\\[\\]{}()'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"?|;.*|[^\\s\\[\\]{}('\"`,;)]*)") +val ATOM_REGEX = Regex("(^-?[0-9]+$)|(^nil$)|(^true$)|(^false$)|^\"((?:\\\\.|[^\\\\\"])*)\"$|^\"(.*)$|:(.*)|(^[^\"]*$)") class Reader(sequence: Sequence) { val tokens = sequence.iterator() @@ -139,11 +139,17 @@ fun read_atom(reader: Reader): MalType { } else if (groups[4]?.value != null) { FALSE } else if (groups[5]?.value != null) { - MalString((groups[5]?.value as String).replace("\\n", "\n").replace("\\\"", "\"").replace("\\\\", "\\")) + 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) { - MalKeyword(groups[6]?.value as String) + throw MalReaderException("expected '\"', got EOF") } else if (groups[7]?.value != null) { - MalSymbol(groups[7]?.value as String) + 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/kotlin/src/mal/readline.kt b/impls/kotlin/src/mal/readline.kt similarity index 100% rename from kotlin/src/mal/readline.kt rename to impls/kotlin/src/mal/readline.kt diff --git a/kotlin/src/mal/step0_repl.kt b/impls/kotlin/src/mal/step0_repl.kt similarity index 100% rename from kotlin/src/mal/step0_repl.kt rename to impls/kotlin/src/mal/step0_repl.kt diff --git a/kotlin/src/mal/step1_read_print.kt b/impls/kotlin/src/mal/step1_read_print.kt similarity index 100% rename from kotlin/src/mal/step1_read_print.kt rename to impls/kotlin/src/mal/step1_read_print.kt 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/kotlin/src/mal/step5_tco.kt b/impls/kotlin/src/mal/step5_tco.kt similarity index 79% rename from kotlin/src/mal/step5_tco.kt rename to impls/kotlin/src/mal/step5_tco.kt index cfc750f387..ff8ff72545 100644 --- a/kotlin/src/mal/step5_tco.kt +++ b/impls/kotlin/src/mal/step5_tco.kt @@ -7,7 +7,14 @@ fun eval(_ast: MalType, _env: Env): MalType { var env = _env while (true) { - if (ast is MalList) { + + 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)) @@ -27,7 +34,9 @@ fun eval(_ast: MalType, _env: Env): MalType { } "fn*" -> return fn_STAR(ast, env) "do" -> { - eval_ast(ast.slice(1, ast.count() - 1), env) + for (i in 1..ast.count() - 2) { + eval(ast.nth(i), env) + } ast = ast.seq().last() } "if" -> { @@ -40,7 +49,7 @@ fun eval(_ast: MalType, _env: Env): MalType { } else return NIL } else -> { - val evaluated = eval_ast(ast, env) as ISeq + val evaluated = ast.elements.fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) val firstEval = evaluated.first() when (firstEval) { @@ -53,19 +62,15 @@ fun eval(_ast: MalType, _env: Env): MalType { } } } - } else return eval_ast(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 + } } } -fun eval_ast(ast: MalType, env: Env): MalType = - when (ast) { - is MalSymbol -> env.get(ast) - is MalList -> ast.elements.fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) - is MalVector -> ast.elements.fold(MalVector(), { a, b -> a.conj_BANG(eval(b, env)); a }) - is MalHashMap -> ast.elements.entries.fold(MalHashMap(), { a, b -> a.assoc_BANG(b.key, eval(b.value, env)); a }) - else -> 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() diff --git a/kotlin/src/mal/step6_file.kt b/impls/kotlin/src/mal/step6_file.kt similarity index 80% rename from kotlin/src/mal/step6_file.kt rename to impls/kotlin/src/mal/step6_file.kt index bbb24a0799..b049c9ad6d 100644 --- a/kotlin/src/mal/step6_file.kt +++ b/impls/kotlin/src/mal/step6_file.kt @@ -9,7 +9,14 @@ fun eval(_ast: MalType, _env: Env): MalType { var env = _env while (true) { - if (ast is MalList) { + + 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)) @@ -29,7 +36,9 @@ fun eval(_ast: MalType, _env: Env): MalType { } "fn*" -> return fn_STAR(ast, env) "do" -> { - eval_ast(ast.slice(1, ast.count() - 1), env) + for (i in 1..ast.count() - 2) { + eval(ast.nth(i), env) + } ast = ast.seq().last() } "if" -> { @@ -42,7 +51,7 @@ fun eval(_ast: MalType, _env: Env): MalType { } else return NIL } else -> { - val evaluated = eval_ast(ast, env) as ISeq + val evaluated = ast.elements.fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) val firstEval = evaluated.first() when (firstEval) { @@ -55,19 +64,15 @@ fun eval(_ast: MalType, _env: Env): MalType { } } } - } else return eval_ast(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 + } } } -fun eval_ast(ast: MalType, env: Env): MalType = - when (ast) { - is MalSymbol -> env.get(ast) - is MalList -> ast.elements.fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) - is MalVector -> ast.elements.fold(MalVector(), { a, b -> a.conj_BANG(eval(b, env)); a }) - is MalHashMap -> ast.elements.entries.fold(MalHashMap(), { a, b -> a.assoc_BANG(b.key, eval(b.value, env)); a }) - else -> 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() @@ -89,7 +94,7 @@ fun main(args: Array) { 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) \")\")))))", 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) 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/kotlin/src/mal/types.kt b/impls/kotlin/src/mal/types.kt similarity index 100% rename from kotlin/src/mal/types.kt rename to impls/kotlin/src/mal/types.kt diff --git a/julia/tests/step5_tco.mal b/impls/kotlin/tests/step5_tco.mal similarity index 100% rename from julia/tests/step5_tco.mal rename to impls/kotlin/tests/step5_tco.mal 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/lua/core.lua b/impls/lua/core.lua similarity index 82% rename from lua/core.lua rename to impls/lua/core.lua index 3376b09dce..0fa324bf4c 100644 --- a/lua/core.lua +++ b/impls/lua/core.lua @@ -3,7 +3,6 @@ local types = require('types') local reader = require('reader') local printer = require('printer') local readline = require('readline') -local socket = require('socket') local Nil, List, HashMap, _pr_str = types.Nil, types.List, types.HashMap, printer._pr_str @@ -12,25 +11,21 @@ local M = {} -- string functions function pr_str(...) - return table.concat( - utils.map(function(e) return _pr_str(e, true) end, arg), " ") + return printer._pr_seq(table.pack(...), true, " ") end function str(...) - return table.concat( - utils.map(function(e) return _pr_str(e, false) end, arg), "") + return printer._pr_seq(table.pack(...), false, "") end function prn(...) - print(table.concat( - utils.map(function(e) return _pr_str(e, true) end, arg), " ")) + print(printer._pr_seq(table.pack(...), true, " ")) io.flush() return Nil end function println(...) - print(table.concat( - utils.map(function(e) return _pr_str(e, false) end, arg), " ")) + print(printer._pr_seq(table.pack(...), false, " ")) io.flush() return Nil end @@ -55,11 +50,11 @@ end -- hash map functions function assoc(hm, ...) - return types._assoc_BANG(types.copy(hm), unpack(arg)) + return types._assoc_BANG(types.copy(hm), ...) end function dissoc(hm, ...) - return types._dissoc_BANG(types.copy(hm), unpack(arg)) + return types._dissoc_BANG(types.copy(hm), ...) end function get(hm, key) @@ -93,6 +88,7 @@ function cons(a,lst) end function concat(...) + local arg = table.pack(...) local new_lst = {} for i = 1, #arg do for j = 1, #arg[i] do @@ -102,6 +98,10 @@ function concat(...) 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] @@ -127,12 +127,13 @@ function rest(a) 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(unpack(args)) + return f(table.unpack(args)) end function map(f, lst) @@ -162,13 +163,14 @@ function swap_BANG(atm,f,...) if types._malfunc_Q(f) then f = f.fn end - local args = List:new(arg) + local args = List:new(table.pack(...)) table.insert(args, 1, atm.val) - atm.val = f(unpack(args)) + 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 @@ -226,7 +228,7 @@ local function lua_to_mal(a) end local function lua_eval(str) - local f, err = loadstring("return "..str) + local f, err = load("return "..str) if err then types.throw("lua-eval: can't load code: "..err) end @@ -240,11 +242,20 @@ M.ns = { ['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) and "\177" ~= string.sub(a,1,1) end, - keyword = function(a) return "\177"..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, @@ -262,11 +273,11 @@ M.ns = { ['-'] = 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(socket.gettime() * 1000) end, + ['time-ms'] = function() return math.floor(os.clock()*1000000) end, - list = function(...) return List:new(arg) end, + list = function(...) return List:new(table.pack(...)) end, ['list?'] = function(a) return types._list_Q(a) end, - vector = function(...) return types.Vector:new(arg) end, + vector = function(...) return types.Vector:new(table.pack(...)) end, ['vector?'] = types._vector_Q, ['hash-map'] = types.hash_map, ['map?'] = types._hash_map_Q, @@ -280,6 +291,7 @@ M.ns = { ['sequential?'] = types._sequential_Q, cons = cons, concat = concat, + vec = vec, nth = nth, first = first, rest = rest, 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 ee0a61e6d7..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,17 +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, '\\\\', '\\') + 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 @@ -83,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/lua/readline.lua b/impls/lua/readline.lua similarity index 100% rename from lua/readline.lua rename to impls/lua/readline.lua 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 100% rename from lua/step0_repl.lua rename to impls/lua/step0_repl.lua 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 78% rename from lua/step2_eval.lua rename to impls/lua/step2_eval.lua index 0b095f2ce2..0bb44d2a26 100755 --- a/lua/step2_eval.lua +++ b/impls/lua/step2_eval.lua @@ -15,34 +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 - if #ast == 0 then return ast 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/lua/types.lua b/impls/lua/types.lua similarity index 83% rename from lua/types.lua rename to impls/lua/types.lua index 0155451247..9ee00e4950 100644 --- a/lua/types.lua +++ b/impls/lua/types.lua @@ -94,9 +94,14 @@ 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" + return type(obj) == "string" and "\u{029e}" ~= string.sub(obj,1,2) end -- Symbols @@ -112,8 +117,20 @@ function M._symbol_Q(obj) 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 M._string_Q(obj) and "\177" == string.sub(obj,1,1) + 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 @@ -156,18 +173,20 @@ function M.HashMap:new(val) return setmetatable(newObj, self) end function M.hash_map(...) - return M._assoc_BANG(M.HashMap:new(), unpack(arg)) + 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 @@ -186,6 +205,12 @@ 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 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/make/numbers.mk b/impls/make/numbers.mk similarity index 99% rename from make/numbers.mk rename to impls/make/numbers.mk index 6d35bbbc34..ad87b77d78 100644 --- a/make/numbers.mk +++ b/impls/make/numbers.mk @@ -22,7 +22,7 @@ int_encode = $(strip $(call _reverse,\ $(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)))) +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))) 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 100% rename from matlab/+types/Function.m rename to impls/matlab/+types/Function.m diff --git a/matlab/+types/HashMap.m b/impls/matlab/+types/HashMap.m similarity index 100% rename from matlab/+types/HashMap.m rename to impls/matlab/+types/HashMap.m diff --git a/matlab/+types/List.m b/impls/matlab/+types/List.m similarity index 100% rename from matlab/+types/List.m rename to impls/matlab/+types/List.m 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 100% rename from matlab/+types/Vector.m rename to impls/matlab/+types/Vector.m diff --git a/matlab/.dockerignore b/impls/matlab/.dockerignore similarity index 100% rename from matlab/.dockerignore rename to impls/matlab/.dockerignore diff --git a/matlab/Dict.m b/impls/matlab/Dict.m similarity index 100% rename from matlab/Dict.m rename to impls/matlab/Dict.m 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/matlab/printer.m b/impls/matlab/printer.m similarity index 100% rename from matlab/printer.m rename to impls/matlab/printer.m 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/matlab/step1_read_print.m b/impls/matlab/step1_read_print.m similarity index 100% rename from matlab/step1_read_print.m rename to impls/matlab/step1_read_print.m 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/matlab/type_utils.m b/impls/matlab/type_utils.m similarity index 88% rename from matlab/type_utils.m rename to impls/matlab/type_utils.m index 8a4ce210ad..939df5260e 100644 --- a/matlab/type_utils.m +++ b/impls/matlab/type_utils.m @@ -74,6 +74,19 @@ 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); 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/miniMAL/core.json b/impls/miniMAL/core.json similarity index 88% rename from miniMAL/core.json rename to impls/miniMAL/core.json index 6ddb7434a6..3ad9bd0926 100644 --- a/miniMAL/core.json +++ b/impls/miniMAL/core.json @@ -10,6 +10,12 @@ ["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", [], @@ -27,7 +33,7 @@ "hm"]]]], ["def", "_get", ["fn", ["obj", "key"], - ["if", ["nil?", "obj"], + ["if", ["null?", "obj"], null, ["if", ["contains?", "obj", "key"], ["get", "obj", "key"], @@ -77,7 +83,7 @@ ["if", [">", ["count", "obj"], 0], [".", "obj", ["`", "split"], ["`", ""]], null], - ["if", ["nil?", "obj"], + ["if", ["null?", "obj"], null, ["throw", "seq: called on non-sequence"] ]]]]]], @@ -98,7 +104,7 @@ null]]], ["def", "reset!", ["fn", ["atm", "val"], - ["set", "atm", ["`", "val"], "val"]]], + ["do", ["set", "atm", ["`", "val"], "val"], "val"]]], ["def", "swap!", ["fn", ["atm", "f", "&", "args"], ["let", ["fn", ["if", ["malfunc?", "f"], ["get", "f", ["`", "fn"]], "f"], @@ -113,7 +119,7 @@ ["`", "="], "equal?", ["`", "throw"], "throw", - ["`", "nil?"], "nil?", + ["`", "nil?"], "null?", ["`", "true?"], "true?", ["`", "false?"], "false?", ["`", "string?"], "_string?", @@ -121,6 +127,14 @@ ["`", "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, ["`", ""]]], @@ -163,6 +177,7 @@ ["`", "sequential?"], "sequential?", ["`", "cons"], "cons", ["`", "concat"], "concat", + ["`", "vec"], "vectorl", ["`", "nth"], "_nth", ["`", "first"], "_first", ["`", "rest"], "_rest", 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/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/miniMAL/tests/step5_tco.mal b/impls/miniMAL/tests/step5_tco.mal similarity index 100% rename from miniMAL/tests/step5_tco.mal rename to impls/miniMAL/tests/step5_tco.mal diff --git a/miniMAL/types.json b/impls/miniMAL/types.json similarity index 98% rename from miniMAL/types.json rename to impls/miniMAL/types.json index a9a0d7f011..3d3e22d7bb 100644 --- a/miniMAL/types.json +++ b/impls/miniMAL/types.json @@ -91,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 92% rename from nim/core.nim rename to impls/nim/core.nim index 52c4d8854c..0393ef6ba6 100644 --- a/nim/core.nim +++ b/impls/nim/core.nim @@ -1,6 +1,6 @@ -import strutils, rdstdin, tables, algorithm, times, sequtils, 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 @@ -37,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") @@ -125,7 +130,7 @@ proc seq(xs: varargs[MalType]): MalType = 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.copy(i,i)) + result.list.add(str xs[0].str.substr(i,i)) elif xs[0] == nilObj: result = nilObj else: @@ -157,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 @@ -204,6 +209,7 @@ let ns* = { "sequential?": fun seq_q, "cons": fun cons, "concat": fun concat, + "vec": fun vec, "count": fun count, "nth": fun nth, "first": fun first, @@ -224,6 +230,9 @@ let ns* = { "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 100% rename from nim/mal.nimble rename to impls/nim/mal.nimble diff --git a/nim/nim.cfg b/impls/nim/nim.cfg similarity index 100% rename from nim/nim.cfg rename to impls/nim/nim.cfg diff --git a/nim/printer.nim b/impls/nim/printer.nim similarity index 84% rename from nim/printer.nim rename to impls/nim/printer.nim index 5aab6f25e8..e6edf9cc84 100644 --- a/nim/printer.nim +++ b/impls/nim/printer.nim @@ -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/nim/tests/step5_tco.mal b/impls/nim/tests/step5_tco.mal similarity index 100% rename from nim/tests/step5_tco.mal rename to impls/nim/tests/step5_tco.mal diff --git a/nim/types.nim b/impls/nim/types.nim similarity index 87% rename from nim/types.nim rename to impls/nim/types.nim index aeae5ea320..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") @@ -110,7 +110,7 @@ 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[0] != '\xff') + 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) @@ -119,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/objc/core.h b/impls/objc/core.h similarity index 100% rename from objc/core.h rename to impls/objc/core.h 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/objc/env.h b/impls/objc/env.h similarity index 100% rename from objc/env.h rename to impls/objc/env.h diff --git a/objc/env.m b/impls/objc/env.m similarity index 80% rename from objc/env.m rename to impls/objc/env.m index 3acf102035..4dde577a9e 100644 --- a/objc/env.m +++ b/impls/objc/env.m @@ -52,23 +52,14 @@ - (NSObject *) set:(MalSymbol *)key val:(NSObject *)val { return val; } -- (Env *) find:(MalSymbol *)key { - if (_data[key]) { - return self; - } else if (_outer) { - Env * e = _outer; - return [e find:key]; - } else { - return nil; - } -} - - (NSObject *) get:(MalSymbol *)key { - Env * e = [self find:key]; - if (e) { - return e.data[key]; - } else { - @throw [NSString stringWithFormat:@"'%@' not found", 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; } } diff --git a/objc/mal_readline.c b/impls/objc/mal_readline.c similarity index 100% rename from objc/mal_readline.c rename to impls/objc/mal_readline.c diff --git a/objc/mal_readline.h b/impls/objc/mal_readline.h similarity index 100% rename from objc/mal_readline.h rename to impls/objc/mal_readline.h diff --git a/objc/malfunc.h b/impls/objc/malfunc.h similarity index 100% rename from objc/malfunc.h rename to impls/objc/malfunc.h diff --git a/objc/malfunc.m b/impls/objc/malfunc.m similarity index 100% rename from objc/malfunc.m rename to impls/objc/malfunc.m diff --git a/objc/printer.h b/impls/objc/printer.h similarity index 100% rename from objc/printer.h rename to impls/objc/printer.h diff --git a/objc/printer.m b/impls/objc/printer.m similarity index 100% rename from objc/printer.m rename to impls/objc/printer.m diff --git a/objc/reader.h b/impls/objc/reader.h similarity index 100% rename from objc/reader.h rename to impls/objc/reader.h 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/objc/step0_repl.m b/impls/objc/step0_repl.m similarity index 100% rename from objc/step0_repl.m rename to impls/objc/step0_repl.m diff --git a/objc/step1_read_print.m b/impls/objc/step1_read_print.m similarity index 100% rename from objc/step1_read_print.m rename to impls/objc/step1_read_print.m 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/objc/tests/step5_tco.mal b/impls/objc/tests/step5_tco.mal similarity index 100% rename from objc/tests/step5_tco.mal rename to impls/objc/tests/step5_tco.mal 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/objc/types.m b/impls/objc/types.m similarity index 97% rename from objc/types.m rename to impls/objc/types.m index 55a2e43532..356c746223 100644 --- a/objc/types.m +++ b/impls/objc/types.m @@ -91,6 +91,10 @@ - (id)objectAtIndex:(NSUInteger)index { return _array[index]; } +- (id)copyWithZone:(NSZone *)zone { + return [[MalVector alloc] initWithArray:[_array copy]]; +} + @end 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/objpascal/core.pas b/impls/objpascal/core.pas similarity index 95% rename from objpascal/core.pas rename to impls/objpascal/core.pas index dd5fcb6d5c..d51374c57f 100644 --- a/objpascal/core.pas +++ b/impls/objpascal/core.pas @@ -52,6 +52,10 @@ 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])); @@ -82,6 +86,22 @@ 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 @@ -184,6 +204,10 @@ 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); @@ -541,11 +565,14 @@ initialization 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; @@ -581,6 +608,7 @@ initialization NS['sequential?'] := @sequential_Q; NS['cons'] := @cons; NS['concat'] := @do_concat; + NS['vec'] := @vec; NS['nth'] := @nth; NS['first'] := @first; NS['rest'] := @rest; 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/objpascal/mal_func.pas b/impls/objpascal/mal_func.pas similarity index 100% rename from objpascal/mal_func.pas rename to impls/objpascal/mal_func.pas diff --git a/objpascal/mal_readline.pas b/impls/objpascal/mal_readline.pas similarity index 100% rename from objpascal/mal_readline.pas rename to impls/objpascal/mal_readline.pas diff --git a/objpascal/mal_types.pas b/impls/objpascal/mal_types.pas similarity index 100% rename from objpascal/mal_types.pas rename to impls/objpascal/mal_types.pas diff --git a/objpascal/printer.pas b/impls/objpascal/printer.pas similarity index 100% rename from objpascal/printer.pas rename to impls/objpascal/printer.pas diff --git a/objpascal/reader.pas b/impls/objpascal/reader.pas similarity index 90% rename from objpascal/reader.pas rename to impls/objpascal/reader.pas index f4ec0a1e54..d77ebf90b4 100644 --- a/objpascal/reader.pas +++ b/impls/objpascal/reader.pas @@ -91,7 +91,7 @@ function read_atom(Reader : TReader) : TMal; Str : string; begin RE := TRegExpr.Create; - RE.Expression := '(^-?[0-9]+$)|(^-?[0-9][0-9.]*$)|(^nil$)|(^true$)|(^false$)|^(\".*\")$|:(.*)|(^[^\"]*$)'; + RE.Expression := '(^-?[0-9]+$)|(^-?[0-9][0-9.]*$)|(^nil$)|(^true$)|(^false$)|^("([\\].|[^\\"])*)"$|^(\".*)$|:(.*)|(^[^\"]*$)'; Token := Reader.Next(); //WriteLn('token: ' + Token); if RE.Exec(Token) then @@ -110,14 +110,17 @@ function read_atom(Reader : TReader) : TMal; else if RE.Match[6] <> '' then begin Str := copy(Token, 2, Length(Token)-2); - Str := StringReplace(Str, '\"', '"', [rfReplaceAll]); - Str := StringReplace(Str, '\n', #10, [rfReplaceAll]); - Str := StringReplace(Str, '\\', '\', [rfReplaceAll]); + 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[7] <> '' then - read_atom := TMalString.Create(#127 + RE.Match[7]) 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 diff --git a/objpascal/regexpr/Source/RegExpr.pas b/impls/objpascal/regexpr/Source/RegExpr.pas similarity index 100% rename from objpascal/regexpr/Source/RegExpr.pas rename to impls/objpascal/regexpr/Source/RegExpr.pas 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/objpascal/step0_repl.pas b/impls/objpascal/step0_repl.pas similarity index 95% rename from objpascal/step0_repl.pas rename to impls/objpascal/step0_repl.pas index 47ed09e150..a2adefe12a 100644 --- a/objpascal/step0_repl.pas +++ b/impls/objpascal/step0_repl.pas @@ -2,8 +2,7 @@ {$H+} // Use AnsiString -Uses CMem, - mal_readline; +Uses mal_readline; var Repl_Env: string = ''; diff --git a/objpascal/step1_read_print.pas b/impls/objpascal/step1_read_print.pas similarity index 98% rename from objpascal/step1_read_print.pas rename to impls/objpascal/step1_read_print.pas index 6d0a0a728a..83f10ecf19 100644 --- a/objpascal/step1_read_print.pas +++ b/impls/objpascal/step1_read_print.pas @@ -3,7 +3,6 @@ {$H+} // Use AnsiString Uses sysutils, - CMem, mal_readline, mal_types, reader, 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/objpascal/tests/step5_tco.mal b/impls/objpascal/tests/step5_tco.mal similarity index 100% rename from objpascal/tests/step5_tco.mal rename to impls/objpascal/tests/step5_tco.mal 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/ocaml/tests/step5_tco.mal b/impls/ocaml/tests/step5_tco.mal similarity index 100% rename from ocaml/tests/step5_tco.mal rename to impls/ocaml/tests/step5_tco.mal 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/kotlin/tests/step5_tco.mal b/impls/perl/tests/step5_tco.mal similarity index 100% rename from kotlin/tests/step5_tco.mal rename to impls/perl/tests/step5_tco.mal 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/perl6/printer.pm b/impls/perl6/printer.pm similarity index 100% rename from perl6/printer.pm rename to impls/perl6/printer.pm 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/perl6/step0_repl.pl b/impls/perl6/step0_repl.pl similarity index 100% rename from perl6/step0_repl.pl rename to impls/perl6/step0_repl.pl diff --git a/perl6/step1_read_print.pl b/impls/perl6/step1_read_print.pl similarity index 100% rename from perl6/step1_read_print.pl rename to impls/perl6/step1_read_print.pl 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/perl6/types.pm b/impls/perl6/types.pm similarity index 100% rename from perl6/types.pm rename to impls/perl6/types.pm 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 93% rename from php/core.php rename to impls/php/core.php index 78f107e3a0..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]; @@ -209,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()); }, @@ -248,6 +262,7 @@ 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); }, 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 87% rename from php/printer.php rename to impls/php/printer.php index d4d53e0664..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) . "}"; @@ -31,6 +31,8 @@ function _pr_str($obj, $print_readably=True) { } 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 68c21eaad1..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,12 +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 = preg_replace('/\\\\n/', "\n", $str); - $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") { @@ -101,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 100% rename from php/step0_repl.php rename to impls/php/step0_repl.php diff --git a/php/step1_read_print.php b/impls/php/step1_read_print.php similarity index 100% rename from php/step1_read_print.php rename to impls/php/step1_read_print.php diff --git a/php/step2_eval.php b/impls/php/step2_eval.php similarity index 82% rename from php/step2_eval.php rename to impls/php/step2_eval.php index 7d5a822359..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,23 +26,20 @@ 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 diff --git a/php/step3_env.php b/impls/php/step3_env.php similarity index 81% rename from php/step3_env.php rename to impls/php/step3_env.php index 4fb25bd632..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,16 +33,10 @@ 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; } @@ -58,9 +56,11 @@ 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); } } diff --git a/php/step4_if_fn_do.php b/impls/php/step4_if_fn_do.php similarity index 80% rename from php/step4_if_fn_do.php rename to impls/php/step4_if_fn_do.php index 2d2ab1ec01..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,16 +34,10 @@ 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; } @@ -59,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) { @@ -76,9 +73,11 @@ 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); } } diff --git a/php/step5_tco.php b/impls/php/step5_tco.php similarity index 84% rename from php/step5_tco.php rename to impls/php/step5_tco.php index 65051fc34e..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,18 +36,10 @@ 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; } @@ -63,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": @@ -79,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); diff --git a/php/step6_file.php b/impls/php/step6_file.php similarity index 85% rename from php/step6_file.php rename to impls/php/step6_file.php index 4a291e91e5..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,18 +36,10 @@ 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; } @@ -63,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": @@ -79,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); @@ -121,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] . '")'); 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/php/tests/step5_tco.mal b/impls/php/tests/step5_tco.mal similarity index 100% rename from php/tests/step5_tco.mal rename to impls/php/tests/step5_tco.mal 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 94% rename from php/types.php rename to impls/php/types.php index d7dbdacf82..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); @@ -50,6 +50,7 @@ function _false_Q($obj) { return $obj === false; } function _string_Q($obj) { return is_string($obj) && strpos($obj, chr(0x7f)) !== 0; } +function _number_Q($obj) { return is_int($obj); } // Symbols @@ -64,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; } @@ -114,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/lua/tests/step5_tco.mal b/impls/pike/tests/step5_tco.mal similarity index 100% rename from lua/tests/step5_tco.mal rename to impls/pike/tests/step5_tco.mal 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/plpgsql/envs.sql b/impls/plpgsql/envs.sql similarity index 77% rename from plpgsql/envs.sql rename to impls/plpgsql/envs.sql index b856ba2071..626eb95798 100644 --- a/plpgsql/envs.sql +++ b/impls/plpgsql/envs.sql @@ -91,43 +91,21 @@ BEGIN RETURN envs.vset(env, symkey, val); END; $$ LANGUAGE plpgsql; --- envs.find -CREATE FUNCTION envs.find(env integer, symkey varchar) RETURNS integer AS $$ +-- envs.get +CREATE FUNCTION envs.get(env integer, symkey varchar) RETURNS integer AS $$ DECLARE outer_id integer; d hstore; - val integer; 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 env; - ELSIF outer_id IS NOT NULL THEN - RETURN envs.find(outer_id, symkey); - ELSE - RETURN NULL; + RETURN d -> symkey; END IF; -END; $$ LANGUAGE plpgsql; - - --- envs.vget -CREATE FUNCTION envs.vget(env integer, symkey varchar) RETURNS integer AS $$ -DECLARE - result integer; - e integer; -BEGIN - e := envs.find(env, symkey); - --RAISE NOTICE 'envs.find env: %, symkey: % -> e: %', env, symkey, e; - IF e IS NULL THEN - RAISE EXCEPTION '''%'' not found', symkey; - ELSE - SELECT data -> symkey INTO result FROM envs.env WHERE env_id = e; + env := outer_id; + IF env IS NULL THEN + RETURN NULL; END IF; - RETURN result; -END; $$ LANGUAGE plpgsql; - --- envs.get -CREATE FUNCTION envs.get(env integer, key integer) RETURNS integer AS $$ -BEGIN - RETURN envs.vget(env, types._valueToString(key)); + END LOOP; END; $$ LANGUAGE plpgsql; diff --git a/plpgsql/init.sql b/impls/plpgsql/init.sql similarity index 100% rename from plpgsql/init.sql rename to impls/plpgsql/init.sql diff --git a/plpgsql/io.sql b/impls/plpgsql/io.sql similarity index 100% rename from plpgsql/io.sql rename to impls/plpgsql/io.sql diff --git a/plpgsql/printer.sql b/impls/plpgsql/printer.sql similarity index 100% rename from plpgsql/printer.sql rename to impls/plpgsql/printer.sql 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/plpgsql/step0_repl.sql b/impls/plpgsql/step0_repl.sql similarity index 100% rename from plpgsql/step0_repl.sql rename to impls/plpgsql/step0_repl.sql diff --git a/plpgsql/step1_read_print.sql b/impls/plpgsql/step1_read_print.sql similarity index 100% rename from plpgsql/step1_read_print.sql rename to impls/plpgsql/step1_read_print.sql 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/plsql/Dockerfile b/impls/plsql/Dockerfile similarity index 100% rename from plsql/Dockerfile rename to impls/plsql/Dockerfile diff --git a/plsql/Dockerfile-oracle b/impls/plsql/Dockerfile-oracle similarity index 100% rename from plsql/Dockerfile-oracle rename to impls/plsql/Dockerfile-oracle diff --git a/plsql/Dockerfile-postgres b/impls/plsql/Dockerfile-postgres similarity index 100% rename from plsql/Dockerfile-postgres rename to impls/plsql/Dockerfile-postgres 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/plsql/env.sql b/impls/plsql/env.sql similarity index 100% rename from plsql/env.sql rename to impls/plsql/env.sql diff --git a/plsql/io.sql b/impls/plsql/io.sql similarity index 100% rename from plsql/io.sql rename to impls/plsql/io.sql diff --git a/plsql/login.sql b/impls/plsql/login.sql similarity index 100% rename from plsql/login.sql rename to impls/plsql/login.sql diff --git a/plsql/printer.sql b/impls/plsql/printer.sql similarity index 100% rename from plsql/printer.sql rename to impls/plsql/printer.sql 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/plsql/step0_repl.sql b/impls/plsql/step0_repl.sql similarity index 100% rename from plsql/step0_repl.sql rename to impls/plsql/step0_repl.sql diff --git a/plsql/step1_read_print.sql b/impls/plsql/step1_read_print.sql similarity index 100% rename from plsql/step1_read_print.sql rename to impls/plsql/step1_read_print.sql diff --git a/plsql/step2_eval.sql b/impls/plsql/step2_eval.sql similarity index 100% rename from plsql/step2_eval.sql rename to impls/plsql/step2_eval.sql diff --git a/plsql/step3_env.sql b/impls/plsql/step3_env.sql similarity index 100% rename from plsql/step3_env.sql rename to impls/plsql/step3_env.sql diff --git a/plsql/step4_if_fn_do.sql b/impls/plsql/step4_if_fn_do.sql similarity index 100% rename from plsql/step4_if_fn_do.sql rename to impls/plsql/step4_if_fn_do.sql diff --git a/plsql/step5_tco.sql b/impls/plsql/step5_tco.sql similarity index 100% rename from plsql/step5_tco.sql rename to impls/plsql/step5_tco.sql 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 90% rename from ps/core.ps rename to impls/ps/core.ps index f5b6e04989..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 100% rename from ps/printer.ps rename to impls/ps/printer.ps diff --git a/ps/reader.ps b/impls/ps/reader.ps similarity index 97% rename from ps/reader.ps rename to impls/ps/reader.ps index 3574242f0e..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 100% rename from ps/step0_repl.ps rename to impls/ps/step0_repl.ps diff --git a/ps/step1_read_print.ps b/impls/ps/step1_read_print.ps similarity index 100% rename from ps/step1_read_print.ps rename to impls/ps/step1_read_print.ps 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/perl/tests/step5_tco.mal b/impls/ps/tests/step5_tco.mal similarity index 100% rename from perl/tests/step5_tco.mal rename to impls/ps/tests/step5_tco.mal diff --git a/ps/tests/stepA_mal.mal b/impls/ps/tests/stepA_mal.mal similarity index 100% rename from ps/tests/stepA_mal.mal rename to impls/ps/tests/stepA_mal.mal diff --git a/ps/types.ps b/impls/ps/types.ps similarity index 98% rename from ps/types.ps rename to impls/ps/types.ps index 871817c0f0..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/ps/tests/step5_tco.mal b/impls/python2/tests/step5_tco.mal similarity index 100% rename from ps/tests/step5_tco.mal rename to impls/python2/tests/step5_tco.mal 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/python/tests/step5_tco.mal b/impls/python3/tests/step5_tco.mal similarity index 100% rename from python/tests/step5_tco.mal rename to impls/python3/tests/step5_tco.mal 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 98% rename from r/core.r rename to impls/r/core.r index 2a658e4cc1..9a12de3a96 100644 --- a/r/core.r +++ b/impls/r/core.r @@ -145,6 +145,9 @@ core_ns <- list( "symbol?"=.symbol_q, "keyword"=new.keyword, "keyword?"=.keyword_q, + "number?"=.number_q, + "fn?"=.fn_q, + "macro?"=.macro_q, "pr-str"=pr_str, "str"=str, @@ -179,6 +182,7 @@ core_ns <- list( "sequential?"=.sequential_q, "cons"=cons, "concat"=do_concat, + "vec"=new.vectorl, "nth"=nth, "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)), 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 100% rename from r/printer.r rename to impls/r/printer.r diff --git a/r/reader.r b/impls/r/reader.r similarity index 92% rename from r/reader.r rename to impls/r/reader.r index 030581093c..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,11 +42,14 @@ read_atom <- function(rdr) { as.integer(token) } else if (re_match("^-?[0-9][0-9.]*$", token)) { as.double(token) - } else if (substr(token,1,1) == "\"") { - gsub("\\\\\\\\", "\\\\", + } else if (re_match("^\"(?:\\\\.|[^\\\\\"])*\"$", token)) { + gsub("\x7f", "\\\\", gsub("\\\\n", "\n", gsub("\\\\\"", "\"", - substr(token, 2, nchar(token)-1)))) + gsub("\\\\\\\\", "\x7f", + substr(token, 2, nchar(token)-1))))) + } else if (substr(token,1,1) == "\"") { + throw("expected '\"', got EOF") } else if (substr(token,1,1) == ":") { new.keyword(substring(token,2)) } else if (token == "nil") { diff --git a/r/readline.r b/impls/r/readline.r similarity index 100% rename from r/readline.r rename to impls/r/readline.r 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 78% rename from r/step6_file.r rename to impls/r/step6_file.r index 8ca13ff487..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,7 +103,7 @@ 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) { 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/r/tests/step5_tco.mal b/impls/r/tests/step5_tco.mal similarity index 100% rename from r/tests/step5_tco.mal rename to impls/r/tests/step5_tco.mal diff --git a/r/types.r b/impls/r/types.r similarity index 93% rename from r/types.r rename to impls/r/types.r index b9ecfe4225..9d8c29a913 100644 --- a/r/types.r +++ b/impls/r/types.r @@ -97,13 +97,19 @@ nil <- structure("malnil", class="nil") 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) || "" == substring(obj,1,8)) } +.number_q <- function(obj) "numeric" == class(obj) || "integer" == class(obj) + # Functions malfunc <- function(eval, ast, env, params) { @@ -128,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 90% rename from racket/core.rkt rename to impls/racket/core.rkt index 2602f98169..1c69df2955 100644 --- a/racket/core.rkt +++ b/impls/racket/core.rkt @@ -57,11 +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 "")) @@ -97,6 +102,7 @@ '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 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 87% rename from racket/reader.rkt rename to impls/racket/reader.rkt index 280b9af2a0..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,14 +31,10 @@ (string->number token)] [(regexp-match #px"^-?[0-9][0-9.]*$" token) (string->number token)] - [(regexp-match #px"^\".*\"$" token) - (string-replace - (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] @@ -48,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))]))) @@ -59,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/racket/readline.rkt b/impls/racket/readline.rkt similarity index 100% rename from racket/readline.rkt rename to impls/racket/readline.rkt 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 100% rename from racket/step0_repl.rkt rename to impls/racket/step0_repl.rkt 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 7f987dfa5f..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 (or (not (list? ast)) (empty? 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 0a098029e6..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 (or (not (list? ast)) (empty? 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 cdc5230894..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 (or (not (list? ast)) (empty? 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 79% rename from racket/step6_file.rkt rename to impls/racket/step6_file.rkt index 680f84ff24..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 (or (not (list? ast)) (empty? 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) @@ -79,7 +84,7 @@ ;; 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/racket/tests/step5_tco.mal b/impls/racket/tests/step5_tco.mal similarity index 100% rename from racket/tests/step5_tco.mal rename to impls/racket/tests/step5_tco.mal diff --git a/racket/types.rkt b/impls/racket/types.rkt similarity index 100% rename from racket/types.rkt rename to impls/racket/types.rkt 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/rpython/mal_readline.py b/impls/rpython/mal_readline.py similarity index 100% rename from rpython/mal_readline.py rename to impls/rpython/mal_readline.py diff --git a/rpython/mal_types.py b/impls/rpython/mal_types.py similarity index 100% rename from rpython/mal_types.py rename to impls/rpython/mal_types.py diff --git a/rpython/printer.py b/impls/rpython/printer.py similarity index 100% rename from rpython/printer.py rename to impls/rpython/printer.py 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/rpython/step0_repl.py b/impls/rpython/step0_repl.py similarity index 100% rename from rpython/step0_repl.py rename to impls/rpython/step0_repl.py diff --git a/rpython/step1_read_print.py b/impls/rpython/step1_read_print.py similarity index 100% rename from rpython/step1_read_print.py rename to impls/rpython/step1_read_print.py 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/rpython/tests/step5_tco.mal b/impls/rpython/tests/step5_tco.mal similarity index 100% rename from rpython/tests/step5_tco.mal rename to impls/rpython/tests/step5_tco.mal 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/ruby/mal_readline.rb b/impls/ruby/mal_readline.rb similarity index 100% rename from ruby/mal_readline.rb rename to impls/ruby/mal_readline.rb 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/ruby/tests/step5_tco.mal b/impls/ruby/tests/step5_tco.mal similarity index 100% rename from ruby/tests/step5_tco.mal rename to impls/ruby/tests/step5_tco.mal 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/ruby/types.rb b/impls/ruby/types.rb similarity index 100% rename from ruby/types.rb rename to impls/ruby/types.rb 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/scala/build.sbt b/impls/scala/build.sbt similarity index 78% rename from scala/build.sbt rename to impls/scala/build.sbt index 8c7430bd07..c5bfda397c 100644 --- a/scala/build.sbt +++ b/impls/scala/build.sbt @@ -1,5 +1,4 @@ lazy val root = (project in file(".")). - settings(assemblySettings: _*). settings( name := "mal", version := "0.1", diff --git a/scala/core.scala b/impls/scala/core.scala similarity index 92% rename from scala/core.scala rename to impls/scala/core.scala index f92e660da8..dc2e3f92ab 100644 --- a/scala/core.scala +++ b/impls/scala/core.scala @@ -14,7 +14,8 @@ 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]) = { @@ -31,6 +32,21 @@ object core { } } + 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) = { op(a(0).asInstanceOf[Long],a(1).asInstanceOf[Long]) @@ -40,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]) = { @@ -232,11 +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, "")), @@ -272,6 +295,7 @@ 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 _, 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 c8d75e4360..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").replace("\\\\", "\\") + // 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 78% rename from scala/step2_eval.scala rename to impls/scala/step2_eval.scala index a25dde1219..1fb3277ee5 100644 --- a/scala/step2_eval.scala +++ b/impls/scala/step2_eval.scala @@ -7,27 +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,v) => (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 if (ast.asInstanceOf[MalList].value.length == 0) return ast - 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/step3_env.scala b/impls/scala/step3_env.scala similarity index 80% rename from scala/step3_env.scala rename to impls/scala/step3_env.scala index 0f37debca6..c3d9ae515f 100644 --- a/scala/step3_env.scala +++ b/impls/scala/step3_env.scala @@ -8,22 +8,24 @@ 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,v) => (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 { @@ -42,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 81% rename from scala/step4_if_fn_do.scala rename to impls/scala/step4_if_fn_do.scala index 4ae4bdc37c..a9d1572eea 100644 --- a/scala/step4_if_fn_do.scala +++ b/impls/scala/step4_if_fn_do.scala @@ -9,22 +9,24 @@ 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,v) => (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 { @@ -42,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) @@ -61,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 83% rename from scala/step5_tco.scala rename to impls/scala/step5_tco.scala index f9cb813929..247579b597 100644 --- a/scala/step5_tco.scala +++ b/impls/scala/step5_tco.scala @@ -9,25 +9,26 @@ 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,v) => (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 { @@ -46,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 => { @@ -67,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 84% rename from scala/step6_file.scala rename to impls/scala/step6_file.scala index b91a9b1c65..d9b356f418 100644 --- a/scala/step6_file.scala +++ b/impls/scala/step6_file.scala @@ -9,25 +9,26 @@ 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,v) => (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 { @@ -46,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 => { @@ -67,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 => { @@ -108,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/scala/tests/step5_tco.mal b/impls/scala/tests/step5_tco.mal similarity index 100% rename from scala/tests/step5_tco.mal rename to impls/scala/tests/step5_tco.mal diff --git a/scala/types.scala b/impls/scala/types.scala similarity index 100% rename from scala/types.scala rename to impls/scala/types.scala 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/swift/tests/step5_tco.mal b/impls/skew/tests/step5_tco.mal similarity index 100% rename from swift/tests/step5_tco.mal rename to impls/skew/tests/step5_tco.mal 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/swift3/tests/step5_tco.mal b/impls/swift3/tests/step5_tco.mal similarity index 100% rename from swift3/tests/step5_tco.mal rename to impls/swift3/tests/step5_tco.mal 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/tcl/core.tcl b/impls/tcl/core.tcl similarity index 92% rename from tcl/core.tcl rename to impls/tcl/core.tcl index a7ab9ea160..2485c87db1 100644 --- a/tcl/core.tcl +++ b/impls/tcl/core.tcl @@ -33,13 +33,34 @@ proc mal_string_q {a} { } proc mal_keyword {a} { - keyword_new [obj_val [lindex $a 0]] + 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 { @@ -219,6 +240,17 @@ proc mal_concat {a} { 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] @@ -383,6 +415,9 @@ set core_ns [dict create \ "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] \ @@ -418,6 +453,7 @@ set core_ns [dict create \ "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] \ diff --git a/tcl/env.tcl b/impls/tcl/env.tcl similarity index 100% rename from tcl/env.tcl rename to impls/tcl/env.tcl diff --git a/tcl/mal_readline.tcl b/impls/tcl/mal_readline.tcl similarity index 100% rename from tcl/mal_readline.tcl rename to impls/tcl/mal_readline.tcl diff --git a/tcl/printer.tcl b/impls/tcl/printer.tcl similarity index 100% rename from tcl/printer.tcl rename to impls/tcl/printer.tcl diff --git a/tcl/reader.tcl b/impls/tcl/reader.tcl similarity index 88% rename from tcl/reader.tcl rename to impls/tcl/reader.tcl index 16f21d9284..6812335f04 100644 --- a/tcl/reader.tcl +++ b/impls/tcl/reader.tcl @@ -18,9 +18,9 @@ oo::class create Reader { } proc tokenize str { - set re {[\s,]*(~@|[\[\]\{\}()'`~^@]|\"(?:\\.|[^\\\"])*\"|;.*|[^\s\[\]\{\}('\"`~^@,;)]*)} + set re {[\s,]*(~@|[\[\]\{\}()'`~^@]|\"(?:\\.|[^\\\"])*\"?|;[^\n]*|[^\s\[\]\{\}('\"`~^@,;)]*)} set tokens {} - foreach {_ capture} [regexp -line -all -inline $re $str] { + foreach {_ capture} [regexp -all -inline $re $str] { if {[string length $capture] > 0 && [string range $capture 0 0] != ";"} { lappend tokens $capture } @@ -31,14 +31,14 @@ proc tokenize str { proc read_tokens_list {reader start_char end_char} { set token [$reader next] if {$token != $start_char} { - error "expected '$start_char'" + error "expected '$start_char', got EOF" } set elements {} set token [$reader peek] while {$token != $end_char} { if {$token == ""} { - error "expected '$end_char'" + error "expected '$end_char', got EOF" } lappend elements [read_form $reader] set token [$reader peek] @@ -83,7 +83,9 @@ proc read_atom {reader} { ^true$ { return $::mal_true } ^false$ { return $::mal_false } ^: { return [keyword_new [parse_keyword $token]] } - ^\".*\"$ { return [string_new [parse_string $token]] } + ^\"(\\\\.|[^\\\\\"])*\"$ + { return [string_new [parse_string $token]] } + ^\" { error "expected '\"', got EOF" } default { return [symbol_new $token] } } } 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/tcl/step0_repl.tcl b/impls/tcl/step0_repl.tcl similarity index 100% rename from tcl/step0_repl.tcl rename to impls/tcl/step0_repl.tcl diff --git a/tcl/step1_read_print.tcl b/impls/tcl/step1_read_print.tcl similarity index 100% rename from tcl/step1_read_print.tcl rename to impls/tcl/step1_read_print.tcl diff --git a/tcl/step2_eval.tcl b/impls/tcl/step2_eval.tcl similarity index 85% rename from tcl/step2_eval.tcl rename to impls/tcl/step2_eval.tcl index 70001493a9..2cb8e0822f 100644 --- a/tcl/step2_eval.tcl +++ b/impls/tcl/step2_eval.tcl @@ -7,7 +7,7 @@ proc READ str { read_str $str } -proc eval_ast {ast env} { +proc EVAL {ast env} { switch [obj_type $ast] { "symbol" { set varname [obj_val $ast] @@ -18,11 +18,6 @@ proc eval_ast {ast env} { } } "list" { - set res {} - foreach element [obj_val $ast] { - lappend res [EVAL $element $env] - } - return [list_new $res] } "vector" { set res {} @@ -39,19 +34,16 @@ proc eval_ast {ast env} { return [hashmap_new $res] } default { return $ast } - } -} + } -proc EVAL {ast env} { - if {![list_q $ast]} { - return [eval_ast $ast $env] - } set a0 [lindex [obj_val $ast] 0] if {$a0 == ""} { return $ast } - set lst_obj [eval_ast $ast $env] - set lst [obj_val $lst_obj] + 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 diff --git a/tcl/step3_env.tcl b/impls/tcl/step3_env.tcl similarity index 88% rename from tcl/step3_env.tcl rename to impls/tcl/step3_env.tcl index 69f5a9a3c3..f6fbebbb31 100644 --- a/tcl/step3_env.tcl +++ b/impls/tcl/step3_env.tcl @@ -8,18 +8,22 @@ proc READ str { read_str $str } -proc eval_ast {ast env} { +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" { - set res {} - foreach element [obj_val $ast] { - lappend res [EVAL $element $env] - } - return [list_new $res] } "vector" { set res {} @@ -36,13 +40,8 @@ proc eval_ast {ast env} { return [hashmap_new $res] } default { return $ast } - } -} + } -proc EVAL {ast env} { - if {![list_q $ast]} { - return [eval_ast $ast $env] - } set a0 [lindex [obj_val $ast] 0] if {$a0 == ""} { return $ast @@ -64,8 +63,10 @@ proc EVAL {ast env} { return [EVAL $a2 $letenv] } default { - set lst_obj [eval_ast $ast $env] - set lst [obj_val $lst_obj] + 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] diff --git a/tcl/step4_if_fn_do.tcl b/impls/tcl/step4_if_fn_do.tcl similarity index 89% rename from tcl/step4_if_fn_do.tcl rename to impls/tcl/step4_if_fn_do.tcl index 4e2ae2f630..c29f8ece6f 100644 --- a/tcl/step4_if_fn_do.tcl +++ b/impls/tcl/step4_if_fn_do.tcl @@ -9,18 +9,22 @@ proc READ str { read_str $str } -proc eval_ast {ast env} { +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" { - set res {} - foreach element [obj_val $ast] { - lappend res [EVAL $element $env] - } - return [list_new $res] } "vector" { set res {} @@ -37,13 +41,8 @@ proc eval_ast {ast env} { return [hashmap_new $res] } default { return $ast } - } -} + } -proc EVAL {ast env} { - if {![list_q $ast]} { - return [eval_ast $ast $env] - } lassign [obj_val $ast] a0 a1 a2 a3 if {$a0 == ""} { return $ast @@ -63,8 +62,9 @@ proc EVAL {ast env} { return [EVAL $a2 $letenv] } "do" { - set el [list_new [lrange [obj_val $ast] 1 end-1]] - eval_ast $el $env + foreach element [lrange [obj_val $ast] 1 end-1] { + EVAL $element $env + } return [EVAL [lindex [obj_val $ast] end] $env] } "if" { @@ -85,8 +85,10 @@ proc EVAL {ast env} { return [function_new $a2 $env $binds] } default { - set lst_obj [eval_ast $ast $env] - set lst [obj_val $lst_obj] + 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] { diff --git a/tcl/step5_tco.tcl b/impls/tcl/step5_tco.tcl similarity index 88% rename from tcl/step5_tco.tcl rename to impls/tcl/step5_tco.tcl index 3e1f62bb27..61b17109a6 100644 --- a/tcl/step5_tco.tcl +++ b/impls/tcl/step5_tco.tcl @@ -9,18 +9,24 @@ proc READ str { read_str $str } -proc eval_ast {ast env} { +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" { - set res {} - foreach element [obj_val $ast] { - lappend res [EVAL $element $env] - } - return [list_new $res] } "vector" { set res {} @@ -37,14 +43,8 @@ proc eval_ast {ast env} { return [hashmap_new $res] } default { return $ast } - } -} - -proc EVAL {ast env} { - while {true} { - if {![list_q $ast]} { - return [eval_ast $ast $env] } + lassign [obj_val $ast] a0 a1 a2 a3 if {$a0 == ""} { return $ast @@ -66,8 +66,9 @@ proc EVAL {ast env} { # TCO: Continue loop } "do" { - set el [list_new [lrange [obj_val $ast] 1 end-1]] - eval_ast $el $env + foreach element [lrange [obj_val $ast] 1 end-1] { + EVAL $element $env + } set ast [lindex [obj_val $ast] end] # TCO: Continue loop } @@ -91,8 +92,10 @@ proc EVAL {ast env} { return [function_new $a2 $env $binds] } default { - set lst_obj [eval_ast $ast $env] - set lst [obj_val $lst_obj] + 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] { diff --git a/tcl/step6_file.tcl b/impls/tcl/step6_file.tcl similarity index 88% rename from tcl/step6_file.tcl rename to impls/tcl/step6_file.tcl index 25a7c83f27..dd4bb8c908 100644 --- a/tcl/step6_file.tcl +++ b/impls/tcl/step6_file.tcl @@ -9,18 +9,24 @@ proc READ str { read_str $str } -proc eval_ast {ast env} { +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" { - set res {} - foreach element [obj_val $ast] { - lappend res [EVAL $element $env] - } - return [list_new $res] } "vector" { set res {} @@ -37,14 +43,8 @@ proc eval_ast {ast env} { return [hashmap_new $res] } default { return $ast } - } -} - -proc EVAL {ast env} { - while {true} { - if {![list_q $ast]} { - return [eval_ast $ast $env] } + lassign [obj_val $ast] a0 a1 a2 a3 if {$a0 == ""} { return $ast @@ -66,8 +66,9 @@ proc EVAL {ast env} { # TCO: Continue loop } "do" { - set el [list_new [lrange [obj_val $ast] 1 end-1]] - eval_ast $el $env + foreach element [lrange [obj_val $ast] 1 end-1] { + EVAL $element $env + } set ast [lindex [obj_val $ast] end] # TCO: Continue loop } @@ -91,8 +92,10 @@ proc EVAL {ast env} { return [function_new $a2 $env $binds] } default { - set lst_obj [eval_ast $ast $env] - set lst [obj_val $lst_obj] + 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] { @@ -148,7 +151,7 @@ $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) \")\")))))" $repl_env +RE "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))" $repl_env fconfigure stdout -translation binary 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/tcl/tests/step5_tco.mal b/impls/tcl/tests/step5_tco.mal similarity index 100% rename from tcl/tests/step5_tco.mal rename to impls/tcl/tests/step5_tco.mal 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/tcl/types.tcl b/impls/tcl/types.tcl similarity index 91% rename from tcl/types.tcl rename to impls/tcl/types.tcl index e1edfad3b9..3742fc2c00 100644 --- a/tcl/types.tcl +++ b/impls/tcl/types.tcl @@ -73,6 +73,10 @@ 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 } @@ -171,6 +175,15 @@ proc function_new {body env binds} { 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"} } 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/tests/docker-build.sh b/impls/tests/docker-build.sh similarity index 88% rename from tests/docker-build.sh rename to impls/tests/docker-build.sh index e79c149de5..4df597932e 100755 --- a/tests/docker-build.sh +++ b/impls/tests/docker-build.sh @@ -1,4 +1,4 @@ -#!/bin/bash +#!/usr/bin/env bash IMAGE_NAME=${IMAGE_NAME:-mal-test-ubuntu-utopic} GIT_TOP=$(git rev-parse --show-toplevel) diff --git a/tests/docker-run.sh b/impls/tests/docker-run.sh similarity index 90% rename from tests/docker-run.sh rename to impls/tests/docker-run.sh index 1666d7d318..0f8be9e1f0 100755 --- a/tests/docker-run.sh +++ b/impls/tests/docker-run.sh @@ -1,4 +1,4 @@ -#!/bin/bash +#!/usr/bin/env bash IMAGE_NAME=${IMAGE_NAME:-mal-test-ubuntu-utopic} GIT_TOP=$(git rev-parse --show-toplevel) 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/tests/print_argv.mal b/impls/tests/print_argv.mal similarity index 100% rename from tests/print_argv.mal rename to impls/tests/print_argv.mal diff --git a/run_argv_test.sh b/impls/tests/run_argv_test.sh similarity index 77% rename from run_argv_test.sh rename to impls/tests/run_argv_test.sh index 3de3efd4a1..e3682e4f9f 100755 --- a/run_argv_test.sh +++ b/impls/tests/run_argv_test.sh @@ -1,4 +1,4 @@ -#!/bin/bash +#!/usr/bin/env bash # # Usage: run_argv_test.sh @@ -23,16 +23,16 @@ fi root="$(dirname $0)" -out="$( $@ $root/tests/print_argv.mal aaa bbb ccc )" +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/tests/print_argv.mal aaa 'bbb ccc' ddd )" +# out="$( $@ $root/print_argv.mal aaa 'bbb ccc' ddd )" # assert_equal '("aaa" "bbb ccc" "ddd")' "$out" -out="$( $@ $root/tests/print_argv.mal )" +out="$( $@ $root/print_argv.mal | tr -d '\r' )" assert_equal '()' "$out" echo 'Passed all *ARGV* tests' 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 93% rename from vb/core.vb rename to impls/vb/core.vb index 27c6974c9d..77ba29cc73 100644 --- a/vb/core.vb +++ b/impls/vb/core.vb @@ -86,6 +86,9 @@ Namespace Mal 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 @@ -104,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 @@ -292,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 @@ -454,6 +485,9 @@ Namespace Mal 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)) @@ -488,6 +522,7 @@ 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)) 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 cc42a14747..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,13 +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("\\", "\")) + .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 100% rename from vb/step0_repl.vb rename to impls/vb/step0_repl.vb 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/vb/tests/step5_tco.mal b/impls/vb/tests/step5_tco.mal similarity index 100% rename from vb/tests/step5_tco.mal rename to impls/vb/tests/step5_tco.mal diff --git a/vb/types.vb b/impls/vb/types.vb similarity index 98% rename from vb/types.vb rename to impls/vb/types.vb index 711011ece6..c1b534e525 100644 --- a/vb/types.vb +++ b/impls/vb/types.vb @@ -465,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/vhdl/.gitignore b/impls/vhdl/.gitignore similarity index 100% rename from vhdl/.gitignore rename to impls/vhdl/.gitignore 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/vhdl/core.vhdl b/impls/vhdl/core.vhdl similarity index 92% rename from vhdl/core.vhdl rename to impls/vhdl/core.vhdl index d95f6a2bda..b904dc0c12 100644 --- a/vhdl/core.vhdl +++ b/impls/vhdl/core.vhdl @@ -66,6 +66,21 @@ package body core is 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 @@ -211,17 +226,16 @@ package body core is assert false severity failure; end function gettimeofday; - -- Returns the number of milliseconds since 2000-01-01 00:00:00 UTC because - -- a standard VHDL integer is 32-bit and therefore cannot hold the number of + -- 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; - constant utc_2000_01_01: c_seconds64 := 946684800 c_sec; -- UNIX time at 2000-01-01 00:00:00 UTC begin rc := gettimeofday(tv, dummy); - new_number(((tv.tv_sec - utc_2000_01_01) / 1 c_sec) * 1000 + (tv.tv_usec / 1000 c_usec), result); + 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 @@ -246,9 +260,13 @@ package body core is 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 - args.val_type := mal_hashmap; - result := args; + 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 @@ -361,6 +379,15 @@ package body core is 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; @@ -533,6 +560,9 @@ package body core is 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); @@ -564,6 +594,7 @@ package body core is 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); @@ -592,12 +623,6 @@ package body core is end procedure define_core_function; procedure define_core_functions(e: inout env_ptr) is - variable is_eof: boolean; - variable input_line, result, err: line; - variable sym: mal_val_ptr; - variable fn: mal_val_ptr; - variable outer: env_ptr; - variable repl_env: env_ptr; begin define_core_function(e, "="); define_core_function(e, "throw"); @@ -609,6 +634,9 @@ package body core is 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"); @@ -640,6 +668,7 @@ package body core is 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"); 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/vhdl/pkg_readline.vhdl b/impls/vhdl/pkg_readline.vhdl similarity index 96% rename from vhdl/pkg_readline.vhdl rename to impls/vhdl/pkg_readline.vhdl index c06ff0bdf1..74e0bbf8d1 100644 --- a/vhdl/pkg_readline.vhdl +++ b/impls/vhdl/pkg_readline.vhdl @@ -2,6 +2,7 @@ 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; diff --git a/vhdl/printer.vhdl b/impls/vhdl/printer.vhdl similarity index 100% rename from vhdl/printer.vhdl rename to impls/vhdl/printer.vhdl diff --git a/vhdl/reader.vhdl b/impls/vhdl/reader.vhdl similarity index 88% rename from vhdl/reader.vhdl rename to impls/vhdl/reader.vhdl index b19788411a..f8f07d2356 100644 --- a/vhdl/reader.vhdl +++ b/impls/vhdl/reader.vhdl @@ -84,6 +84,9 @@ package body reader is 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; @@ -187,11 +190,15 @@ package body reader is src_i := src_i + 1; end if; end loop; - result := new string'(s(1 to dst_i)); + 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) is + 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; @@ -221,7 +228,17 @@ package body reader is 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); @@ -256,6 +273,22 @@ package body reader is 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; @@ -326,9 +359,9 @@ package body reader is when ')' => new_string("unexcepted ')'", err); when '[' => read_sequence(mal_vector, "]", r, result, err); when ']' => new_string("unexcepted ']'", err); - when '{' => read_sequence(mal_hashmap, "}", r, result, err); + when '{' => read_map(r, result, err); when '}' => new_string("unexcepted '}'", err); - when others => read_atom(r, result); + when others => read_atom(r, result, err); end case; end procedure read_form; 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/vhdl/run_vhdl.sh b/impls/vhdl/run_vhdl.sh similarity index 95% rename from vhdl/run_vhdl.sh rename to impls/vhdl/run_vhdl.sh index b8e374a222..1cc8e3bf9f 100755 --- a/vhdl/run_vhdl.sh +++ b/impls/vhdl/run_vhdl.sh @@ -1,4 +1,4 @@ -#!/bin/bash +#!/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 diff --git a/vhdl/step0_repl.vhdl b/impls/vhdl/step0_repl.vhdl similarity index 100% rename from vhdl/step0_repl.vhdl rename to impls/vhdl/step0_repl.vhdl diff --git a/vhdl/step1_read_print.vhdl b/impls/vhdl/step1_read_print.vhdl similarity index 100% rename from vhdl/step1_read_print.vhdl rename to impls/vhdl/step1_read_print.vhdl diff --git a/vhdl/step2_eval.vhdl b/impls/vhdl/step2_eval.vhdl similarity index 77% rename from vhdl/step2_eval.vhdl rename to impls/vhdl/step2_eval.vhdl index 0a643f4da6..a9efe834e5 100644 --- a/vhdl/step2_eval.vhdl +++ b/impls/vhdl/step2_eval.vhdl @@ -36,12 +36,16 @@ architecture test of step2_eval is end if; end procedure eval_native_func; - procedure eval_ast_seq(ast_seq: inout mal_seq_ptr; env: inout mal_val_ptr; result: inout mal_seq_ptr; err: out mal_val_ptr) is + 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); + result := new mal_seq(0 to ast_seq'length - 1 - skip); for i in result'range loop - EVAL(ast_seq(i), env, result(i), eval_err); + EVAL(ast_seq(skip + i), env, result(i), eval_err); if eval_err /= null then err := eval_err; return; @@ -49,11 +53,19 @@ architecture test of step2_eval is end loop; end procedure eval_ast_seq; - procedure eval_ast(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: mal_val_ptr; + 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); @@ -64,8 +76,10 @@ architecture test of step2_eval is end if; result := val; return; - when mal_list | mal_vector | mal_hashmap => - eval_ast_seq(ast.seq_val, env, new_seq, eval_err); + 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; @@ -76,28 +90,25 @@ architecture test of step2_eval is result := ast; return; end case; - end procedure eval_ast; - - procedure EVAL(ast: inout mal_val_ptr; env: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is - variable a, call_args, sub_err: mal_val_ptr; - begin - if ast.val_type /= mal_list then - eval_ast(ast, env, result, err); - return; - end if; if ast.seq_val'length = 0 then result := ast; return; end if; - eval_ast(ast, env, a, sub_err); + 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; - seq_drop_prefix(a, 1, call_args); - eval_native_func(a.seq_val(0), call_args, result); + 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 diff --git a/vhdl/step3_env.vhdl b/impls/vhdl/step3_env.vhdl similarity index 75% rename from vhdl/step3_env.vhdl rename to impls/vhdl/step3_env.vhdl index 3542ff1c82..73b8503c3a 100644 --- a/vhdl/step3_env.vhdl +++ b/impls/vhdl/step3_env.vhdl @@ -37,12 +37,16 @@ architecture test of step3_env is end if; end procedure eval_native_func; - procedure eval_ast_seq(ast_seq: inout mal_seq_ptr; env: inout env_ptr; result: inout mal_seq_ptr; err: out mal_val_ptr) is + 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); + result := new mal_seq(0 to ast_seq'length - 1 - skip); for i in result'range loop - EVAL(ast_seq(i), env, result(i), eval_err); + EVAL(ast_seq(skip + i), env, result(i), eval_err); if eval_err /= null then err := eval_err; return; @@ -50,22 +54,38 @@ architecture test of step3_env is end loop; end procedure eval_ast_seq; - procedure eval_ast(ast: inout mal_val_ptr; env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is - variable key, val, eval_err, env_err: mal_val_ptr; + 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, env_err); - if env_err /= null then - err := env_err; + 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 | mal_vector | mal_hashmap => - eval_ast_seq(ast.seq_val, env, new_seq, eval_err); + 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; @@ -76,17 +96,6 @@ architecture test of step3_env is result := ast; return; end case; - end procedure eval_ast; - - procedure EVAL(ast: inout mal_val_ptr; env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is - variable i: integer; - variable evaled_ast, a0, call_args, val, vars, sub_err: mal_val_ptr; - variable let_env: env_ptr; - begin - if ast.val_type /= mal_list then - eval_ast(ast, env, result, err); - return; - end if; if ast.seq_val'length = 0 then result := ast; @@ -119,13 +128,19 @@ architecture test of step3_env is EVAL(ast.seq_val(2), let_env, result, err); deallocate(let_env); else - eval_ast(ast, env, evaled_ast, sub_err); + 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; - seq_drop_prefix(evaled_ast, 1, call_args); - eval_native_func(a0, call_args, result); + new_seq_obj(mal_list, new_seq, call_args); + eval_native_func(fn, call_args, result); end if; end procedure EVAL; diff --git a/vhdl/step4_if_fn_do.vhdl b/impls/vhdl/step4_if_fn_do.vhdl similarity index 78% rename from vhdl/step4_if_fn_do.vhdl rename to impls/vhdl/step4_if_fn_do.vhdl index d28101a6be..6e63f77f72 100644 --- a/vhdl/step4_if_fn_do.vhdl +++ b/impls/vhdl/step4_if_fn_do.vhdl @@ -20,12 +20,16 @@ architecture test of step4_if_fn_do is -- 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; env: inout env_ptr; result: inout mal_seq_ptr; err: out mal_val_ptr) is + 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); + result := new mal_seq(0 to ast_seq'length - 1 - skip); for i in result'range loop - EVAL(ast_seq(i), env, result(i), eval_err); + EVAL(ast_seq(skip + i), env, result(i), eval_err); if eval_err /= null then err := eval_err; return; @@ -33,22 +37,38 @@ architecture test of step4_if_fn_do is end loop; end procedure eval_ast_seq; - procedure eval_ast(ast: inout mal_val_ptr; env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is - variable key, val, eval_err, env_err: mal_val_ptr; + 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, env_err); - if env_err /= null then - err := env_err; + 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 | mal_vector | mal_hashmap => - eval_ast_seq(ast.seq_val, env, new_seq, eval_err); + 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; @@ -59,17 +79,6 @@ architecture test of step4_if_fn_do is result := ast; return; end case; - end procedure eval_ast; - - procedure EVAL(ast: inout mal_val_ptr; env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is - variable i: integer; - variable evaled_ast, a0, call_args, val, vars, sub_err, fn: mal_val_ptr; - variable let_env, fn_env: env_ptr; - begin - if ast.val_type /= mal_list then - eval_ast(ast, env, result, err); - return; - end if; if ast.seq_val'length = 0 then result := ast; @@ -138,13 +147,18 @@ architecture test of step4_if_fn_do is end if; end if; - eval_ast(ast, env, evaled_ast, sub_err); + 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; - seq_drop_prefix(evaled_ast, 1, call_args); - fn := evaled_ast.seq_val(0); + 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); diff --git a/vhdl/step5_tco.vhdl b/impls/vhdl/step5_tco.vhdl similarity index 78% rename from vhdl/step5_tco.vhdl rename to impls/vhdl/step5_tco.vhdl index 6f8f030b6b..617d4ee6ed 100644 --- a/vhdl/step5_tco.vhdl +++ b/impls/vhdl/step5_tco.vhdl @@ -20,12 +20,16 @@ architecture test of step5_tco is -- 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; env: inout env_ptr; result: inout mal_seq_ptr; err: out mal_val_ptr) is + 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); + result := new mal_seq(0 to ast_seq'length - 1 - skip); for i in result'range loop - EVAL(ast_seq(i), env, result(i), eval_err); + EVAL(ast_seq(skip + i), env, result(i), eval_err); if eval_err /= null then err := eval_err; return; @@ -33,22 +37,42 @@ architecture test of step5_tco is end loop; end procedure eval_ast_seq; - procedure eval_ast(ast: inout mal_val_ptr; env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is - variable key, val, eval_err, env_err: mal_val_ptr; + 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, env_err); - if env_err /= null then - err := env_err; + 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 | mal_vector | mal_hashmap => - eval_ast_seq(ast.seq_val, env, new_seq, eval_err); + 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; @@ -59,20 +83,6 @@ architecture test of step5_tco is result := ast; return; end case; - end procedure eval_ast; - - 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 i: integer; - variable ast, evaled_ast, a0, call_args, val, vars, sub_err, fn: mal_val_ptr; - variable env, let_env, fn_env: env_ptr; - begin - ast := in_ast; - env := in_env; - loop - if ast.val_type /= mal_list then - eval_ast(ast, env, result, err); - return; - end if; if ast.seq_val'length = 0 then result := ast; @@ -144,13 +154,18 @@ architecture test of step5_tco is end if; end if; - eval_ast(ast, env, evaled_ast, sub_err); + 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; - seq_drop_prefix(evaled_ast, 1, call_args); - fn := evaled_ast.seq_val(0); + 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); diff --git a/vhdl/step6_file.vhdl b/impls/vhdl/step6_file.vhdl similarity index 83% rename from vhdl/step6_file.vhdl rename to impls/vhdl/step6_file.vhdl index be9727f22a..3b21c0e37e 100644 --- a/vhdl/step6_file.vhdl +++ b/impls/vhdl/step6_file.vhdl @@ -75,12 +75,16 @@ architecture test of step6_file is end case; end procedure apply_func; - procedure eval_ast_seq(ast_seq: inout mal_seq_ptr; env: inout env_ptr; result: inout mal_seq_ptr; err: out mal_val_ptr) is + 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); + result := new mal_seq(0 to ast_seq'length - 1 - skip); for i in result'range loop - EVAL(ast_seq(i), env, result(i), eval_err); + EVAL(ast_seq(skip + i), env, result(i), eval_err); if eval_err /= null then err := eval_err; return; @@ -88,22 +92,42 @@ architecture test of step6_file is end loop; end procedure eval_ast_seq; - procedure eval_ast(ast: inout mal_val_ptr; env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is - variable key, val, eval_err, env_err: mal_val_ptr; + 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, env_err); - if env_err /= null then - err := env_err; + 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 | mal_vector | mal_hashmap => - eval_ast_seq(ast.seq_val, env, new_seq, eval_err); + 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; @@ -114,20 +138,6 @@ architecture test of step6_file is result := ast; return; end case; - end procedure eval_ast; - - 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 i: integer; - variable ast, evaled_ast, a0, call_args, val, vars, sub_err, fn: mal_val_ptr; - variable env, let_env, fn_env: env_ptr; - begin - ast := in_ast; - env := in_env; - loop - if ast.val_type /= mal_list then - eval_ast(ast, env, result, err); - return; - end if; if ast.seq_val'length = 0 then result := ast; @@ -199,26 +209,27 @@ architecture test of step6_file is end if; end if; - eval_ast(ast, env, evaled_ast, sub_err); + EVAL (a0, env, fn, sub_err); if sub_err /= null then err := sub_err; return; end if; - seq_drop_prefix(evaled_ast, 1, call_args); - fn := evaled_ast.seq_val(0); - case fn.val_type is - when mal_nativefn => - apply_native_func(fn, call_args, result, err); - return; - when mal_fn => + -- 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 - when others => - new_string("not a function", err); - return; - end case; + end if; + apply_func(fn, call_args, result, err); + return; end loop; end procedure EVAL; @@ -302,7 +313,7 @@ architecture test of step6_file is -- 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) " & '"' & ")" & '"' & ")))))", 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); 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/vhdl/types.vhdl b/impls/vhdl/types.vhdl similarity index 100% rename from vhdl/types.vhdl rename to impls/vhdl/types.vhdl diff --git a/vimscript/.gitignore b/impls/vimscript/.gitignore similarity index 100% rename from vimscript/.gitignore rename to impls/vimscript/.gitignore 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/vimscript/reader.vim b/impls/vimscript/reader.vim similarity index 87% rename from vimscript/reader.vim rename to impls/vimscript/reader.vim index 38510cd45e..5d86dec67c 100644 --- a/vimscript/reader.vim +++ b/impls/vimscript/reader.vim @@ -24,6 +24,7 @@ function Tokenize(str) \ "\\~@\\|" . \ "[\\[\\]{}()'`~^@]\\|" . \ "\"\\%(\\\\.\\|[^\\\\\"]\\)*\"\\|" . + \ "\"\\%(\\\\.\\|[^\\\\\"]\\)*\\|" . \ ";[^\\n]*\\|" . \ "[^[:blank:]\\n\\[\\]{}('\"`,;)]*" . \ "\\)" @@ -42,12 +43,20 @@ function Tokenize(str) 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) - let str = a:token[1:-2] - let str = substitute(str, '\\"', '"', "g") - let str = substitute(str, '\\n', "\n", "g") - let str = substitute(str, '\\\\', "\\", "g") - return str + return substitute(a:token[1:-2], '\\.', '\=UnescapeChar(submatch(0))', "g") endfunction function ReadAtom(rdr) @@ -56,8 +65,10 @@ function ReadAtom(rdr) return IntegerNew(str2nr(token)) elseif token =~ "^-\\?[0-9][0-9.]*$" return FloatNew(str2float(token)) - elseif token =~ "^\".*\"$" + elseif token =~ "^\"\\%(\\\\.\\|[^\\\\\"]\\)*\"$" return StringNew(ParseString(token)) + elseif token =~ "^\".*$" + throw "expected '\"', got EOF" elseif token =~ "^:" return KeywordNew(token[1:-1]) elseif token == "nil" @@ -79,11 +90,12 @@ function ReadTokensList(rdr, start, last) endif let token = a:rdr.peek() while token != a:last - if token == "" - throw "expected '" . a:last . "', got EOF" - endif call add(elements, ReadForm(a:rdr)) - let token = a:rdr.peek() + try + let token = a:rdr.peek() + catch + throw "expected '" . a:last . "', got EOF" + endtry endwhile call a:rdr.nexttoken() return elements diff --git a/vimscript/readline.vim b/impls/vimscript/readline.vim similarity index 83% rename from vimscript/readline.vim rename to impls/vimscript/readline.vim index 8c3b66b10e..af4d57f596 100644 --- a/vimscript/readline.vim +++ b/impls/vimscript/readline.vim @@ -11,8 +11,8 @@ endfunction " Returns [is_eof, line_string] function Readline(prompt) - " Use the vimreadline() function defined in vimreadline.c and compiled - " into libvimreadline.so + " 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" 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/vimscript/run_vimscript.sh b/impls/vimscript/run_vimscript.sh similarity index 100% rename from vimscript/run_vimscript.sh rename to impls/vimscript/run_vimscript.sh diff --git a/vimscript/step0_repl.vim b/impls/vimscript/step0_repl.vim similarity index 100% rename from vimscript/step0_repl.vim rename to impls/vimscript/step0_repl.vim diff --git a/vimscript/step1_read_print.vim b/impls/vimscript/step1_read_print.vim similarity index 100% rename from vimscript/step1_read_print.vim rename to impls/vimscript/step1_read_print.vim 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/vimscript/tests/step5_tco.mal b/impls/vimscript/tests/step5_tco.mal similarity index 100% rename from vimscript/tests/step5_tco.mal rename to impls/vimscript/tests/step5_tco.mal 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/vimscript/vimextras.c b/impls/vimscript/vimextras.c similarity index 83% rename from vimscript/vimextras.c rename to impls/vimscript/vimextras.c index 339586a83b..15d9d5ad9c 100644 --- a/vimscript/vimextras.c +++ b/impls/vimscript/vimextras.c @@ -27,10 +27,10 @@ char* vimreadline(char* prompt) { return buf; } -#define UNIXTIME_2000_01_01 946684800 +#define UNIXTIME_BASE 1451606400 /* = Unix time of 2016-01-01 */ /* - * Returns the number of milliseconds since 2000-01-01 00:00:00 UTC. + * 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 @@ -40,5 +40,5 @@ int vimtimems(int dummy) { struct timeval tv; (void) dummy; /* unused */ gettimeofday(&tv, NULL); - return (tv.tv_sec - UNIXTIME_2000_01_01) * 1000 + (tv.tv_usec / 1000); + 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/io/Dockerfile b/io/Dockerfile deleted file mode 100644 index e93a326434..0000000000 --- a/io/Dockerfile +++ /dev/null @@ -1,33 +0,0 @@ -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 -########################################################## - -# Zip -RUN apt-get -y install unzip - -RUN cd /tmp && curl -O -J -L http://iobin.suspended-chord.info/linux/iobin-linux-x64-deb-current.zip \ - && unzip iobin-linux-x64-deb-current.zip IoLanguage-2013.11.04-Linux-x64.deb \ - && dpkg -i IoLanguage-2013.11.04-Linux-x64.deb \ - && ldconfig \ - && rm -f iobin-linux-x64-deb-current.zip IoLanguage-2013.11.04-Linux-x64.deb - -ENV HOME /mal diff --git a/io/Makefile b/io/Makefile deleted file mode 100644 index 5da1e5e5f7..0000000000 --- a/io/Makefile +++ /dev/null @@ -1,20 +0,0 @@ -TESTS = - -SOURCES_BASE = MalReadline.io MalTypes.io MalReader.io -SOURCES_LISP = Env.io MalCore.io stepA_mal.io -SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) - -.PHONY: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" - -tests: $(TESTS) - -$(TESTS): - @echo "Running $@"; \ - ruby $@ || exit 1; \ diff --git a/io/run b/io/run deleted file mode 100755 index 1c38be7185..0000000000 --- a/io/run +++ /dev/null @@ -1,6 +0,0 @@ -#!/bin/bash - -# Io prints the line "Registering Regex: Regex" when loading the Regex module -# for the first time, and there's no way to suppress it. To avoid polluting -# the Mal script output, we swallow the first 25 bytes. -io $(dirname $0)/${STEP:-stepA_mal}.io "$@" | (read -N 25 -t 10 ; cat) diff --git a/io/step7_quote.io b/io/step7_quote.io deleted file mode 100644 index ce4b962424..0000000000 --- a/io/step7_quote.io +++ /dev/null @@ -1,117 +0,0 @@ -MalTypes -MalReader - -READ := method(str, MalReader read_str(str)) - -isPair := method(obj, - obj ?isSequential and(obj isEmpty not) -) - -quasiquote := method(ast, - if(isPair(ast) not, return(MalList with(list(MalSymbol with("quote"), ast)))) - a0 := ast at(0) - if(a0 == MalSymbol with("unquote"), return(ast at(1))) - if(isPair(a0) and (a0 at(0) == MalSymbol with("splice-unquote")), - return(MalList with(list(MalSymbol with("concat"), a0 at(1), quasiquote(ast rest)))), - return(MalList with(list(MalSymbol with("cons"), quasiquote(a0), quasiquote(ast rest))))) -) - -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, - keyObj := MalMap keyToObj(k) - m atPut(MalMap objToKey(EVAL(keyObj, env)), EVAL(v, env)) - ) - m, - ast - ) -) - -EVAL := method(ast, env, - loop( - 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) \")\")))))") - -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, - ("Error: " .. (e error)) println - ) -) diff --git a/io/step8_macros.io b/io/step8_macros.io deleted file mode 100644 index 6ab02f4798..0000000000 --- a/io/step8_macros.io +++ /dev/null @@ -1,144 +0,0 @@ -MalTypes -MalReader - -READ := method(str, MalReader read_str(str)) - -isPair := method(obj, - obj ?isSequential and(obj isEmpty not) -) - -quasiquote := method(ast, - if(isPair(ast) not, return(MalList with(list(MalSymbol with("quote"), ast)))) - a0 := ast at(0) - if(a0 == MalSymbol with("unquote"), return(ast at(1))) - if(isPair(a0) and (a0 at(0) == MalSymbol with("splice-unquote")), - return(MalList with(list(MalSymbol with("concat"), a0 at(1), quasiquote(ast rest)))), - return(MalList with(list(MalSymbol with("cons"), quasiquote(a0), quasiquote(ast rest))))) -) - -isMacroCall := method(ast, env, - if(ast type != "MalList", return false) - a0 := ast first - if(a0 type != "MalSymbol", return false) - if(env find(a0) isNil, return false) - f := env get(a0) - (f type == "MalFunc") and (f isMacro) -) - -macroexpand := method(ast, env, - while(isMacroCall(ast, env), - macro := env get(ast at(0)) - ast = macro blk call(ast rest) - ) - 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, - keyObj := MalMap keyToObj(k) - m atPut(MalMap objToKey(EVAL(keyObj, env)), EVAL(v, env)) - ) - m, - ast - ) -) - -EVAL := method(ast, env, - loop( - if(ast type != "MalList", return(eval_ast(ast, env))) - - ast = macroexpand(ast, env) - 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) setIsMacro(true))), - "macroexpand", - return(macroexpand(ast at(1), env)) - ) - ) - - // 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) \")\")))))") -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(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, - ("Error: " .. (e error)) println - ) -) diff --git a/io/step9_try.io b/io/step9_try.io deleted file mode 100644 index 990bcd13d2..0000000000 --- a/io/step9_try.io +++ /dev/null @@ -1,154 +0,0 @@ -MalTypes -MalReader - -READ := method(str, MalReader read_str(str)) - -isPair := method(obj, - obj ?isSequential and(obj isEmpty not) -) - -quasiquote := method(ast, - if(isPair(ast) not, return(MalList with(list(MalSymbol with("quote"), ast)))) - a0 := ast at(0) - if(a0 == MalSymbol with("unquote"), return(ast at(1))) - if(isPair(a0) and (a0 at(0) == MalSymbol with("splice-unquote")), - return(MalList with(list(MalSymbol with("concat"), a0 at(1), quasiquote(ast rest)))), - return(MalList with(list(MalSymbol with("cons"), quasiquote(a0), quasiquote(ast rest))))) -) - -isMacroCall := method(ast, env, - if(ast type != "MalList", return false) - a0 := ast first - if(a0 type != "MalSymbol", return false) - if(env find(a0) isNil, return false) - f := env get(a0) - (f type == "MalFunc") and (f isMacro) -) - -macroexpand := method(ast, env, - while(isMacroCall(ast, env), - macro := env get(ast at(0)) - ast = macro blk call(ast rest) - ) - 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, - keyObj := MalMap keyToObj(k) - m atPut(MalMap objToKey(EVAL(keyObj, env)), EVAL(v, env)) - ) - m, - ast - ) -) - -EVAL := method(ast, env, - loop( - if(ast type != "MalList", return(eval_ast(ast, env))) - - ast = macroexpand(ast, env) - 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) setIsMacro(true))), - "macroexpand", - return(macroexpand(ast at(1), env)), - "try*", - 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 - 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) \")\")))))") -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(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, - ("Error: " .. (e error)) println - ) -) diff --git a/io/stepA_mal.io b/io/stepA_mal.io deleted file mode 100644 index 911b21f175..0000000000 --- a/io/stepA_mal.io +++ /dev/null @@ -1,158 +0,0 @@ -MalTypes -MalReader - -READ := method(str, MalReader read_str(str)) - -isPair := method(obj, - obj ?isSequential and(obj isEmpty not) -) - -quasiquote := method(ast, - if(isPair(ast) not, return(MalList with(list(MalSymbol with("quote"), ast)))) - a0 := ast at(0) - if(a0 == MalSymbol with("unquote"), return(ast at(1))) - if(isPair(a0) and (a0 at(0) == MalSymbol with("splice-unquote")), - return(MalList with(list(MalSymbol with("concat"), a0 at(1), quasiquote(ast rest)))), - return(MalList with(list(MalSymbol with("cons"), quasiquote(a0), quasiquote(ast rest))))) -) - -isMacroCall := method(ast, env, - if(ast type != "MalList", return false) - a0 := ast first - if(a0 type != "MalSymbol", return false) - if(env find(a0) isNil, return false) - f := env get(a0) - (f type == "MalFunc") and (f isMacro) -) - -macroexpand := method(ast, env, - while(isMacroCall(ast, env), - macro := env get(ast at(0)) - ast = macro blk call(ast rest) - ) - 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, - keyObj := MalMap keyToObj(k) - m atPut(MalMap objToKey(EVAL(keyObj, env)), EVAL(v, env)) - ) - m, - ast - ) -) - -EVAL := method(ast, env, - loop( - if(ast type != "MalList", return(eval_ast(ast, env))) - - ast = macroexpand(ast, env) - 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) setIsMacro(true))), - "macroexpand", - return(macroexpand(ast at(1), env)), - "try*", - 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 - 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! *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) \")\")))))") -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("(def! *gensym-counter* (atom 0))") -RE("(def! gensym (fn* [] (symbol (str \"G__\" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))") -RE("(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(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, - ("Error: " .. (e error)) println - ) -) diff --git a/io/tests/stepA_mal.mal b/io/tests/stepA_mal.mal deleted file mode 100644 index 4a07a602ef..0000000000 --- a/io/tests/stepA_mal.mal +++ /dev/null @@ -1,33 +0,0 @@ -;; 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/java/Dockerfile b/java/Dockerfile deleted file mode 100644 index 0dc69c55d5..0000000000 --- a/java/Dockerfile +++ /dev/null @@ -1,28 +0,0 @@ -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 -########################################################## - -# Java and maven -RUN apt-get -y install openjdk-7-jdk -RUN apt-get -y install maven2 -ENV MAVEN_OPTS -Duser.home=/mal - diff --git a/java/Makefile b/java/Makefile deleted file mode 100644 index 8e256e5822..0000000000 --- a/java/Makefile +++ /dev/null @@ -1,43 +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) - -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 - -#.PHONY: stats tests $(TESTS) -.PHONY: stats - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" diff --git a/java/run b/java/run deleted file mode 100755 index 8252305dac..0000000000 --- a/java/run +++ /dev/null @@ -1,9 +0,0 @@ -#!/bin/bash -args="" -if [ "$#" -gt 0 ]; then - args="-Dexec.args='$1'" - for a in "${@:2}"; do - args="$args '$a'" - done -fi -exec mvn -quiet exec:java -Dexec.mainClass="mal.${STEP:-stepA_mal}" "$args" 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 9f9f8e4c95..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().equals("unquote"))) { - return ((MalList)ast).nth(1); - } else if (is_pair(a0)) { - MalVal a00 = ((MalList)a0).nth(0); - if ((a00 instanceof MalSymbol) && - (((MalSymbol)a00).getName().equals("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 a109a88b2e..0000000000 --- a/java/src/main/java/mal/step8_macros.java +++ /dev/null @@ -1,270 +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().equals("unquote"))) { - return ((MalList)ast).nth(1); - } else if (is_pair(a0)) { - MalVal a00 = ((MalList)a0).nth(0); - if ((a00 instanceof MalSymbol) && - (((MalSymbol)a00).getName().equals("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 eval_ast(expanded, env); - } - 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 e5f77f5fac..0000000000 --- a/java/src/main/java/mal/step9_try.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 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().equals("unquote"))) { - return ((MalList)ast).nth(1); - } else if (is_pair(a0)) { - MalVal a00 = ((MalList)a0).nth(0); - if ((a00 instanceof MalSymbol) && - (((MalSymbol)a00).getName().equals("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 eval_ast(expanded, env); - } - 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 c4162c6ca7..0000000000 --- a/java/src/main/java/mal/stepA_mal.java +++ /dev/null @@ -1,305 +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().equals("unquote"))) { - return ((MalList)ast).nth(1); - } else if (is_pair(a0)) { - MalVal a00 = ((MalList)a0).nth(0); - if ((a00 instanceof MalSymbol) && - (((MalSymbol)a00).getName().equals("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 eval_ast(expanded, env); - } - 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, "(def! *gensym-counter* (atom 0))"); - RE(repl_env, "(def! gensym (fn* [] (symbol (str \"G__\" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))"); - RE(repl_env, "(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)))))))))"); - - 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/Dockerfile b/js/Dockerfile deleted file mode 100644 index 0559f7a9ad..0000000000 --- a/js/Dockerfile +++ /dev/null @@ -1,37 +0,0 @@ -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 node modules -RUN apt-get -y install g++ - -# Add nodesource apt repo config for 0.12 stable -RUN curl -sL https://deb.nodesource.com/setup_0.12 | bash - - -# Install nodejs -RUN apt-get -y install nodejs - -# Link common name -RUN ln -sf nodejs /usr/bin/node - -ENV NPM_CONFIG_CACHE /mal/.npm - diff --git a/js/Makefile b/js/Makefile deleted file mode 100644 index 72e71348e4..0000000000 --- a/js/Makefile +++ /dev/null @@ -1,43 +0,0 @@ - -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) - -all: node_modules - -dist: mal.js mal web/mal.js - -node_modules: - npm install - -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 - -.PHONY: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" - -tests: $(TESTS) - -$(TESTS): - @echo "Running $@"; \ - node $@ || exit 1; \ diff --git a/js/core.js b/js/core.js deleted file mode 100644 index 01dad97c50..0000000000 --- a/js/core.js +++ /dev/null @@ -1,259 +0,0 @@ -// Node vs browser behavior -var core = {}; -if (typeof module === 'undefined') { - var exports = core; -} else { - var types = require('./types'), - readline = require('./node_readline'), - reader = require('./reader'), - printer = require('./printer'), - interop = require('./interop'); -} - -// Errors/Exceptions -function mal_throw(exc) { throw exc; } - - -// String functions -function pr_str() { - return Array.prototype.map.call(arguments,function(exp) { - return printer._pr_str(exp, true); - }).join(" "); -} - -function str() { - return Array.prototype.map.call(arguments,function(exp) { - return printer._pr_str(exp, false); - }).join(""); -} - -function prn() { - printer.println.apply({}, Array.prototype.map.call(arguments,function(exp) { - return printer._pr_str(exp, true); - })); -} - -function println() { - printer.println.apply({}, Array.prototype.map.call(arguments,function(exp) { - return printer._pr_str(exp, false); - })); -} - -function slurp(f) { - if (typeof require !== 'undefined') { - return require('fs').readFileSync(f, 'utf-8'); - } else { - var req = new XMLHttpRequest(); - req.open("GET", f, false); - req.send(); - if (req.status == 200) { - return req.responseText; - } else { - throw new Error("Failed to slurp file: " + f); - } - } -} - - -// Number functions -function time_ms() { return new Date().getTime(); } - - -// Hash Map functions -function assoc(src_hm) { - var hm = types._clone(src_hm); - var args = [hm].concat(Array.prototype.slice.call(arguments, 1)); - return types._assoc_BANG.apply(null, args); -} - -function dissoc(src_hm) { - var hm = types._clone(src_hm); - var args = [hm].concat(Array.prototype.slice.call(arguments, 1)); - return types._dissoc_BANG.apply(null, args); -} - -function get(hm, key) { - if (hm != null && key in hm) { - return hm[key]; - } else { - return null; - } -} - -function contains_Q(hm, key) { - if (key in hm) { return true; } else { return false; } -} - -function keys(hm) { return Object.keys(hm); } -function vals(hm) { return Object.keys(hm).map(function(k) { return hm[k]; }); } - - -// Sequence functions -function cons(a, b) { return [a].concat(b); } - -function concat(lst) { - lst = lst || []; - return lst.concat.apply(lst, Array.prototype.slice.call(arguments, 1)); -} - -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 === null) ? null : lst[0]; } - -function rest(lst) { return (lst == null) ? [] : lst.slice(1); } - -function empty_Q(lst) { return lst.length === 0; } - -function count(s) { - if (Array.isArray(s)) { return s.length; } - else if (s === null) { return 0; } - else { return Object.keys(s).length; } -} - -function conj(lst) { - if (types._list_Q(lst)) { - return Array.prototype.slice.call(arguments, 1).reverse().concat(lst); - } else { - var v = lst.concat(Array.prototype.slice.call(arguments, 1)); - v.__isvector__ = true; - return v; - } -} - -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])); -} - -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, - 'string?': types._string_Q, - 'symbol': types._symbol, - 'symbol?': types._symbol_Q, - 'keyword': types._keyword, - 'keyword?': types._keyword_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; 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/step1_read_print.js b/js/step1_read_print.js deleted file mode 100644 index f1fb0269be..0000000000 --- a/js/step1_read_print.js +++ /dev/null @@ -1,41 +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, env) { - return ast; -} - -// print -function PRINT(exp) { - return printer._pr_str(exp, true); -} - -// repl -var re = function(str) { return EVAL(READ(str), {}); }; -var rep = function(str) { return PRINT(EVAL(READ(str), {})); }; - -// 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/step2_eval.js b/js/step2_eval.js deleted file mode 100644 index 42a60d2ab7..0000000000 --- a/js/step2_eval.js +++ /dev/null @@ -1,81 +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); - } - if (ast.length === 0) { - return ast; - } - - // 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 999531fcbb..0000000000 --- a/js/step3_env.js +++ /dev/null @@ -1,95 +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); - } - 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); - 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 3878b03915..0000000000 --- a/js/step4_if_fn_do.js +++ /dev/null @@ -1,111 +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); - } - 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); - 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 a449194aa9..0000000000 --- a/js/step5_tco.js +++ /dev/null @@ -1,122 +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); - } - 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); - 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 71b8eb5737..0000000000 --- a/js/step6_file.js +++ /dev/null @@ -1,132 +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); - } - 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); - 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(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/step7_quote.js b/js/step7_quote.js deleted file mode 100644 index 6f22844cd2..0000000000 --- a/js/step7_quote.js +++ /dev/null @@ -1,157 +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 (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 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); - } - 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); - 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(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/step8_macros.js b/js/step8_macros.js deleted file mode 100644 index fc8eb5fd2d..0000000000 --- a/js/step8_macros.js +++ /dev/null @@ -1,185 +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 (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 "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 3eac1c9804..0000000000 --- a/js/step9_try.js +++ /dev/null @@ -1,196 +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 (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! 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 b6dbab0c37..0000000000 --- a/js/stepA_mal.js +++ /dev/null @@ -1,200 +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 (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! *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)))))))))"); - -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 d23a1b2bc6..0000000000 --- a/js/tests/stepA_mal.mal +++ /dev/null @@ -1,39 +0,0 @@ -;; 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/types.js b/js/types.js deleted file mode 100644 index 6e7f196b05..0000000000 --- a/js/types.js +++ /dev/null @@ -1,224 +0,0 @@ -// 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 EVAL(x,env), ast) - elseif isa(ast, Dict) - [EVAL(x[1],env) => EVAL(x[2], env) for x=ast] - else - ast - end -end - -function EVAL(ast, env) - if !isa(ast, Array) return eval_ast(ast, env) 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 = eval_ast(ast, env) - 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/julia/step7_quote.jl b/julia/step7_quote.jl deleted file mode 100755 index 79dd652d26..0000000000 --- a/julia/step7_quote.jl +++ /dev/null @@ -1,145 +0,0 @@ -#!/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 ispair(ast) - (isa(ast, Array) || isa(ast, Tuple)) && length(ast) > 0 -end - -function quasiquote(ast) - if !ispair(ast) - [[:quote]; Any[ast]] - elseif ast[1] == :unquote - ast[2] - elseif ispair(ast[1]) && ast[1][1] == symbol("splice-unquote") - [[:concat]; Any[ast[1][2]]; Any[quasiquote(ast[2:end])]] - else - [[:cons]; Any[quasiquote(ast[1])]; Any[quasiquote(ast[2:end])]] - end -end - -function eval_ast(ast, env) - if typeof(ast) == Symbol - env_get(env,ast) - elseif isa(ast, Array) || isa(ast, Tuple) - map((x) -> EVAL(x,env), ast) - elseif isa(ast, Dict) - [EVAL(x[1],env) => EVAL(x[2], env) for x=ast] - else - ast - end -end - -function EVAL(ast, env) - while true - #println("EVAL: $(printer.pr_str(ast,true))") - if !isa(ast, Array) return eval_ast(ast, env) 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] - eval_ast(ast[2:end-1], env) - 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 = eval_ast(ast, env) - 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) \")\")))))") - -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/julia/step8_macros.jl b/julia/step8_macros.jl deleted file mode 100755 index e7b42c766e..0000000000 --- a/julia/step8_macros.jl +++ /dev/null @@ -1,174 +0,0 @@ -#!/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 ispair(ast) - (isa(ast, Array) || isa(ast, Tuple)) && length(ast) > 0 -end - -function quasiquote(ast) - if !ispair(ast) - [[:quote]; Any[ast]] - elseif ast[1] == :unquote - ast[2] - elseif ispair(ast[1]) && ast[1][1] == symbol("splice-unquote") - [[:concat]; Any[ast[1][2]]; Any[quasiquote(ast[2:end])]] - else - [[:cons]; Any[quasiquote(ast[1])]; Any[quasiquote(ast[2:end])]] - end -end - -function ismacroCall(ast, env) - return isa(ast, Array) && - !isempty(ast) && - isa(ast[1], Symbol) && - env_find(env, ast[1]) != nothing && - isa(env_get(env, ast[1]), MalFunc) && - env_get(env, ast[1]).ismacro -end - -function macroexpand(ast, env) - while ismacroCall(ast, env) - mac = env_get(env, ast[1]) - ast = mac.fn(ast[2:end]...) - end - ast -end - -function eval_ast(ast, env) - if typeof(ast) == Symbol - env_get(env,ast) - elseif isa(ast, Array) || isa(ast, Tuple) - map((x) -> EVAL(x,env), ast) - elseif isa(ast, Dict) - [EVAL(x[1],env) => EVAL(x[2], env) for x=ast] - else - ast - end -end - -function EVAL(ast, env) - while true - #println("EVAL: $(printer.pr_str(ast,true))") - if !isa(ast, Array) return eval_ast(ast, env) end - - # apply - ast = macroexpand(ast, env) - if !isa(ast, Array) return eval_ast(ast, env) end - 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 :macroexpand == ast[1] - return macroexpand(ast[2], env) - elseif :do == ast[1] - eval_ast(ast[2:end-1], env) - 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 = eval_ast(ast, env) - 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) \")\")))))") -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 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/julia/step9_try.jl b/julia/step9_try.jl deleted file mode 100755 index 868069a28e..0000000000 --- a/julia/step9_try.jl +++ /dev/null @@ -1,192 +0,0 @@ -#!/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 ispair(ast) - (isa(ast, Array) || isa(ast, Tuple)) && length(ast) > 0 -end - -function quasiquote(ast) - if !ispair(ast) - [[:quote]; Any[ast]] - elseif ast[1] == :unquote - ast[2] - elseif ispair(ast[1]) && ast[1][1] == symbol("splice-unquote") - [[:concat]; Any[ast[1][2]]; Any[quasiquote(ast[2:end])]] - else - [[:cons]; Any[quasiquote(ast[1])]; Any[quasiquote(ast[2:end])]] - end -end - -function ismacroCall(ast, env) - return isa(ast, Array) && - !isempty(ast) && - isa(ast[1], Symbol) && - env_find(env, ast[1]) != nothing && - isa(env_get(env, ast[1]), MalFunc) && - env_get(env, ast[1]).ismacro -end - -function macroexpand(ast, env) - while ismacroCall(ast, env) - mac = env_get(env, ast[1]) - ast = mac.fn(ast[2:end]...) - end - ast -end - -function eval_ast(ast, env) - if typeof(ast) == Symbol - env_get(env,ast) - elseif isa(ast, Array) || isa(ast, Tuple) - map((x) -> EVAL(x,env), ast) - elseif isa(ast, Dict) - [EVAL(x[1],env) => EVAL(x[2], env) for x=ast] - else - ast - end -end - -function EVAL(ast, env) - while true - #println("EVAL: $(printer.pr_str(ast,true))") - if !isa(ast, Array) return eval_ast(ast, env) end - - # apply - ast = macroexpand(ast, env) - if !isa(ast, Array) return eval_ast(ast, env) end - 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 :macroexpand == ast[1] - return macroexpand(ast[2], env) - 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] - eval_ast(ast[2:end-1], env) - 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 = eval_ast(ast, env) - 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) \")\")))))") -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 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/julia/stepA_mal.jl b/julia/stepA_mal.jl deleted file mode 100755 index 1f897cbdf4..0000000000 --- a/julia/stepA_mal.jl +++ /dev/null @@ -1,196 +0,0 @@ -#!/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 ispair(ast) - (isa(ast, Array) || isa(ast, Tuple)) && length(ast) > 0 -end - -function quasiquote(ast) - if !ispair(ast) - [[:quote]; Any[ast]] - elseif ast[1] == :unquote - ast[2] - elseif ispair(ast[1]) && ast[1][1] == symbol("splice-unquote") - [[:concat]; Any[ast[1][2]]; Any[quasiquote(ast[2:end])]] - else - [[:cons]; Any[quasiquote(ast[1])]; Any[quasiquote(ast[2:end])]] - end -end - -function ismacroCall(ast, env) - return isa(ast, Array) && - !isempty(ast) && - isa(ast[1], Symbol) && - env_find(env, ast[1]) != nothing && - isa(env_get(env, ast[1]), MalFunc) && - env_get(env, ast[1]).ismacro -end - -function macroexpand(ast, env) - while ismacroCall(ast, env) - mac = env_get(env, ast[1]) - ast = mac.fn(ast[2:end]...) - end - ast -end - -function eval_ast(ast, env) - if typeof(ast) == Symbol - env_get(env,ast) - elseif isa(ast, Array) || isa(ast, Tuple) - map((x) -> EVAL(x,env), ast) - elseif isa(ast, Dict) - [EVAL(x[1],env) => EVAL(x[2], env) for x=ast] - else - ast - end -end - -function EVAL(ast, env) - while true - #println("EVAL: $(printer.pr_str(ast,true))") - if !isa(ast, Array) return eval_ast(ast, env) end - - # apply - ast = macroexpand(ast, env) - if !isa(ast, Array) return eval_ast(ast, env) end - 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 :macroexpand == ast[1] - return macroexpand(ast[2], env) - 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] - eval_ast(ast[2:end-1], env) - 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 = eval_ast(ast, env) - 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! *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) \")\")))))") -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! *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)))))))))") - - -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/kotlin/Dockerfile b/kotlin/Dockerfile deleted file mode 100644 index 2d3ae15aa7..0000000000 --- a/kotlin/Dockerfile +++ /dev/null @@ -1,34 +0,0 @@ -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 -########################################################## - -# Java and Zip -RUN apt-get -y install openjdk-7-jdk -RUN apt-get -y install unzip - -RUN curl -O -J -L https://github.com/JetBrains/kotlin/releases/download/build-1.0.0/kotlin-compiler-1.0.0.zip - -RUN mkdir -p /kotlin-compiler -RUN unzip kotlin-compiler-1.0.0.zip -d /kotlin-compiler - -ENV KOTLIN_HOME /kotlin-compiler/kotlinc -ENV PATH $KOTLIN_HOME/bin:$PATH diff --git a/kotlin/Makefile b/kotlin/Makefile deleted file mode 100644 index 8e729689cc..0000000000 --- a/kotlin/Makefile +++ /dev/null @@ -1,34 +0,0 @@ -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 - -SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) -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 $@ - -.PHONY: stats - -stats: $(SOURCES:%.kt=src/mal/%.kt) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" - -stats-lisp: $(SOURCES_LISP:%.kt=src/mal/%.kt) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" diff --git a/kotlin/run b/kotlin/run deleted file mode 100755 index 8840277bd1..0000000000 --- a/kotlin/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec java -jar $(dirname $0)/${STEP:-stepA_mal}.jar "${@}" diff --git a/kotlin/src/mal/step2_eval.kt b/kotlin/src/mal/step2_eval.kt deleted file mode 100644 index 630745a1c0..0000000000 --- a/kotlin/src/mal/step2_eval.kt +++ /dev/null @@ -1,45 +0,0 @@ -package mal - -fun read(input: String?): MalType = read_str(input) - -fun eval(ast: MalType, env: Map): MalType = - if (ast is MalList && ast.count() > 0) { - val evaluated = eval_ast(ast, env) as ISeq - if (evaluated.first() !is MalFunction) throw MalException("cannot execute non-function") - (evaluated.first() as MalFunction).apply(evaluated.rest()) - } else eval_ast(ast, env) - -fun eval_ast(ast: MalType, env: Map): MalType = - when (ast) { - is MalSymbol -> env[ast.value] ?: throw MalException("'${ast.value}' not found") - is MalList -> ast.elements.fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) - is MalVector -> ast.elements.fold(MalVector(), { a, b -> a.conj_BANG(eval(b, env)); a }) - is MalHashMap -> ast.elements.entries.fold(MalHashMap(), { a, b -> a.assoc_BANG(b.key, eval(b.value, env)); a }) - else -> 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/kotlin/src/mal/step3_env.kt b/kotlin/src/mal/step3_env.kt deleted file mode 100644 index 021ac4875d..0000000000 --- a/kotlin/src/mal/step3_env.kt +++ /dev/null @@ -1,61 +0,0 @@ -package mal - -fun read(input: String?): MalType = read_str(input) - -fun eval(ast: MalType, env: Env): MalType = - if (ast is MalList && ast.count() > 0) { - val first = ast.first() - if (first is MalSymbol && first.value == "def!") { - 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) - } - eval(ast.nth(2), child) - } else { - val evaluated = eval_ast(ast, env) as ISeq - if (evaluated.first() !is MalFunction) throw MalException("cannot execute non-function") - (evaluated.first() as MalFunction).apply(evaluated.rest()) - } - } else eval_ast(ast, env) - -fun eval_ast(ast: MalType, env: Env): MalType = - when (ast) { - is MalSymbol -> env.get(ast) - is MalList -> ast.elements.fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) - is MalVector -> ast.elements.fold(MalVector(), { a, b -> a.conj_BANG(eval(b, env)); a }) - is MalHashMap -> ast.elements.entries.fold(MalHashMap(), { a, b -> a.assoc_BANG(b.key, eval(b.value, env)); a }) - else -> 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/kotlin/src/mal/step4_if_fn_do.kt b/kotlin/src/mal/step4_if_fn_do.kt deleted file mode 100644 index ff7ae5c58b..0000000000 --- a/kotlin/src/mal/step4_if_fn_do.kt +++ /dev/null @@ -1,103 +0,0 @@ -package mal - -fun read(input: String?): MalType = read_str(input) - -fun eval(ast: MalType, env: Env): MalType = - if (ast is MalList && ast.count() > 0) { - val first = ast.first() - if (first is MalSymbol) { - when (first.value) { - "def!" -> eval_def_BANG(ast, env) - "let*" -> eval_let_STAR(ast, env) - "fn*" -> eval_fn_STAR(ast, env) - "do" -> eval_do(ast, env) - "if" -> eval_if(ast, env) - else -> eval_function_call(ast, env) - } - } else eval_function_call(ast, env) - } else eval_ast(ast, env) - -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 = - (eval_ast(MalList(ast.rest()), env) as ISeq).seq().last() - -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: ISeq, env: Env): MalType { - val evaluated = eval_ast(ast, env) as ISeq - val first = evaluated.first() as? MalFunction ?: throw MalException("cannot execute non-function") - return first.apply(evaluated.rest()) -} - -fun eval_ast(ast: MalType, env: Env): MalType = - when (ast) { - is MalSymbol -> env.get(ast) - is MalList -> ast.elements.fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) - is MalVector -> ast.elements.fold(MalVector(), { a, b -> a.conj_BANG(eval(b, env)); a }) - is MalHashMap -> ast.elements.entries.fold(MalHashMap(), { a, b -> a.assoc_BANG(b.key, eval(b.value, env)); a }) - else -> ast - } - -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/kotlin/src/mal/step7_quote.kt b/kotlin/src/mal/step7_quote.kt deleted file mode 100644 index b8d4ab46d0..0000000000 --- a/kotlin/src/mal/step7_quote.kt +++ /dev/null @@ -1,148 +0,0 @@ -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) { - if (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" -> { - eval_ast(ast.slice(1, ast.count() - 1), 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 = eval_ast(ast, env) as ISeq - 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") - } - } - } - } else return eval_ast(ast, env) - } -} - -fun eval_ast(ast: MalType, env: Env): MalType = - when (ast) { - is MalSymbol -> env.get(ast) - is MalList -> ast.elements.fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) - is MalVector -> ast.elements.fold(MalVector(), { a, b -> a.conj_BANG(eval(b, env)); a }) - is MalHashMap -> ast.elements.entries.fold(MalHashMap(), { a, b -> a.assoc_BANG(b.key, eval(b.value, env)); a }) - else -> 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 is_pair(ast: MalType): Boolean = ast is ISeq && ast.seq().any() - -private fun quasiquote(ast: MalType): MalType { - if (!is_pair(ast)) { - val quoted = MalList() - quoted.conj_BANG(MalSymbol("quote")) - quoted.conj_BANG(ast) - return quoted - } - - val seq = ast as ISeq - var first = seq.first() - - if ((first as? MalSymbol)?.value == "unquote") { - return seq.nth(1) - } - - if (is_pair(first) && ((first as ISeq).first() as? MalSymbol)?.value == "splice-unquote") { - val spliced = MalList() - spliced.conj_BANG(MalSymbol("concat")) - spliced.conj_BANG(first.nth(1)) - spliced.conj_BANG(quasiquote(MalList(seq.seq().drop(1).toCollection(LinkedList())))) - return spliced - } - - val consed = MalList() - consed.conj_BANG(MalSymbol("cons")) - consed.conj_BANG(quasiquote(ast.first())) - consed.conj_BANG(quasiquote(MalList(seq.seq().drop(1).toCollection(LinkedList())))) - return consed -} - -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) \")\")))))", 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/kotlin/src/mal/step8_macros.kt b/kotlin/src/mal/step8_macros.kt deleted file mode 100644 index 929ccfb27c..0000000000 --- a/kotlin/src/mal/step8_macros.kt +++ /dev/null @@ -1,180 +0,0 @@ -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) { - ast = macroexpand(ast, env) - - if (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" -> { - eval_ast(ast.slice(1, ast.count() - 1), 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) - "macroexpand" -> return macroexpand(ast.nth(1), env) - else -> { - val evaluated = eval_ast(ast, env) as ISeq - 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") - } - } - } - } else return eval_ast(ast, env) - } -} - -fun eval_ast(ast: MalType, env: Env): MalType = - when (ast) { - is MalSymbol -> env.get(ast) - is MalList -> ast.elements.fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) - is MalVector -> ast.elements.fold(MalVector(), { a, b -> a.conj_BANG(eval(b, env)); a }) - is MalHashMap -> ast.elements.entries.fold(MalHashMap(), { a, b -> a.assoc_BANG(b.key, eval(b.value, env)); a }) - else -> 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 is_pair(ast: MalType): Boolean = ast is ISeq && ast.seq().any() - -private fun quasiquote(ast: MalType): MalType { - if (!is_pair(ast)) { - val quoted = MalList() - quoted.conj_BANG(MalSymbol("quote")) - quoted.conj_BANG(ast) - return quoted - } - - val seq = ast as ISeq - var first = seq.first() - - if ((first as? MalSymbol)?.value == "unquote") { - return seq.nth(1) - } - - if (is_pair(first) && ((first as ISeq).first() as? MalSymbol)?.value == "splice-unquote") { - val spliced = MalList() - spliced.conj_BANG(MalSymbol("concat")) - spliced.conj_BANG(first.nth(1)) - spliced.conj_BANG(quasiquote(MalList(seq.seq().drop(1).toCollection(LinkedList())))) - return spliced - } - - val consed = MalList() - consed.conj_BANG(MalSymbol("cons")) - consed.conj_BANG(quasiquote(ast.first())) - consed.conj_BANG(quasiquote(MalList(seq.seq().drop(1).toCollection(LinkedList())))) - return consed -} - -private fun is_macro_call(ast: MalType, env: Env): Boolean { - val ast_list = ast as? MalList ?: return false - if (ast_list.count() == 0) return false - val symbol = ast_list.first() as? MalSymbol ?: return false - val function = env.find(symbol) as? MalFunction ?: return false - - return function.is_macro -} - -private fun macroexpand(_ast: MalType, env: Env): MalType { - var ast = _ast - while (is_macro_call(ast, env)) { - val symbol = (ast as MalList).first() as MalSymbol - val function = env.find(symbol) as MalFunction - ast = function.apply(ast.rest()) - } - return ast -} - -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) \")\")))))", 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 (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/kotlin/src/mal/step9_try.kt b/kotlin/src/mal/step9_try.kt deleted file mode 100644 index ddead51e72..0000000000 --- a/kotlin/src/mal/step9_try.kt +++ /dev/null @@ -1,195 +0,0 @@ -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) { - ast = macroexpand(ast, env) - - if (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" -> { - eval_ast(ast.slice(1, ast.count() - 1), 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) - "macroexpand" -> return macroexpand(ast.nth(1), env) - "try*" -> return try_catch(ast, env) - else -> { - val evaluated = eval_ast(ast, env) as ISeq - 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") - } - } - } - } else return eval_ast(ast, env) - } -} - -fun eval_ast(ast: MalType, env: Env): MalType = - when (ast) { - is MalSymbol -> env.get(ast) - is MalList -> ast.elements.fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) - is MalVector -> ast.elements.fold(MalVector(), { a, b -> a.conj_BANG(eval(b, env)); a }) - is MalHashMap -> ast.elements.entries.fold(MalHashMap(), { a, b -> a.assoc_BANG(b.key, eval(b.value, env)); a }) - else -> 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 is_pair(ast: MalType): Boolean = ast is ISeq && ast.seq().any() - -private fun quasiquote(ast: MalType): MalType { - if (!is_pair(ast)) { - val quoted = MalList() - quoted.conj_BANG(MalSymbol("quote")) - quoted.conj_BANG(ast) - return quoted - } - - val seq = ast as ISeq - var first = seq.first() - - if ((first as? MalSymbol)?.value == "unquote") { - return seq.nth(1) - } - - if (is_pair(first) && ((first as ISeq).first() as? MalSymbol)?.value == "splice-unquote") { - val spliced = MalList() - spliced.conj_BANG(MalSymbol("concat")) - spliced.conj_BANG(first.nth(1)) - spliced.conj_BANG(quasiquote(MalList(seq.seq().drop(1).toCollection(LinkedList())))) - return spliced - } - - val consed = MalList() - consed.conj_BANG(MalSymbol("cons")) - consed.conj_BANG(quasiquote(ast.first())) - consed.conj_BANG(quasiquote(MalList(seq.seq().drop(1).toCollection(LinkedList())))) - return consed -} - -private fun is_macro_call(ast: MalType, env: Env): Boolean { - val ast_list = ast as? MalList ?: return false - if (ast_list.count() == 0) return false - val symbol = ast_list.first() as? MalSymbol ?: return false - val function = env.find(symbol) as? MalFunction ?: return false - - return function.is_macro -} - -private fun macroexpand(_ast: MalType, env: Env): MalType { - var ast = _ast - while (is_macro_call(ast, env)) { - val symbol = (ast as MalList).first() as MalSymbol - val function = env.find(symbol) as MalFunction - ast = function.apply(ast.rest()) - } - return ast -} - -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) { - 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) \")\")))))", 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 (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/kotlin/src/mal/stepA_mal.kt b/kotlin/src/mal/stepA_mal.kt deleted file mode 100644 index 062d2fa0b8..0000000000 --- a/kotlin/src/mal/stepA_mal.kt +++ /dev/null @@ -1,198 +0,0 @@ -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) { - ast = macroexpand(ast, env) - - if (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" -> { - eval_ast(ast.slice(1, ast.count() - 1), 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) - "macroexpand" -> return macroexpand(ast.nth(1), env) - "try*" -> return try_catch(ast, env) - else -> { - val evaluated = eval_ast(ast, env) as ISeq - 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") - } - } - } - } else return eval_ast(ast, env) - } -} - -fun eval_ast(ast: MalType, env: Env): MalType = - when (ast) { - is MalSymbol -> env.get(ast) - is MalList -> ast.elements.fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) - is MalVector -> ast.elements.fold(MalVector(), { a, b -> a.conj_BANG(eval(b, env)); a }) - is MalHashMap -> ast.elements.entries.fold(MalHashMap(), { a, b -> a.assoc_BANG(b.key, eval(b.value, env)); a }) - else -> 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 is_pair(ast: MalType): Boolean = ast is ISeq && ast.seq().any() - -private fun quasiquote(ast: MalType): MalType { - if (!is_pair(ast)) { - val quoted = MalList() - quoted.conj_BANG(MalSymbol("quote")) - quoted.conj_BANG(ast) - return quoted - } - - val seq = ast as ISeq - var first = seq.first() - - if ((first as? MalSymbol)?.value == "unquote") { - return seq.nth(1) - } - - if (is_pair(first) && ((first as ISeq).first() as? MalSymbol)?.value == "splice-unquote") { - val spliced = MalList() - spliced.conj_BANG(MalSymbol("concat")) - spliced.conj_BANG(first.nth(1)) - spliced.conj_BANG(quasiquote(MalList(seq.seq().drop(1).toCollection(LinkedList())))) - return spliced - } - - val consed = MalList() - consed.conj_BANG(MalSymbol("cons")) - consed.conj_BANG(quasiquote(ast.first())) - consed.conj_BANG(quasiquote(MalList(seq.seq().drop(1).toCollection(LinkedList())))) - return consed -} - -private fun is_macro_call(ast: MalType, env: Env): Boolean { - val ast_list = ast as? MalList ?: return false - if (ast_list.count() == 0) return false - val symbol = ast_list.first() as? MalSymbol ?: return false - val function = env.find(symbol) as? MalFunction ?: return false - - return function.is_macro -} - -private fun macroexpand(_ast: MalType, env: Env): MalType { - var ast = _ast - while (is_macro_call(ast, env)) { - val symbol = (ast as MalList).first() as MalSymbol - val function = env.find(symbol) as MalFunction - ast = function.apply(ast.rest()) - } - return ast -} - -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) { - 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) \")\")))))", 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! *gensym-counter* (atom 0))", repl_env) - rep("(def! gensym (fn* [] (symbol (str \"G__\" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))", repl_env) - 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)))))))))", 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/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/Dockerfile b/lua/Dockerfile deleted file mode 100644 index f7bc915f29..0000000000 --- a/lua/Dockerfile +++ /dev/null @@ -1,30 +0,0 @@ -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 -########################################################## - -# Lua -RUN apt-get -y install lua5.1 lua-rex-pcre luarocks -RUN luarocks install linenoise -RUN luarocks install luasocket - -# luarocks .cache directory is relative to HOME -ENV HOME /mal diff --git a/lua/Makefile b/lua/Makefile deleted file mode 100644 index 042e3b0cde..0000000000 --- a/lua/Makefile +++ /dev/null @@ -1,47 +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 - -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 linenoise.so mal.lua mal - rm -rf lib/lua/5.1 - -.PHONY: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*--|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*--|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" - - -.PHONY: libs -libs: linenoise.so - -linenoise.so: - luarocks install --tree=./ linenoise - ln -sf lib/lua/5.1/linenoise.so $@ - 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 f64559cea6..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' or types._functionref_Q(obj) then - return "#" - else - return string.format("%s", obj) - end -end - -return M diff --git a/lua/run b/lua/run deleted file mode 100755 index f73e5b6f8f..0000000000 --- a/lua/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec lua $(dirname $0)/${STEP:-stepA_mal}.lua "${@}" diff --git a/lua/step3_env.lua b/lua/step3_env.lua deleted file mode 100755 index 24cdfc7459..0000000000 --- a/lua/step3_env.lua +++ /dev/null @@ -1,93 +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] - if not a0 then return ast end - 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 46302d1b6f..0000000000 --- a/lua/step4_if_fn_do.lua +++ /dev/null @@ -1,111 +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] - if not a0 then return ast end - 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 b3d77950fd..0000000000 --- a/lua/step5_tco.lua +++ /dev/null @@ -1,119 +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] - if not a0 then return ast end - 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 63d0208aa0..0000000000 --- a/lua/step6_file.lua +++ /dev/null @@ -1,129 +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] - if not a0 then return ast end - 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 e978d681c7..0000000000 --- a/lua/step7_quote.lua +++ /dev/null @@ -1,155 +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] - if not a0 then return ast end - 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 800833cca8..0000000000 --- a/lua/step8_macros.lua +++ /dev/null @@ -1,184 +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 eval_ast(ast, env) end - - local a0,a1,a2,a3 = ast[1], ast[2],ast[3],ast[4] - if not a0 then return ast end - 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 a7a1db8f76..0000000000 --- a/lua/step9_try.lua +++ /dev/null @@ -1,204 +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 eval_ast(ast, env) end - - local a0,a1,a2,a3 = ast[1], ast[2],ast[3],ast[4] - if not a0 then return ast end - 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 4dc5d571c6..0000000000 --- a/lua/stepA_mal.lua +++ /dev/null @@ -1,208 +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 eval_ast(ast, env) end - - local a0,a1,a2,a3 = ast[1], ast[2],ast[3],ast[4] - if not a0 then return ast end - 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("(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)))))))))") - -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/tests/stepA_mal.mal b/lua/tests/stepA_mal.mal deleted file mode 100644 index b52a902ae3..0000000000 --- a/lua/tests/stepA_mal.mal +++ /dev/null @@ -1,38 +0,0 @@ -;; 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/make/Dockerfile b/make/Dockerfile deleted file mode 100644 index 5f61062ee3..0000000000 --- a/make/Dockerfile +++ /dev/null @@ -1,24 +0,0 @@ -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 -########################################################## - -# Nothing additional needed for make diff --git a/make/Makefile b/make/Makefile deleted file mode 100644 index 913ae19dd1..0000000000 --- a/make/Makefile +++ /dev/null @@ -1,38 +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) - -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: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*#|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*#|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" - -tests: $(TESTS) - -$(TESTS): - @echo "Running $@"; \ - make -f $@ || exit 1; \ diff --git a/make/core.mk b/make/core.mk deleted file mode 100644 index 1497527ec3..0000000000 --- a/make/core.mk +++ /dev/null @@ -1,299 +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)),$(if $(call _keyword?,$(1)),$(__false),$(__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))) - -# 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,list,\ - $(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)))))) - -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))))))) - -seq = $(strip\ - $(if $(call _list?,$(1)),\ - $(if $(call _EQ,0,$(call _count,$(1))),$(__nil),$(1)),\ - $(if $(call _vector?,$(1)),\ - $(if $(call _EQ,0,$(call _count,$(1))),\ - $(__nil),\ - $(word 1,$(foreach new_list,$(call _list),\ - $(new_list) \ - $(eval $(new_list)_value := $(strip $($(word 1,$(1))_value)))))),\ - $(if $(call _EQ,string,$(call _obj_type,$(1))),\ - $(if $(call _EQ,0,$(call _count,$(1))),\ - $(__nil),\ - $(word 1,$(foreach new_list,$(call _list),\ - $(new_list) \ - $(eval $(new_list)_value := $(strip \ - $(foreach c,$($(word 1,$(1))_value),\ - $(call _string,$(c)))))))),\ - $(if $(call _nil?,$(1)),\ - $(__nil),\ - $(call _error,seq: called on non-sequence)))))) - -# 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? \ - string? string? \ - symbol symbol \ - symbol? symbol? \ - keyword keyword \ - keyword? keyword? \ - function? function? \ - \ - 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 \ - apply sapply \ - map smap \ - \ - conj conj \ - seq seq \ - \ - 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/printer.mk b/make/printer.mk deleted file mode 100644 index dda5ee63b0..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 $(NEWLINE),$(ESC_N),$(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 6f2707c029..0000000000 --- a/make/reader.mk +++ /dev/null @@ -1,197 +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 $(MINUS) $(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 - -# $(_NL) is used here instead of $(NEWLINE) because $(strip) removes -# $(NEWLINE). str_encode will just pass through $(_NL) so str_decode -# later will restore a correct newline -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 $(and $(filter \,$(ch)),$(filter n,$(word 2,$($(1))))),\ - $(eval $(1) := $(wordlist 3,$(words $($(1))),$($(1))))\ - $(and $(READER_DEBUG),$(info READ_STRING ch: \$(word 1,$($(1))) | $($(1))))\ - $(_NL) $(strip $(call READ_STRING,$(1))),\ - $(if $(and $(filter \,$(ch)),$(filter \,$(word 2,$($(1))))),\ - $(eval $(1) := $(wordlist 3,$(words $($(1))),$($(1))))\ - $(and $(READER_DEBUG),$(info READ_STRING ch: \$(word 1,$($(1))) | $($(1))))\ - \ $(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 $(and $(filter $(MINUS),$(ch)),$(filter $(NUMBERS),$(word 2,$($(1))))),\ - $(call _number,$(call READ_NUMBER,$(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 69f5960756..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}" && echo "$${line}" || echo "__||EOF||__"; history -a $(READLINE_HISTORY_FILE) 2>/dev/null || true))$(if $(filter __||EOF||__,$(__readline_temp)),$(eval READLINE_EOF := yes),$(__readline_temp)) - -endif diff --git a/make/run b/make/run deleted file mode 100755 index f897b62de8..0000000000 --- a/make/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec make --no-print-directory -f $(dirname $0)/${STEP:-stepA_mal}.mk "${@}" 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 0fed27c7d3..0000000000 --- a/make/step2_eval.mk +++ /dev/null @@ -1,75 +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)),\ - $(if $(call _EQ,0,$(call _count,$(1))),\ - $(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 810e296501..0000000000 --- a/make/step3_env.mk +++ /dev/null @@ -1,98 +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)),\ - $(if $(call _EQ,0,$(call _count,$(1))),\ - $(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 0fa266d691..0000000000 --- a/make/step4_if_fn_do.mk +++ /dev/null @@ -1,116 +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)),\ - $(if $(call _EQ,0,$(call _count,$(1))),\ - $(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 a8555dfa51..0000000000 --- a/make/step6_file.mk +++ /dev/null @@ -1,131 +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)),\ - $(if $(call _EQ,0,$(call _count,$(1))),\ - $(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 d1f6bca12f..0000000000 --- a/make/step7_quote.mk +++ /dev/null @@ -1,148 +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)),\ - $(if $(call _EQ,0,$(call _count,$(1))),\ - $(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 7ea351edec..0000000000 --- a/make/step8_macros.mk +++ /dev/null @@ -1,173 +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)),\ - $(if $(call _EQ,0,$(call _count,$(ast))),\ - $(ast),\ - $(word 1,$(strip $(call EVAL_INVOKE,$(ast),$(2)) $(__nil)))),\ - $(call EVAL_AST,$(ast),$(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)) - -# 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 47d1fd72f2..0000000000 --- a/make/step9_try.mk +++ /dev/null @@ -1,188 +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)),\ - $(if $(call _EQ,0,$(call _count,$(ast))),\ - $(ast),\ - $(word 1,$(strip $(call EVAL_INVOKE,$(ast),$(2)) $(__nil)))),\ - $(call EVAL_AST,$(ast),$(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)) - -# 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 5e3642076f..0000000000 --- a/make/stepA_mal.mk +++ /dev/null @@ -1,197 +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)),\ - $(if $(call _EQ,0,$(call _count,$(ast))),\ - $(ast),\ - $(word 1,$(strip $(call EVAL_INVOKE,$(ast),$(2)) $(__nil)))),\ - $(call EVAL_AST,$(ast),$(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)) - -# 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, (def! *gensym-counter* (atom 0)) )) -$(call do,$(call REP, (def! gensym (fn* [] (symbol (str "G__" (swap! *gensym-counter* (fn* [x] (+ 1 x))))))) )) -$(call do,$(call 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))))))))) )) - -# 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 43016e5a6e..0000000000 --- a/make/types.mk +++ /dev/null @@ -1,266 +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)))) - -_hash_equal? = $(strip \ - $(if $(and $(call _EQ,$(foreach v,$(call __get_obj_values,$(1)),$(word 4,$(subst _, ,$(v)))),$(foreach v,$(call __get_obj_values,$(2)),$(word 4,$(subst _, ,$(v))))),\ - $(call _EQ,$(call _count,$(1)),$(words $(call gmsl_pairmap,_equal?,$(foreach v,$(call __get_obj_values,$(1)),$($(v))),$(foreach v,$(call __get_obj_values,$(2)),$($(v))))))),\ - $(__true),)) - -_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 $(call _hash_map?,$(1)),\ - $(call _hash_equal?,$(1),$(2)),\ - $(if $(or $(call _vector?,$(1)),$(call _list?,$(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 bee3e319fa..0000000000 --- a/make/util.mk +++ /dev/null @@ -1,99 +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) -ESC_N := $(SLASH)n -SQUOTE := '# ' -QQUOTE := `# ` -SPACE := -SPACE += -MINUS := - -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 2601d07680..0000000000 --- a/mal.html +++ /dev/null @@ -1,297 +0,0 @@ - - - - - - - - - - - - - - Mal Web REPL - - - - - - - - - - diff --git a/mal/Dockerfile b/mal/Dockerfile deleted file mode 100644 index 0559f7a9ad..0000000000 --- a/mal/Dockerfile +++ /dev/null @@ -1,37 +0,0 @@ -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 node modules -RUN apt-get -y install g++ - -# Add nodesource apt repo config for 0.12 stable -RUN curl -sL https://deb.nodesource.com/setup_0.12 | bash - - -# Install nodejs -RUN apt-get -y install nodejs - -# Link common name -RUN ln -sf nodejs /usr/bin/node - -ENV NPM_CONFIG_CACHE /mal/.npm - diff --git a/mal/Makefile b/mal/Makefile deleted file mode 100644 index 322c9cad5c..0000000000 --- a/mal/Makefile +++ /dev/null @@ -1,30 +0,0 @@ - -TESTS = - -SOURCES_BASE = -SOURCES_LISP = env.mal core.mal stepA_mal.mal -SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) - -all: mal.mal - -mal.mal: stepA_mal.mal - cp $< $@ - -clean: - rm -f mal.mal - -#.PHONY: stats tests $(TESTS) -.PHONY: stats - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*;|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*;|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" - -#tests: $(TESTS) -# -#$(TESTS): -# @echo "Running $@"; \ -# python $@ || exit 1; \ diff --git a/mal/core.mal b/mal/core.mal deleted file mode 100644 index a766b80125..0000000000 --- a/mal/core.mal +++ /dev/null @@ -1,63 +0,0 @@ -(def! core_ns - [["=" =] - ["throw" throw] - ["nil?" nil?] - ["true?" true?] - ["false?" false?] - ["string?" string?] - ["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] - ["<" <] - ["<=" <=] - [">" >] - [">=" >=] - ["+" +] - ["-" -] - ["*" *] - ["/" /] - ["time-ms" time-ms] - - ["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] - ["apply" apply] - ["map" map] - - ["conj" conj] - ["seq" seq] - - ["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/run b/mal/run deleted file mode 100755 index a6f4bfe8d1..0000000000 --- a/mal/run +++ /dev/null @@ -1,5 +0,0 @@ -#!/bin/bash -cd $(dirname $0) -MAL_FILE=./../mal/${STEP:-stepA_mal}.mal -export STEP=stepA_mal # force MAL_IMPL to use stepA -exec ./../${MAL_IMPL:-js}/run ${MAL_FILE} "${@}" diff --git a/mal/step0_repl.mal b/mal/step0_repl.mal deleted file mode 100644 index 723c83c4ea..0000000000 --- a/mal/step0_repl.mal +++ /dev/null @@ -1,30 +0,0 @@ -;; read -(def! READ (fn* [strng] - strng)) - -;; eval -(def! EVAL (fn* [ast env] - ast)) - -;; print -(def! PRINT (fn* [exp] 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/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 173b6b9ad0..0000000000 --- a/mal/step2_eval.mal +++ /dev/null @@ -1,64 +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 - (if (empty? ast) - ast - (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 985e644d9b..0000000000 --- a/mal/step3_env.mal +++ /dev/null @@ -1,85 +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 - (nil? a0) - ast - - (= '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 b72cd83ee1..0000000000 --- a/mal/step4_if_fn_do.mal +++ /dev/null @@ -1,103 +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 - (nil? a0) - ast - - (= '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 23df09aa50..0000000000 --- a/mal/step6_file.mal +++ /dev/null @@ -1,108 +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 - (nil? a0) - ast - - (= '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 85a742342f..0000000000 --- a/mal/step7_quote.mal +++ /dev/null @@ -1,136 +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 - (nil? a0) - ast - - (= '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 ece64b77bd..0000000000 --- a/mal/step8_macros.mal +++ /dev/null @@ -1,170 +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)) - (eval-ast ast env) - - (let* [a0 (first ast)] - (cond - (nil? a0) - ast - - (= '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 4e52a1b3c6..0000000000 --- a/mal/step9_try.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)) - (eval-ast ast env) - - (let* [a0 (first ast)] - (cond - (nil? a0) - ast - - (= '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 d4e53de505..0000000000 --- a/mal/stepA_mal.mal +++ /dev/null @@ -1,186 +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)) - (eval-ast ast env) - - (let* [a0 (first ast)] - (cond - (nil? a0) - ast - - (= '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 "(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)))))))))") - -;; 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/Dockerfile b/matlab/Dockerfile deleted file mode 100644 index ea9afaa046..0000000000 --- a/matlab/Dockerfile +++ /dev/null @@ -1,34 +0,0 @@ -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 -########################################################## - -# Java and maven deps -RUN apt-get -y install openjdk-7-jdk -RUN apt-get -y install maven2 -ENV MAVEN_OPTS -Duser.home=/mal - -# GNU Octave -RUN apt-get -y install software-properties-common && \ - apt-add-repository -y ppa:octave/stable && \ - apt-get -y update && \ - apt-get -y install octave - diff --git a/matlab/Env.m b/matlab/Env.m deleted file mode 100644 index d541a14348..0000000000 --- a/matlab/Env.m +++ /dev/null @@ -1,67 +0,0 @@ -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 = 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 - if exist('OCTAVE_VERSION', 'builtin') ~= 0 - error('ENV:notfound', ... - sprintf('''%s'' not found', k.name)); - else - throw(MException('ENV:notfound', ... - sprintf('''%s'' not found', k.name))); - end - end - end - end -end diff --git a/matlab/Makefile b/matlab/Makefile deleted file mode 100644 index 1363956831..0000000000 --- a/matlab/Makefile +++ /dev/null @@ -1,20 +0,0 @@ -SOURCES_BASE = type_utils.m Dict.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) - -all: - -clean: - -.PHONY: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*%|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" - -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*%|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" diff --git a/matlab/core.m b/matlab/core.m deleted file mode 100644 index 4354f3a218..0000000000 --- a/matlab/core.m +++ /dev/null @@ -1,290 +0,0 @@ -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) - 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 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 - throw(MException('Type:seq',... - 'seq: called on non-sequence')) - 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('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('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/matlab/reader.m b/matlab/reader.m deleted file mode 100644 index ada1af6f1b..0000000000 --- a/matlab/reader.m +++ /dev/null @@ -1,125 +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)); - atm = strrep(atm, '\\', '\'); - 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''', 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); - %disp(tokens); - rdr = types.Reader(tokens); - ast = reader.read_form(rdr); - end - end -end diff --git a/matlab/run b/matlab/run deleted file mode 100755 index 1cb6ecbbea..0000000000 --- a/matlab/run +++ /dev/null @@ -1,13 +0,0 @@ -#!/bin/bash -args="" -if [ "$#" -gt 0 ]; then - args="'$1'" - for a in "${@:2}"; do - args="$args,'$a'" - done -fi -if [ -n "$USE_MATLAB" ] ; then - exec matlab -nodisplay -nosplash -nodesktop -nojvm -r "${STEP:-stepA_mal}($args);quit;" -else - exec octave --no-gui --no-history -q --traditional --eval "${STEP:-stepA_mal}($args);quit;" -fi diff --git a/matlab/step2_eval.m b/matlab/step2_eval.m deleted file mode 100644 index cb426d21d2..0000000000 --- a/matlab/step2_eval.m +++ /dev/null @@ -1,89 +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 ~type_utils.list_Q(ast) - ret = eval_ast(ast, env); - return; - end - - % apply - if length(ast) == 0 - ret = ast; - return; - end - 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) - 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/matlab/step3_env.m b/matlab/step3_env.m deleted file mode 100644 index 429539eb8e..0000000000 --- a/matlab/step3_env.m +++ /dev/null @@ -1,101 +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 ~type_utils.list_Q(ast) - ret = eval_ast(ast, env); - 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 - 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(); - 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/matlab/step4_if_fn_do.m b/matlab/step4_if_fn_do.m deleted file mode 100644 index 05cab719bc..0000000000 --- a/matlab/step4_if_fn_do.m +++ /dev/null @@ -1,125 +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 ~type_utils.list_Q(ast) - ret = eval_ast(ast, env); - 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' - 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 = 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 - 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(); - - % 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/matlab/step5_tco.m b/matlab/step5_tco.m deleted file mode 100644 index dae02b5c05..0000000000 --- a/matlab/step5_tco.m +++ /dev/null @@ -1,138 +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 ~type_utils.list_Q(ast) - ret = eval_ast(ast, env); - 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' - 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 = 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 - 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(); - - % 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/matlab/step6_file.m b/matlab/step6_file.m deleted file mode 100644 index 3e64a6a916..0000000000 --- a/matlab/step6_file.m +++ /dev/null @@ -1,147 +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 ~type_utils.list_Q(ast) - ret = eval_ast(ast, env); - 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' - 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 = 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 - 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(); - - % 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) - 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/matlab/step7_quote.m b/matlab/step7_quote.m deleted file mode 100644 index 6f4577b444..0000000000 --- a/matlab/step7_quote.m +++ /dev/null @@ -1,175 +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 = type_utils.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 ~type_utils.list_Q(ast) - ret = eval_ast(ast, env); - 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' - 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 = 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 - 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(); - - % 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) - 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/matlab/step8_macros.m b/matlab/step8_macros.m deleted file mode 100644 index 7e0b46ab1b..0000000000 --- a/matlab/step8_macros.m +++ /dev/null @@ -1,209 +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 = type_utils.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 type_utils.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 ~type_utils.list_Q(ast) - ret = eval_ast(ast, env); - return; - end - - % apply - if length(ast) == 0 - ret = ast; - return; - end - ast = macroexpand(ast, env); - if ~type_utils.list_Q(ast) - ret = eval_ast(ast, env); - 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 = 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 - 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(); - - % 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) - 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/matlab/step9_try.m b/matlab/step9_try.m deleted file mode 100644 index b54461e3be..0000000000 --- a/matlab/step9_try.m +++ /dev/null @@ -1,242 +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 = type_utils.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 type_utils.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 ~type_utils.list_Q(ast) - ret = eval_ast(ast, env); - return; - end - - % apply - if length(ast) == 0 - ret = ast; - return; - end - ast = macroexpand(ast, env); - if ~type_utils.list_Q(ast) - ret = eval_ast(ast, env); - 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 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 - 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 = 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 - 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(); - - % 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) - 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/matlab/stepA_mal.m b/matlab/stepA_mal.m deleted file mode 100644 index 8883ac85b4..0000000000 --- a/matlab/stepA_mal.m +++ /dev/null @@ -1,246 +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 = type_utils.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 type_utils.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 ~type_utils.list_Q(ast) - ret = eval_ast(ast, env); - return; - end - - % apply - if length(ast) == 0 - ret = ast; - return; - end - ast = macroexpand(ast, env); - if ~type_utils.list_Q(ast) - ret = eval_ast(ast, env); - 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 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 - 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 = 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 - 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(); - - % 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('(def! *gensym-counter* (atom 0))', repl_env); - rep('(def! gensym (fn* [] (symbol (str "G__" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))', repl_env); - 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)))))))))', 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/miniMAL/Dockerfile b/miniMAL/Dockerfile deleted file mode 100644 index 6843896fa9..0000000000 --- a/miniMAL/Dockerfile +++ /dev/null @@ -1,38 +0,0 @@ -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 node modules -RUN apt-get -y install g++ - -# Add nodesource apt repo config for 0.12 stable -RUN curl -sL https://deb.nodesource.com/setup_0.12 | bash - - -# Install nodejs -RUN apt-get -y install nodejs - -# Link common name -RUN ln -sf nodejs /usr/bin/node - -ENV NPM_CONFIG_CACHE /mal/.npm - -RUN npm install -g minimal-lisp diff --git a/miniMAL/Makefile b/miniMAL/Makefile deleted file mode 100644 index 82e7f6e32f..0000000000 --- a/miniMAL/Makefile +++ /dev/null @@ -1,35 +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) - -all: node_modules - -node_modules: - npm install - -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: - -.PHONY: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*$$" $^ | wc` "[comments/blanks]" diff --git a/miniMAL/miniMAL-core.json b/miniMAL/miniMAL-core.json deleted file mode 100644 index 6717968969..0000000000 --- a/miniMAL/miniMAL-core.json +++ /dev/null @@ -1,114 +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", ["readline", ["require", ["`", "readline"]], - "opts", ["new", ["fn", [], null]], - "_", ["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/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 3f403d0594..0000000000 --- a/miniMAL/package.json +++ /dev/null @@ -1,9 +0,0 @@ -{ - "name": "mal-miniMAL", - "version": "0.0.1", - "description": "Make a Lisp (mal) language implemented in miniMAL", - "dependencies": { - "minimal-lisp": "0.0.6", - "ffi": "2.0.x" - } -} diff --git a/miniMAL/run b/miniMAL/run deleted file mode 100755 index db4875f09f..0000000000 --- a/miniMAL/run +++ /dev/null @@ -1,3 +0,0 @@ -#!/bin/bash -cd $(dirname $0) -exec miniMAL ./${STEP:-stepA_mal}.json "${@}" 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 40517a59d4..0000000000 --- a/miniMAL/step2_eval.json +++ /dev/null @@ -1,62 +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"], - ["if", ["empty?", "ast"], - "ast", - ["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 c423084599..0000000000 --- a/miniMAL/step3_env.json +++ /dev/null @@ -1,76 +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"], - ["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", ["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 9b69a8f61b..0000000000 --- a/miniMAL/step4_if_fn_do.json +++ /dev/null @@ -1,94 +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"], - ["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", ["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 43c73bf4fa..0000000000 --- a/miniMAL/step5_tco.json +++ /dev/null @@ -1,102 +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"], - ["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", - ["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 768cca7411..0000000000 --- a/miniMAL/step6_file.json +++ /dev/null @@ -1,109 +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"], - ["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", - ["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 f764ffd74c..0000000000 --- a/miniMAL/step7_quote.json +++ /dev/null @@ -1,134 +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", ["and", ["symbol?", ["nth", "ast", 0]], - ["=", ["`", "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"], - ["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", - ["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 c3a05fca37..0000000000 --- a/miniMAL/step8_macros.json +++ /dev/null @@ -1,160 +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", ["and", ["symbol?", ["nth", "ast", 0]], - ["=", ["`", "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"]], - ["eval-ast", "ast", "env"], - ["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", ["=", ["`", "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 e7fbdab63a..0000000000 --- a/miniMAL/step9_try.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", ["and", ["symbol?", ["nth", "ast", 0]], - ["=", ["`", "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"]], - ["eval-ast", "ast", "env"], - ["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", ["=", ["`", "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 789949dfdd..0000000000 --- a/miniMAL/stepA_mal.json +++ /dev/null @@ -1,176 +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", ["and", ["symbol?", ["nth", "ast", 0]], - ["=", ["`", "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"]], - ["eval-ast", "ast", "env"], - ["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", ["=", ["`", "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", ["`", "(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)))))))))"]], - -["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/Dockerfile b/nim/Dockerfile deleted file mode 100644 index 2f0918817d..0000000000 --- a/nim/Dockerfile +++ /dev/null @@ -1,35 +0,0 @@ -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++ - -# Nim -RUN apt-get -y install xz-utils -RUN cd /tmp && curl -O http://nim-lang.org/download/nim-0.12.0.tar.xz \ - && tar xvJf /tmp/nim-0.12.0.tar.xz && cd nim-0.12.0 \ - && make && sh install.sh /usr/local/bin \ - && cp bin/nim /usr/local/bin/ \ - && rm -r /tmp/nim-0.12.0 - -ENV HOME /mal diff --git a/nim/Makefile b/nim/Makefile deleted file mode 100644 index 9b145d653f..0000000000 --- a/nim/Makefile +++ /dev/null @@ -1,38 +0,0 @@ -##################### - -SOURCES_BASE = types.nim reader.nim printer.nim -SOURCES_LISP = env.nim core.nim stepA_mal.nim -SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) -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 - -.PHONY: stats stats-lisp - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*#|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*#|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" diff --git a/nim/env.nim b/nim/env.nim deleted file mode 100644 index dcb64f7da8..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/reader.nim b/nim/reader.nim deleted file mode 100644 index 4df8c9c5b6..0000000000 --- a/nim/reader.nim +++ /dev/null @@ -1,115 +0,0 @@ -import re, strutils, sequtils, 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 = @[] - 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][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 != 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 43f85816b7..0000000000 --- a/nim/step3_env.nim +++ /dev/null @@ -1,71 +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: - 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*": - 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 e0179745ee..0000000000 --- a/nim/step4_if_fn_do.nim +++ /dev/null @@ -1,105 +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: - 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] - 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 4b41afdae4..0000000000 --- a/nim/step5_tco.nim +++ /dev/null @@ -1,116 +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) - 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 "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 eee3a952d0..0000000000 --- a/nim/step6_file.nim +++ /dev/null @@ -1,126 +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) - 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 "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 46004069c7..0000000000 --- a/nim/step7_quote.nim +++ /dev/null @@ -1,147 +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) - 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 "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 f292ea5a14..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.eval_ast(env) - 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 52d76e8141..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.eval_ast(env) - 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 1f0eb5f3d3..0000000000 --- a/nim/stepA_mal.nim +++ /dev/null @@ -1,193 +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.eval_ast(env) - 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 "(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)))))))))" -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/objc/Dockerfile b/objc/Dockerfile deleted file mode 100644 index fa7e3a4f71..0000000000 --- a/objc/Dockerfile +++ /dev/null @@ -1,62 +0,0 @@ -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 -########################################################## - -# 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/objc/Makefile b/objc/Makefile deleted file mode 100644 index e069db7830..0000000000 --- a/objc/Makefile +++ /dev/null @@ -1,62 +0,0 @@ -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 - -SOURCES = $(STEP4_DEPS) stepA_mal.m -SOURCES_LISP = env.h env.m core.h core.m stepA_mal.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 | egrep -v "Entering|Leaving") -OBJC_LIBS := $(filter-out -shared-libgcc,$(shell gnustep-config --base-libs | 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 - -.PHONY: stats tests - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" diff --git a/objc/core.m b/objc/core.m deleted file mode 100644 index 1397019791..0000000000 --- a/objc/core.m +++ /dev/null @@ -1,335 +0,0 @@ -#import - -#import "mal_readline.h" -#import "types.h" -#import "reader.h" -#import "printer.h" -#import "malfunc.h" -#import "core.h" - -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){ - return [NSString stringWithFormat:@"\u029e%@", args[0]]; - }, - @"keyword?": ^(NSArray *args){ - return wrap_tf([args[0] isKindOfClass:[NSString class]] && - ![args[0] isKindOfClass:[MalSymbol class]] && - !string_Q(args[0])); - }, - - @"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; - }, - @"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 arrayWithArray: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": ^(NSArray *args){ - if ([args[0] isKindOfClass:[MalFunc class]]) { - return [(MalFunc *)args[0] meta]; - } else { - return (NSObject *)[NSNull alloc]; - } - }, - @"with-meta": ^(NSArray *args){ - if ([args[0] isKindOfClass:[MalFunc class]]) { - MalFunc * cmf = [(MalFunc *)args[0] copy]; - cmf.meta = args[1]; - return cmf; - } else { - @throw @"with-meta: object type not supported"; - } - }, - @"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/objc/reader.m b/objc/reader.m deleted file mode 100644 index 49320e33cb..0000000000 --- a/objc/reader.m +++ /dev/null @@ -1,191 +0,0 @@ -#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:@"\""] - stringByReplacingOccurrencesOfString:@"\\n" withString:@"\n"] - stringByReplacingOccurrencesOfString:@"\\\\" withString:@"\\"]; - } else if ([match rangeAtIndex:7].location < -1ULL/2) { // keyword - return [NSString stringWithFormat:@"\u029e%@", - [token substringWithRange:[match rangeAtIndex:7]]]; - } else if ([match rangeAtIndex:8].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/objc/run b/objc/run deleted file mode 100755 index 8ba68a5484..0000000000 --- a/objc/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec $(dirname $0)/${STEP:-stepA_mal} "${@}" diff --git a/objc/step2_eval.m b/objc/step2_eval.m deleted file mode 100644 index e07934ddac..0000000000 --- a/objc/step2_eval.m +++ /dev/null @@ -1,111 +0,0 @@ -#import - -#import "mal_readline.h" -#import "types.h" -#import "reader.h" -#import "printer.h" - -// read -NSObject *READ(NSString *str) { - return read_str(str); -} - -// eval - -// forward declaration -NSObject *EVAL(NSObject *ast, NSDictionary *env); - -NSObject *eval_ast(NSObject *ast, NSDictionary *env) { - if ([ast isMemberOfClass:[MalSymbol class]]) { - if ([env objectForKey:ast]) { - return env[ast]; - } else { - @throw [NSString stringWithFormat:@"'%@' not found", ast]; - } - } else if ([ast isKindOfClass:[NSArray class]]) { - NSMutableArray *newLst = [NSMutableArray array]; - for (NSObject * x in (NSArray *)ast) { - [newLst addObject:EVAL(x, env)]; - } - if ([ast isKindOfClass:[MalVector class]]) { - return [MalVector fromArray:newLst]; - } else { - return 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 { - return ast; - } -} - -NSObject *EVAL(NSObject *ast, NSDictionary *env) { - //NSLog(@"EVAL: %@", ast); - if (!list_Q(ast)) { - return eval_ast(ast, env); - } - - // apply list - if ([(NSArray *)ast count] == 0) { - return ast; - } - NSArray * el = (NSArray *) eval_ast(ast, env); - NSObject * (^ f)(NSArray *) = el[0]; - NSArray * args = _rest(el); - 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/objc/step3_env.m b/objc/step3_env.m deleted file mode 100644 index 8ee4286eef..0000000000 --- a/objc/step3_env.m +++ /dev/null @@ -1,124 +0,0 @@ -#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 - -// forward declaration -NSObject *EVAL(NSObject *ast, Env *env); - -NSObject *eval_ast(NSObject *ast, Env *env) { - if ([ast isMemberOfClass:[MalSymbol class]]) { - return [env get:(MalSymbol *)ast]; - } else if ([ast isKindOfClass:[NSArray class]]) { - NSMutableArray *newLst = [NSMutableArray array]; - for (NSObject * x in (NSArray *)ast) { - [newLst addObject:EVAL(x, env)]; - } - if ([ast isKindOfClass:[MalVector class]]) { - return [MalVector fromArray:newLst]; - } else { - return 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 { - return ast; - } -} - -NSObject *EVAL(NSObject *ast, Env *env) { - //NSLog(@"EVAL: %@", ast); - if (!list_Q(ast)) { - return eval_ast(ast, env); - } - - // apply list - if ([(NSArray *)ast count] == 0) { - return ast; - } - NSArray * alst = (NSArray *)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 { - NSArray * el = (NSArray *) eval_ast(ast, env); - NSObject * (^ f)(NSArray *) = el[0]; - NSArray * args = _rest(el); - 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/objc/step4_if_fn_do.m b/objc/step4_if_fn_do.m deleted file mode 100644 index 27e24827eb..0000000000 --- a/objc/step4_if_fn_do.m +++ /dev/null @@ -1,146 +0,0 @@ -#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_ast(NSObject *ast, Env *env) { - if ([ast isMemberOfClass:[MalSymbol class]]) { - return [env get:(MalSymbol *)ast]; - } else if ([ast isKindOfClass:[NSArray class]]) { - NSMutableArray *newLst = [NSMutableArray array]; - for (NSObject * x in (NSArray *)ast) { - [newLst addObject:EVAL(x, env)]; - } - if ([ast isKindOfClass:[MalVector class]]) { - return [MalVector fromArray:newLst]; - } else { - return 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 { - return ast; - } -} - -NSObject *EVAL(NSObject *ast, Env *env) { - //NSLog(@"EVAL: %@ (%@)", _pr_str(ast, true), env); - if (!list_Q(ast)) { - return eval_ast(ast, env); - } - - // apply list - if ([(NSArray *)ast count] == 0) { - return ast; - } - NSArray * alst = (NSArray *)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"]) { - NSArray * el = (NSArray *)eval_ast(_rest(alst), env); - return [el lastObject]; - } 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 { - NSArray * el = (NSArray *) eval_ast(ast, env); - NSArray * args = @[]; - if ([el count] > 1) { - args = _rest(el); - } - return apply(el[0], args); - /* - if ([el[0] isKindOfClass:[MalFunc class]]) { - MalFunc * mf = el[0]; - return [mf apply:args]; - } else { - NSObject * (^ f)(NSArray *) = el[0]; - 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(NSException *e) { - if ([[e name] isEqualTo:@"ReaderContinue"]) { continue; } - printf("Exception: %s\n", [[e reason] UTF8String]); - } - } - - [pool drain]; - -// } -} diff --git a/objc/step5_tco.m b/objc/step5_tco.m deleted file mode 100644 index 541e74c4c8..0000000000 --- a/objc/step5_tco.m +++ /dev/null @@ -1,148 +0,0 @@ -#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_ast(NSObject *ast, Env *env) { - if ([ast isMemberOfClass:[MalSymbol class]]) { - return [env get:(MalSymbol *)ast]; - } else if ([ast isKindOfClass:[NSArray class]]) { - NSMutableArray *newLst = [NSMutableArray array]; - for (NSObject * x in (NSArray *)ast) { - [newLst addObject:EVAL(x, env)]; - } - if ([ast isKindOfClass:[MalVector class]]) { - return [MalVector fromArray:newLst]; - } else { - return 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 { - return ast; - } -} - -NSObject *EVAL(NSObject *ast, Env *env) { - while (true) { - //NSLog(@"EVAL: %@ (%@)", _pr_str(ast, true), env); - if (!list_Q(ast)) { - return eval_ast(ast, env); - } - - // apply list - if ([(NSArray *)ast count] == 0) { - return ast; - } - NSArray * alst = (NSArray *)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"]) { - NSRange r = NSMakeRange(1, [alst count] - 2); - eval_ast([alst subarrayWithRange:r], 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 { - NSArray * el = (NSArray *) eval_ast(ast, env); - NSArray * args = @[]; - if ([el count] > 1) { - args = _rest(el); - } - if ([el[0] isKindOfClass:[MalFunc class]]) { - MalFunc * mf = el[0]; - env = [Env fromBindings:[mf env] binds:[mf params] exprs:args]; - ast = [mf ast]; // TCO - } else { - NSObject * (^ f)(NSArray *) = el[0]; - 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(NSException *e) { - if ([[e name] isEqualTo:@"ReaderContinue"]) { continue; } - printf("Exception: %s\n", [[e reason] UTF8String]); - } - } - - [pool drain]; - -// } -} diff --git a/objc/step6_file.m b/objc/step6_file.m deleted file mode 100644 index 843e57e3cc..0000000000 --- a/objc/step6_file.m +++ /dev/null @@ -1,169 +0,0 @@ -#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_ast(NSObject *ast, Env *env) { - if ([ast isMemberOfClass:[MalSymbol class]]) { - return [env get:(MalSymbol *)ast]; - } else if ([ast isKindOfClass:[NSArray class]]) { - NSMutableArray *newLst = [NSMutableArray array]; - for (NSObject * x in (NSArray *)ast) { - [newLst addObject:EVAL(x, env)]; - } - if ([ast isKindOfClass:[MalVector class]]) { - return [MalVector fromArray:newLst]; - } else { - return 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 { - return ast; - } -} - -NSObject *EVAL(NSObject *ast, Env *env) { - while (true) { - //NSLog(@"EVAL: %@ (%@)", _pr_str(ast, true), env); - if (!list_Q(ast)) { - return eval_ast(ast, env); - } - - // apply list - if ([(NSArray *)ast count] == 0) { - return ast; - } - NSArray * alst = (NSArray *)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"]) { - NSRange r = NSMakeRange(1, [alst count] - 2); - eval_ast([alst subarrayWithRange:r], 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 { - NSArray * el = (NSArray *) eval_ast(ast, env); - NSArray * args = @[]; - if ([el count] > 1) { - args = _rest(el); - } - if ([el[0] isKindOfClass:[MalFunc class]]) { - MalFunc * mf = el[0]; - env = [Env fromBindings:[mf env] binds:[mf params] exprs:args]; - ast = [mf ast]; // TCO - } else { - NSObject * (^ f)(NSArray *) = el[0]; - 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) \")\")))))", 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(NSException *e) { - if ([[e name] isEqualTo:@"ReaderContinue"]) { continue; } - printf("Exception: %s\n", [[e reason] UTF8String]); - } - } - - [pool drain]; - -// } -} diff --git a/objc/step7_quote.m b/objc/step7_quote.m deleted file mode 100644 index 4917b9abb5..0000000000 --- a/objc/step7_quote.m +++ /dev/null @@ -1,203 +0,0 @@ -#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 is_pair(NSObject *obj) { - return [obj isKindOfClass:[NSArray class]] && - [(NSArray *)obj count] > 0; -} - -NSObject * quasiquote(NSObject *ast) { - if (!is_pair(ast)) { - return @[[MalSymbol stringWithString:@"quote"], ast]; - } else { - NSArray * alst = (NSArray *)ast; - id a0 = alst[0]; - if ([a0 isKindOfClass:[MalSymbol class]] && - [(NSString *)a0 isEqualTo:@"unquote"]) { - return alst[1]; - } else if (is_pair(a0)) { - id a0lst = (NSArray *)a0; - id a00 = a0lst[0]; - if ([a00 isKindOfClass:[MalSymbol class]] && - [(NSString *)a00 isEqualTo:@"splice-unquote"]) { - return @[[MalSymbol stringWithString:@"concat"], - a0lst[1], - quasiquote(_rest(alst))]; - } - } - return @[[MalSymbol stringWithString:@"cons"], - quasiquote(a0), - quasiquote(_rest(alst))]; - } -} - -NSObject *eval_ast(NSObject *ast, Env *env) { - if ([ast isMemberOfClass:[MalSymbol class]]) { - return [env get:(MalSymbol *)ast]; - } else if ([ast isKindOfClass:[NSArray class]]) { - NSMutableArray *newLst = [NSMutableArray array]; - for (NSObject * x in (NSArray *)ast) { - [newLst addObject:EVAL(x, env)]; - } - if ([ast isKindOfClass:[MalVector class]]) { - return [MalVector fromArray:newLst]; - } else { - return 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 { - return ast; - } -} - -NSObject *EVAL(NSObject *ast, Env *env) { - while (true) { - //NSLog(@"EVAL: %@ (%@)", _pr_str(ast, true), env); - if (!list_Q(ast)) { - return eval_ast(ast, env); - } - - // apply list - if ([(NSArray *)ast count] == 0) { - return ast; - } - NSArray * alst = (NSArray *)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"]) { - NSRange r = NSMakeRange(1, [alst count] - 2); - eval_ast([alst subarrayWithRange:r], 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 { - NSArray * el = (NSArray *) eval_ast(ast, env); - NSArray * args = @[]; - if ([el count] > 1) { - args = _rest(el); - } - if ([el[0] isKindOfClass:[MalFunc class]]) { - MalFunc * mf = el[0]; - env = [Env fromBindings:[mf env] binds:[mf params] exprs:args]; - ast = [mf ast]; // TCO - } else { - NSObject * (^ f)(NSArray *) = el[0]; - 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) \")\")))))", 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(NSException *e) { - if ([[e name] isEqualTo:@"ReaderContinue"]) { continue; } - printf("Exception: %s\n", [[e reason] UTF8String]); - } - } - - [pool drain]; - -// } -} diff --git a/objc/step8_macros.m b/objc/step8_macros.m deleted file mode 100644 index e9d772a32a..0000000000 --- a/objc/step8_macros.m +++ /dev/null @@ -1,239 +0,0 @@ -#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 is_pair(NSObject *obj) { - return [obj isKindOfClass:[NSArray class]] && - [(NSArray *)obj count] > 0; -} - -NSObject * quasiquote(NSObject *ast) { - if (!is_pair(ast)) { - return @[[MalSymbol stringWithString:@"quote"], ast]; - } else { - NSArray * alst = (NSArray *)ast; - id a0 = alst[0]; - if ([a0 isKindOfClass:[MalSymbol class]] && - [(NSString *)a0 isEqualTo:@"unquote"]) { - return alst[1]; - } else if (is_pair(a0)) { - id a0lst = (NSArray *)a0; - id a00 = a0lst[0]; - if ([a00 isKindOfClass:[MalSymbol class]] && - [(NSString *)a00 isEqualTo:@"splice-unquote"]) { - return @[[MalSymbol stringWithString:@"concat"], - a0lst[1], - quasiquote(_rest(alst))]; - } - } - return @[[MalSymbol stringWithString:@"cons"], - quasiquote(a0), - quasiquote(_rest(alst))]; - } -} - -BOOL is_macro_call(NSObject *ast, Env *env) { - if (list_Q(ast)) { - NSArray * alst = (NSArray *)ast; - if ([alst[0] isKindOfClass:[MalSymbol class]] && [env find:alst[0]]) { - id mf = [env get:alst[0]]; - if ([mf isKindOfClass:[MalFunc class]]) { - return [(MalFunc *)mf isMacro]; - } - } - } - return false; -} - -NSObject *macroexpand(NSObject *ast, Env *env) { - while(is_macro_call(ast, env)) { - NSArray * alst = (NSArray *)ast; - MalFunc * mf = (MalFunc *)[env get:alst[0]]; - ast = [mf apply:_rest(alst)]; - } - return ast; -} - -NSObject *eval_ast(NSObject *ast, Env *env) { - if ([ast isMemberOfClass:[MalSymbol class]]) { - return [env get:(MalSymbol *)ast]; - } else if ([ast isKindOfClass:[NSArray class]]) { - NSMutableArray *newLst = [NSMutableArray array]; - for (NSObject * x in (NSArray *)ast) { - [newLst addObject:EVAL(x, env)]; - } - if ([ast isKindOfClass:[MalVector class]]) { - return [MalVector fromArray:newLst]; - } else { - return 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 { - return ast; - } -} - -NSObject *EVAL(NSObject *ast, Env *env) { - while (true) { - //NSLog(@"EVAL: %@ (%@)", _pr_str(ast, true), env); - if (!list_Q(ast)) { - return eval_ast(ast, env); - } - - // apply list - if ([(NSArray *)ast count] == 0) { - return ast; - } - ast = macroexpand(ast, env); - if (!list_Q(ast)) { - return eval_ast(ast, env); - } - - NSArray * alst = (NSArray *)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); - f.isMacro = true; - return [env set:alst[1] val:f]; - } else if ([a0sym isEqualTo:@"macroexpand"]) { - return macroexpand(alst[1], env); - } else if ([a0sym isEqualTo:@"do"]) { - NSRange r = NSMakeRange(1, [alst count] - 2); - eval_ast([alst subarrayWithRange:r], 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 { - NSArray * el = (NSArray *) eval_ast(ast, env); - NSArray * args = @[]; - if ([el count] > 1) { - args = _rest(el); - } - if ([el[0] isKindOfClass:[MalFunc class]]) { - MalFunc * mf = el[0]; - env = [Env fromBindings:[mf env] binds:[mf params] exprs:args]; - ast = [mf ast]; // TCO - } else { - NSObject * (^ f)(NSArray *) = el[0]; - 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) \")\")))))", 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 ([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(NSException *e) { - if ([[e name] isEqualTo:@"ReaderContinue"]) { continue; } - printf("Exception: %s\n", [[e reason] UTF8String]); - } - } - - [pool drain]; - -// } -} diff --git a/objc/step9_try.m b/objc/step9_try.m deleted file mode 100644 index ac5039d1fd..0000000000 --- a/objc/step9_try.m +++ /dev/null @@ -1,258 +0,0 @@ -#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 is_pair(NSObject *obj) { - return [obj isKindOfClass:[NSArray class]] && - [(NSArray *)obj count] > 0; -} - -NSObject * quasiquote(NSObject *ast) { - if (!is_pair(ast)) { - return @[[MalSymbol stringWithString:@"quote"], ast]; - } else { - NSArray * alst = (NSArray *)ast; - id a0 = alst[0]; - if ([a0 isKindOfClass:[MalSymbol class]] && - [(NSString *)a0 isEqualTo:@"unquote"]) { - return alst[1]; - } else if (is_pair(a0)) { - id a0lst = (NSArray *)a0; - id a00 = a0lst[0]; - if ([a00 isKindOfClass:[MalSymbol class]] && - [(NSString *)a00 isEqualTo:@"splice-unquote"]) { - return @[[MalSymbol stringWithString:@"concat"], - a0lst[1], - quasiquote(_rest(alst))]; - } - } - return @[[MalSymbol stringWithString:@"cons"], - quasiquote(a0), - quasiquote(_rest(alst))]; - } -} - -BOOL is_macro_call(NSObject *ast, Env *env) { - if (list_Q(ast)) { - NSArray * alst = (NSArray *)ast; - if ([alst[0] isKindOfClass:[MalSymbol class]] && [env find:alst[0]]) { - id mf = [env get:alst[0]]; - if ([mf isKindOfClass:[MalFunc class]]) { - return [(MalFunc *)mf isMacro]; - } - } - } - return false; -} - -NSObject *macroexpand(NSObject *ast, Env *env) { - while(is_macro_call(ast, env)) { - NSArray * alst = (NSArray *)ast; - MalFunc * mf = (MalFunc *)[env get:alst[0]]; - ast = [mf apply:_rest(alst)]; - } - return ast; -} - -NSObject *eval_ast(NSObject *ast, Env *env) { - if ([ast isMemberOfClass:[MalSymbol class]]) { - return [env get:(MalSymbol *)ast]; - } else if ([ast isKindOfClass:[NSArray class]]) { - NSMutableArray *newLst = [NSMutableArray array]; - for (NSObject * x in (NSArray *)ast) { - [newLst addObject:EVAL(x, env)]; - } - if ([ast isKindOfClass:[MalVector class]]) { - return [MalVector fromArray:newLst]; - } else { - return 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 { - return ast; - } -} - -NSObject *EVAL(NSObject *ast, Env *env) { - while (true) { - //NSLog(@"EVAL: %@ (%@)", _pr_str(ast, true), env); - if (!list_Q(ast)) { - return eval_ast(ast, env); - } - - // apply list - if ([(NSArray *)ast count] == 0) { - return ast; - } - ast = macroexpand(ast, env); - if (!list_Q(ast)) { - return eval_ast(ast, env); - } - - NSArray * alst = (NSArray *)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); - f.isMacro = true; - return [env set:alst[1] val:f]; - } else if ([a0sym isEqualTo:@"macroexpand"]) { - return macroexpand(alst[1], env); - } 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"]) { - NSRange r = NSMakeRange(1, [alst count] - 2); - eval_ast([alst subarrayWithRange:r], 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 { - NSArray * el = (NSArray *) eval_ast(ast, env); - NSArray * args = @[]; - if ([el count] > 1) { - args = _rest(el); - } - if ([el[0] isKindOfClass:[MalFunc class]]) { - MalFunc * mf = el[0]; - env = [Env fromBindings:[mf env] binds:[mf params] exprs:args]; - ast = [mf ast]; // TCO - } else { - NSObject * (^ f)(NSArray *) = el[0]; - 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) \")\")))))", 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 ([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(NSException *e) { - if ([[e name] isEqualTo:@"ReaderContinue"]) { continue; } - printf("Exception: %s\n", [[e reason] UTF8String]); - } - } - - [pool drain]; - -// } -} diff --git a/objc/stepA_mal.m b/objc/stepA_mal.m deleted file mode 100644 index 80822234e4..0000000000 --- a/objc/stepA_mal.m +++ /dev/null @@ -1,261 +0,0 @@ -#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 is_pair(NSObject *obj) { - return [obj isKindOfClass:[NSArray class]] && - [(NSArray *)obj count] > 0; -} - -NSObject * quasiquote(NSObject *ast) { - if (!is_pair(ast)) { - return @[[MalSymbol stringWithString:@"quote"], ast]; - } else { - NSArray * alst = (NSArray *)ast; - id a0 = alst[0]; - if ([a0 isKindOfClass:[MalSymbol class]] && - [(NSString *)a0 isEqualTo:@"unquote"]) { - return alst[1]; - } else if (is_pair(a0)) { - id a0lst = (NSArray *)a0; - id a00 = a0lst[0]; - if ([a00 isKindOfClass:[MalSymbol class]] && - [(NSString *)a00 isEqualTo:@"splice-unquote"]) { - return @[[MalSymbol stringWithString:@"concat"], - a0lst[1], - quasiquote(_rest(alst))]; - } - } - return @[[MalSymbol stringWithString:@"cons"], - quasiquote(a0), - quasiquote(_rest(alst))]; - } -} - -BOOL is_macro_call(NSObject *ast, Env *env) { - if (list_Q(ast)) { - NSArray * alst = (NSArray *)ast; - if ([alst[0] isKindOfClass:[MalSymbol class]] && [env find:alst[0]]) { - id mf = [env get:alst[0]]; - if ([mf isKindOfClass:[MalFunc class]]) { - return [(MalFunc *)mf isMacro]; - } - } - } - return false; -} - -NSObject *macroexpand(NSObject *ast, Env *env) { - while(is_macro_call(ast, env)) { - NSArray * alst = (NSArray *)ast; - MalFunc * mf = (MalFunc *)[env get:alst[0]]; - ast = [mf apply:_rest(alst)]; - } - return ast; -} - -NSObject *eval_ast(NSObject *ast, Env *env) { - if ([ast isMemberOfClass:[MalSymbol class]]) { - return [env get:(MalSymbol *)ast]; - } else if ([ast isKindOfClass:[NSArray class]]) { - NSMutableArray *newLst = [NSMutableArray array]; - for (NSObject * x in (NSArray *)ast) { - [newLst addObject:EVAL(x, env)]; - } - if ([ast isKindOfClass:[MalVector class]]) { - return [MalVector fromArray:newLst]; - } else { - return 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 { - return ast; - } -} - -NSObject *EVAL(NSObject *ast, Env *env) { - while (true) { - //NSLog(@"EVAL: %@ (%@)", _pr_str(ast, true), env); - if (!list_Q(ast)) { - return eval_ast(ast, env); - } - - // apply list - if ([(NSArray *)ast count] == 0) { - return ast; - } - ast = macroexpand(ast, env); - if (!list_Q(ast)) { - return eval_ast(ast, env); - } - - NSArray * alst = (NSArray *)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); - f.isMacro = true; - return [env set:alst[1] val:f]; - } else if ([a0sym isEqualTo:@"macroexpand"]) { - return macroexpand(alst[1], env); - } 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"]) { - NSRange r = NSMakeRange(1, [alst count] - 2); - eval_ast([alst subarrayWithRange:r], 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 { - NSArray * el = (NSArray *) eval_ast(ast, env); - NSArray * args = @[]; - if ([el count] > 1) { - args = _rest(el); - } - if ([el[0] isKindOfClass:[MalFunc class]]) { - MalFunc * mf = el[0]; - env = [Env fromBindings:[mf env] binds:[mf params] exprs:args]; - ast = [mf ast]; // TCO - } else { - NSObject * (^ f)(NSArray *) = el[0]; - 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) \")\")))))", 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! *gensym-counter* (atom 0))", repl_env); - REP(@"(def! gensym (fn* [] (symbol (str \"G__\" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))", repl_env); - 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)))))))))", 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(NSException *e) { - if ([[e name] isEqualTo:@"ReaderContinue"]) { continue; } - printf("Exception: %s\n", [[e reason] UTF8String]); - } - } - - [pool drain]; - -// } -} diff --git a/objc/types.h b/objc/types.h deleted file mode 100644 index 22b18c6730..0000000000 --- a/objc/types.h +++ /dev/null @@ -1,94 +0,0 @@ -#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; -- (Env *) find:(MalSymbol *)key; -- (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/objpascal/Dockerfile b/objpascal/Dockerfile deleted file mode 100644 index 31bb193b10..0000000000 --- a/objpascal/Dockerfile +++ /dev/null @@ -1,25 +0,0 @@ -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 -########################################################## - -# Free Pascal -RUN apt-get -y install libc6-dev fp-compiler diff --git a/objpascal/Makefile b/objpascal/Makefile deleted file mode 100644 index af938fbfd5..0000000000 --- a/objpascal/Makefile +++ /dev/null @@ -1,45 +0,0 @@ -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 - -SOURCES = mal_readline.pas mal_types.pas mal_func.pas \ - reader.pas printer.pas mal_env.pas core.pas stepA_mal.pas -SOURCES_LISP = mal_env.pas core.pas stepA_mal.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 - -.PHONY: stats stats-lisp - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" - diff --git a/objpascal/mal_env.pas b/objpascal/mal_env.pas deleted file mode 100644 index 9bbe2ebd61..0000000000 --- a/objpascal/mal_env.pas +++ /dev/null @@ -1,101 +0,0 @@ -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 Find(Key : TMalSymbol) : TEnv; - function Get(Key : TMalSymbol) : 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.Find(Key : TMalSymbol) : TEnv; -var - Sym : string; -begin - Sym := (Key as TMalSymbol).Val; - if Data.IndexOf(Sym) >= 0 then - Find := Self - else if Outer <> nil then - Find := Outer.Find(Key) - else - Find := nil; -end; - -function TEnv.Get(Key : TMalSymbol) : TMal; -var - Sym : string; - Env : TEnv; -begin - Sym := (Key as TMalSymbol).Val; - Env := Self.Find(Key); - if Env <> nil then - Get := Env.Data[Sym] - else - raise Exception.Create('''' + Sym + ''' not found'); -end; - -end. diff --git a/objpascal/regexpr/Source/RegExpr.pas.orig b/objpascal/regexpr/Source/RegExpr.pas.orig deleted file mode 100644 index dd1f856c0d..0000000000 --- a/objpascal/regexpr/Source/RegExpr.pas.orig +++ /dev/null @@ -1,4041 +0,0 @@ -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 - -uses - Windows; // CharUpper/Lower - -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/objpascal/run b/objpascal/run deleted file mode 100755 index 8ba68a5484..0000000000 --- a/objpascal/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec $(dirname $0)/${STEP:-stepA_mal} "${@}" diff --git a/objpascal/step2_eval.pas b/objpascal/step2_eval.pas deleted file mode 100644 index 9da3bcbad6..0000000000 --- a/objpascal/step2_eval.pas +++ /dev/null @@ -1,151 +0,0 @@ -program Mal; - -{$H+} // Use AnsiString - -Uses sysutils, - CMem, - 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 -// Forward declation since eval_ast call it -function EVAL(Ast: TMal; Env: TEnv) : TMal; forward; - -function eval_ast(Ast: TMal; Env: TEnv) : TMal; -var - Sym : string; - OldArr, NewArr : TMalArray; - OldDict, NewDict : TMalDict; - I : longint; -begin - if Ast is TMalSymbol then - begin - Sym := (Ast as TMalSymbol).Val; - if Env.IndexOf(Sym) < 0 then - raise Exception.Create('''' + Sym + ''' not found') - else - eval_ast := Env[Sym]; - end - else if Ast is TMalList then - begin - OldArr := (Ast as TMalList).Val; - SetLength(NewArr, Length(OldArr)); - for I := 0 to Length(OldArr)-1 do - begin - NewArr[I] := EVAL(OldArr[I], Env); - end; - if Ast is TMalVector then - eval_ast := TMalVector.Create(NewArr) - else - eval_ast := TMalList.Create(NewArr); - end - else if Ast is TMalHashMap then - begin - OldDict := (Ast as TMalHashMap).Val; - NewDict := TMalDict.Create; - I := 0; - while I < OldDict.Count do - begin - NewDict[OldDict.Keys[I]] := EVAL(OldDict[OldDict.Keys[I]], Env); - I := I + 1; - end; - eval_ast := TMalHashMap.Create(NewDict); - end - else - eval_ast := Ast; -end; - -function EVAL(Ast: TMal; Env: TEnv) : TMal; -var - Arr : TMalArray; - Fn : TMalCallable; -begin - if Ast.ClassType <> TMalList then - Exit(eval_ast(Ast, Env)); - - // Apply list - Arr := (eval_ast(Ast, Env) as TMalList).Val; - if Length(Arr) = 0 then - Exit(Ast); - if Arr[0] is TMalFunc then - begin - Fn := (Arr[0] as TMalFunc).Val; - EVAL := Fn(copy(Arr, 1, Length(Arr)-1)); - 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/objpascal/step3_env.pas b/objpascal/step3_env.pas deleted file mode 100644 index f51e318beb..0000000000 --- a/objpascal/step3_env.pas +++ /dev/null @@ -1,173 +0,0 @@ -program Mal; - -{$H+} // Use AnsiString - -Uses sysutils, - CMem, - 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 -// Forward declation since eval_ast call it -function EVAL(Ast: TMal; Env: TEnv) : TMal; forward; - -function eval_ast(Ast: TMal; Env: TEnv) : TMal; -var - OldArr, NewArr : TMalArray; - OldDict, NewDict : TMalDict; - I : longint; -begin - if Ast is TMalSymbol then - begin - eval_ast := Env.Get((Ast as TMalSymbol)); - end - else if Ast is TMalList then - begin - OldArr := (Ast as TMalList).Val; - SetLength(NewArr, Length(OldArr)); - for I := 0 to Length(OldArr)-1 do - begin - NewArr[I] := EVAL(OldArr[I], Env); - end; - if Ast is TMalVector then - eval_ast := TMalVector.Create(NewArr) - else - eval_ast := TMalList.Create(NewArr); - end - else if Ast is TMalHashMap then - begin - OldDict := (Ast as TMalHashMap).Val; - NewDict := TMalDict.Create; - I := 0; - while I < OldDict.Count do - begin - NewDict[OldDict.Keys[I]] := EVAL(OldDict[OldDict.Keys[I]], Env); - I := I + 1; - end; - eval_ast := TMalHashMap.Create(NewDict); - end - else - eval_ast := Ast; -end; - -function EVAL(Ast: TMal; Env: TEnv) : TMal; -var - Arr : TMalArray; - Arr1 : TMalArray; - A0Sym : string; - LetEnv : TEnv; - I : longint; - Fn : TMalCallable; -begin - if Ast.ClassType <> TMalList then - Exit(eval_ast(Ast, Env)); - - // 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 - Arr := (eval_ast(Ast, Env) as TMalList).Val; - if Arr[0] is TMalFunc then - begin - Fn := (Arr[0] as TMalFunc).Val; - EVAL := Fn(copy(Arr, 1, Length(Arr)-1)); - 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/objpascal/step4_if_fn_do.pas b/objpascal/step4_if_fn_do.pas deleted file mode 100644 index f1204b7160..0000000000 --- a/objpascal/step4_if_fn_do.pas +++ /dev/null @@ -1,199 +0,0 @@ -program Mal; - -{$H+} // Use AnsiString - -Uses sysutils, - CMem, - 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 -// Forward declation since eval_ast call it -function EVAL(Ast: TMal; Env: TEnv) : TMal; forward; - -function eval_ast(Ast: TMal; Env: TEnv) : TMal; -var - OldArr, NewArr : TMalArray; - OldDict, NewDict : TMalDict; - I : longint; -begin - if Ast is TMalSymbol then - begin - eval_ast := Env.Get((Ast as TMalSymbol)); - end - else if Ast is TMalList then - begin - OldArr := (Ast as TMalList).Val; - SetLength(NewArr, Length(OldArr)); - for I := 0 to Length(OldArr)-1 do - begin - NewArr[I] := EVAL(OldArr[I], Env); - end; - if Ast is TMalVector then - eval_ast := TMalVector.Create(NewArr) - else - eval_ast := TMalList.Create(NewArr); - end - else if Ast is TMalHashMap then - begin - OldDict := (Ast as TMalHashMap).Val; - NewDict := TMalDict.Create; - I := 0; - while I < OldDict.Count do - begin - NewDict[OldDict.Keys[I]] := EVAL(OldDict[OldDict.Keys[I]], Env); - I := I + 1; - end; - eval_ast := TMalHashMap.Create(NewDict); - end - else - eval_ast := Ast; -end; - -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; -begin - if Ast.ClassType <> TMalList then - Exit(eval_ast(Ast, Env)); - - // 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 - Arr := (eval_ast(Lst.Rest, Env) as TMalList).Val; - EVAL := Arr[Length(Arr)-1]; - 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 - Arr := (eval_ast(Ast, Env) as TMalList).Val; - if Arr[0] is TMalFunc then - begin - Fn := Arr[0] as TMalFunc; - if Length(Arr) < 2 then - SetLength(Args, 0) - else - Args := copy(Arr, 1, Length(Arr)-1); - 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/objpascal/step5_tco.pas b/objpascal/step5_tco.pas deleted file mode 100644 index 6771931079..0000000000 --- a/objpascal/step5_tco.pas +++ /dev/null @@ -1,202 +0,0 @@ -program Mal; - -{$H+} // Use AnsiString - -Uses sysutils, - CMem, - 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 -// Forward declation since eval_ast call it -function EVAL(Ast: TMal; Env: TEnv) : TMal; forward; - -function eval_ast(Ast: TMal; Env: TEnv) : TMal; -var - OldArr, NewArr : TMalArray; - OldDict, NewDict : TMalDict; - I : longint; -begin - if Ast is TMalSymbol then - begin - eval_ast := Env.Get((Ast as TMalSymbol)); - end - else if Ast is TMalList then - begin - OldArr := (Ast as TMalList).Val; - SetLength(NewArr, Length(OldArr)); - for I := 0 to Length(OldArr)-1 do - begin - NewArr[I] := EVAL(OldArr[I], Env); - end; - if Ast is TMalVector then - eval_ast := TMalVector.Create(NewArr) - else - eval_ast := TMalList.Create(NewArr); - end - else if Ast is TMalHashMap then - begin - OldDict := (Ast as TMalHashMap).Val; - NewDict := TMalDict.Create; - I := 0; - while I < OldDict.Count do - begin - NewDict[OldDict.Keys[I]] := EVAL(OldDict[OldDict.Keys[I]], Env); - I := I + 1; - end; - eval_ast := TMalHashMap.Create(NewDict); - end - else - eval_ast := Ast; -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; -begin - while true do - begin - if Ast.ClassType <> TMalList then - Exit(eval_ast(Ast, Env)); - - // 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 - eval_ast(TMalList.Create(copy(Arr,1, Length(Arr)-2)), 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 - Arr := (eval_ast(Ast, Env) as TMalList).Val; - if Arr[0] is TMalFunc then - begin - Fn := Arr[0] as TMalFunc; - if Length(Arr) < 2 then - SetLength(Args, 0) - else - Args := copy(Arr, 1, Length(Arr)-1); - 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/objpascal/step6_file.pas b/objpascal/step6_file.pas deleted file mode 100644 index d4d3324deb..0000000000 --- a/objpascal/step6_file.pas +++ /dev/null @@ -1,223 +0,0 @@ -program Mal; - -{$H+} // Use AnsiString - -Uses sysutils, - CMem, - 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 -// Forward declation since eval_ast call it -function EVAL(Ast: TMal; Env: TEnv) : TMal; forward; - -function eval_ast(Ast: TMal; Env: TEnv) : TMal; -var - OldArr, NewArr : TMalArray; - OldDict, NewDict : TMalDict; - I : longint; -begin - if Ast is TMalSymbol then - begin - eval_ast := Env.Get((Ast as TMalSymbol)); - end - else if Ast is TMalList then - begin - OldArr := (Ast as TMalList).Val; - SetLength(NewArr, Length(OldArr)); - for I := 0 to Length(OldArr)-1 do - begin - NewArr[I] := EVAL(OldArr[I], Env); - end; - if Ast is TMalVector then - eval_ast := TMalVector.Create(NewArr) - else - eval_ast := TMalList.Create(NewArr); - end - else if Ast is TMalHashMap then - begin - OldDict := (Ast as TMalHashMap).Val; - NewDict := TMalDict.Create; - I := 0; - while I < OldDict.Count do - begin - NewDict[OldDict.Keys[I]] := EVAL(OldDict[OldDict.Keys[I]], Env); - I := I + 1; - end; - eval_ast := TMalHashMap.Create(NewDict); - end - else - eval_ast := Ast; -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; -begin - while true do - begin - if Ast.ClassType <> TMalList then - Exit(eval_ast(Ast, Env)); - - // 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 - eval_ast(TMalList.Create(copy(Arr,1, Length(Arr)-2)), 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 - Arr := (eval_ast(Ast, Env) as TMalList).Val; - if Arr[0] is TMalFunc then - begin - Fn := Arr[0] as TMalFunc; - if Length(Arr) < 2 then - SetLength(Args, 0) - else - Args := copy(Arr, 1, Length(Arr)-1); - 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) ")")))))'); - - 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/objpascal/step7_quote.pas b/objpascal/step7_quote.pas deleted file mode 100644 index 2455b1da3f..0000000000 --- a/objpascal/step7_quote.pas +++ /dev/null @@ -1,264 +0,0 @@ -program Mal; - -{$H+} // Use AnsiString - -Uses sysutils, - CMem, - 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 is_pair(x: TMal) : Boolean; -begin - is_pair := _sequential_Q(x) and (Length((x as TMalList).Val) > 0); -end; - -function quasiquote(Ast: TMal) : TMal; -var - Arr, Arr0 : TMalArray; - A0, A00 : TMal; -begin - if not is_pair(Ast) then - Exit(_list(TMalSymbol.Create('quote'), Ast)) - else - begin - Arr := (Ast as TMalList).Val; - A0 := Arr[0]; - if (A0 is TMalSymbol) and - ((A0 as TMalSymbol).Val = 'unquote') then - Exit(Arr[1]) - else if is_pair(A0) then - begin - Arr0 := (Arr[0] as TMalList).Val; - A00 := Arr0[0]; - if (A00 is TMalSymbol) and - ((A00 as TMalSymbol).Val = 'splice-unquote') then - Exit(_list(TMalSymbol.Create('concat'), - Arr0[1], - quasiquote((Ast as TMalList).Rest))); - end; - quasiquote := _list(TMalSymbol.Create('cons'), - quasiquote(A0), - quasiquote((Ast as TMalList).Rest)); - end; -end; - - - -// Forward declation since eval_ast call it -function EVAL(Ast: TMal; Env: TEnv) : TMal; forward; - -function eval_ast(Ast: TMal; Env: TEnv) : TMal; -var - OldArr, NewArr : TMalArray; - OldDict, NewDict : TMalDict; - I : longint; -begin - if Ast is TMalSymbol then - begin - eval_ast := Env.Get((Ast as TMalSymbol)); - end - else if Ast is TMalList then - begin - OldArr := (Ast as TMalList).Val; - SetLength(NewArr, Length(OldArr)); - for I := 0 to Length(OldArr)-1 do - begin - NewArr[I] := EVAL(OldArr[I], Env); - end; - if Ast is TMalVector then - eval_ast := TMalVector.Create(NewArr) - else - eval_ast := TMalList.Create(NewArr); - end - else if Ast is TMalHashMap then - begin - OldDict := (Ast as TMalHashMap).Val; - NewDict := TMalDict.Create; - I := 0; - while I < OldDict.Count do - begin - NewDict[OldDict.Keys[I]] := EVAL(OldDict[OldDict.Keys[I]], Env); - I := I + 1; - end; - eval_ast := TMalHashMap.Create(NewDict); - end - else - eval_ast := Ast; -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; -begin - while true do - begin - if Ast.ClassType <> TMalList then - Exit(eval_ast(Ast, Env)); - - // 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 - eval_ast(TMalList.Create(copy(Arr,1, Length(Arr)-2)), 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 - Arr := (eval_ast(Ast, Env) as TMalList).Val; - if Arr[0] is TMalFunc then - begin - Fn := Arr[0] as TMalFunc; - if Length(Arr) < 2 then - SetLength(Args, 0) - else - Args := copy(Arr, 1, Length(Arr)-1); - 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) ")")))))'); - - 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/objpascal/step8_macros.pas b/objpascal/step8_macros.pas deleted file mode 100644 index a0d9dba6fd..0000000000 --- a/objpascal/step8_macros.pas +++ /dev/null @@ -1,320 +0,0 @@ -program Mal; - -{$H+} // Use AnsiString - -Uses sysutils, - CMem, - 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 is_pair(x: TMal) : Boolean; -begin - is_pair := _sequential_Q(x) and (Length((x as TMalList).Val) > 0); -end; - -function quasiquote(Ast: TMal) : TMal; -var - Arr, Arr0 : TMalArray; - A0, A00 : TMal; -begin - if not is_pair(Ast) then - Exit(_list(TMalSymbol.Create('quote'), Ast)) - else - begin - Arr := (Ast as TMalList).Val; - A0 := Arr[0]; - if (A0 is TMalSymbol) and - ((A0 as TMalSymbol).Val = 'unquote') then - Exit(Arr[1]) - else if is_pair(A0) then - begin - Arr0 := (Arr[0] as TMalList).Val; - A00 := Arr0[0]; - if (A00 is TMalSymbol) and - ((A00 as TMalSymbol).Val = 'splice-unquote') then - Exit(_list(TMalSymbol.Create('concat'), - Arr0[1], - quasiquote((Ast as TMalList).Rest))); - end; - quasiquote := _list(TMalSymbol.Create('cons'), - quasiquote(A0), - quasiquote((Ast as TMalList).Rest)); - end; -end; - -function is_macro_call(Ast: TMal; Env: TEnv): Boolean; -var - A0 : TMal; - Mac : TMal; -begin - is_macro_call := false; - if (Ast.ClassType = TMalList) and - (Length((Ast as TMalList).Val) > 0) then - begin - A0 := (Ast as TMalList).Val[0]; - if (A0 is TMalSymbol) and - (Env.Find(A0 as TMalSymbol) <> nil) then - begin - Mac := Env.Get((A0 as TMalSymbol)); - if Mac is TMalFunc then - is_macro_call := (Mac as TMalFunc).isMacro; - end; - end; - -end; - -// Forward declation since eval_ast call it -function EVAL(Ast: TMal; Env: TEnv) : TMal; forward; - -function macroexpand(Ast: TMal; Env: TEnv): TMal; -var - A0 : TMal; - Arr : TMalArray; - Args : TMalArray; - Mac : TMalFunc; -begin - while is_macro_call(Ast, Env) do - begin - Arr := (Ast as TMalList).Val; - A0 := Arr[0]; - Mac := Env.Get((A0 as TMalSymbol)) as TMalFunc; - Args := (Ast as TMalList).Rest.Val; - if Mac.Ast = nil then - Ast := Mac.Val(Args) - else - Ast := EVAL(Mac.Ast, - TEnv.Create(Mac.Env, Mac.Params, Args)); - end; - macroexpand := Ast; -end; - -function eval_ast(Ast: TMal; Env: TEnv) : TMal; -var - OldArr, NewArr : TMalArray; - OldDict, NewDict : TMalDict; - I : longint; -begin - if Ast is TMalSymbol then - begin - eval_ast := Env.Get((Ast as TMalSymbol)); - end - else if Ast is TMalList then - begin - OldArr := (Ast as TMalList).Val; - SetLength(NewArr, Length(OldArr)); - for I := 0 to Length(OldArr)-1 do - begin - NewArr[I] := EVAL(OldArr[I], Env); - end; - if Ast is TMalVector then - eval_ast := TMalVector.Create(NewArr) - else - eval_ast := TMalList.Create(NewArr); - end - else if Ast is TMalHashMap then - begin - OldDict := (Ast as TMalHashMap).Val; - NewDict := TMalDict.Create; - I := 0; - while I < OldDict.Count do - begin - NewDict[OldDict.Keys[I]] := EVAL(OldDict[OldDict.Keys[I]], Env); - I := I + 1; - end; - eval_ast := TMalHashMap.Create(NewDict); - end - else - eval_ast := Ast; -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; -begin - while true do - begin - if Ast.ClassType <> TMalList then - Exit(eval_ast(Ast, Env)); - - Ast := macroexpand(Ast, Env); - if Ast.ClassType <> TMalList then - Exit(eval_ast(Ast, Env)); - - // 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.isMacro := true; - Exit(Env.Add((Arr[1] as TMalSymbol), Fn)); - end; - 'macroexpand': - Exit(macroexpand(Arr[1], Env)); - 'do': - begin - eval_ast(TMalList.Create(copy(Arr,1, Length(Arr)-2)), 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 - Arr := (eval_ast(Ast, Env) as TMalList).Val; - if Arr[0] is TMalFunc then - begin - Fn := Arr[0] as TMalFunc; - if Length(Arr) < 2 then - SetLength(Args, 0) - else - Args := copy(Arr, 1, Length(Arr)-1); - 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) ")")))))'); - 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 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/objpascal/step9_try.pas b/objpascal/step9_try.pas deleted file mode 100644 index e8626974c0..0000000000 --- a/objpascal/step9_try.pas +++ /dev/null @@ -1,340 +0,0 @@ -program Mal; - -{$H+} // Use AnsiString - -Uses sysutils, - CMem, - 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 is_pair(x: TMal) : Boolean; -begin - is_pair := _sequential_Q(x) and (Length((x as TMalList).Val) > 0); -end; - -function quasiquote(Ast: TMal) : TMal; -var - Arr, Arr0 : TMalArray; - A0, A00 : TMal; -begin - if not is_pair(Ast) then - Exit(_list(TMalSymbol.Create('quote'), Ast)) - else - begin - Arr := (Ast as TMalList).Val; - A0 := Arr[0]; - if (A0 is TMalSymbol) and - ((A0 as TMalSymbol).Val = 'unquote') then - Exit(Arr[1]) - else if is_pair(A0) then - begin - Arr0 := (Arr[0] as TMalList).Val; - A00 := Arr0[0]; - if (A00 is TMalSymbol) and - ((A00 as TMalSymbol).Val = 'splice-unquote') then - Exit(_list(TMalSymbol.Create('concat'), - Arr0[1], - quasiquote((Ast as TMalList).Rest))); - end; - quasiquote := _list(TMalSymbol.Create('cons'), - quasiquote(A0), - quasiquote((Ast as TMalList).Rest)); - end; -end; - -function is_macro_call(Ast: TMal; Env: TEnv): Boolean; -var - A0 : TMal; - Mac : TMal; -begin - is_macro_call := false; - if (Ast.ClassType = TMalList) and - (Length((Ast as TMalList).Val) > 0) then - begin - A0 := (Ast as TMalList).Val[0]; - if (A0 is TMalSymbol) and - (Env.Find(A0 as TMalSymbol) <> nil) then - begin - Mac := Env.Get((A0 as TMalSymbol)); - if Mac is TMalFunc then - is_macro_call := (Mac as TMalFunc).isMacro; - end; - end; - -end; - -// Forward declation since eval_ast call it -function EVAL(Ast: TMal; Env: TEnv) : TMal; forward; - -function macroexpand(Ast: TMal; Env: TEnv): TMal; -var - A0 : TMal; - Arr : TMalArray; - Args : TMalArray; - Mac : TMalFunc; -begin - while is_macro_call(Ast, Env) do - begin - Arr := (Ast as TMalList).Val; - A0 := Arr[0]; - Mac := Env.Get((A0 as TMalSymbol)) as TMalFunc; - Args := (Ast as TMalList).Rest.Val; - if Mac.Ast = nil then - Ast := Mac.Val(Args) - else - Ast := EVAL(Mac.Ast, - TEnv.Create(Mac.Env, Mac.Params, Args)); - end; - macroexpand := Ast; -end; - -function eval_ast(Ast: TMal; Env: TEnv) : TMal; -var - OldArr, NewArr : TMalArray; - OldDict, NewDict : TMalDict; - I : longint; -begin - if Ast is TMalSymbol then - begin - eval_ast := Env.Get((Ast as TMalSymbol)); - end - else if Ast is TMalList then - begin - OldArr := (Ast as TMalList).Val; - SetLength(NewArr, Length(OldArr)); - for I := 0 to Length(OldArr)-1 do - begin - NewArr[I] := EVAL(OldArr[I], Env); - end; - if Ast is TMalVector then - eval_ast := TMalVector.Create(NewArr) - else - eval_ast := TMalList.Create(NewArr); - end - else if Ast is TMalHashMap then - begin - OldDict := (Ast as TMalHashMap).Val; - NewDict := TMalDict.Create; - I := 0; - while I < OldDict.Count do - begin - NewDict[OldDict.Keys[I]] := EVAL(OldDict[OldDict.Keys[I]], Env); - I := I + 1; - end; - eval_ast := TMalHashMap.Create(NewDict); - end - else - eval_ast := Ast; -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; -begin - while true do - begin - if Ast.ClassType <> TMalList then - Exit(eval_ast(Ast, Env)); - - Ast := macroexpand(Ast, Env); - if Ast.ClassType <> TMalList then - Exit(eval_ast(Ast, Env)); - - // 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.isMacro := true; - Exit(Env.Add((Arr[1] as TMalSymbol), Fn)); - end; - 'macroexpand': - Exit(macroexpand(Arr[1], Env)); - 'try*': - begin - try - Exit(EVAL(Arr[1], Env)); - except - On E : Exception do - begin - 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 - eval_ast(TMalList.Create(copy(Arr,1, Length(Arr)-2)), 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 - Arr := (eval_ast(Ast, Env) as TMalList).Val; - if Arr[0] is TMalFunc then - begin - Fn := Arr[0] as TMalFunc; - if Length(Arr) < 2 then - SetLength(Args, 0) - else - Args := copy(Arr, 1, Length(Arr)-1); - 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) ")")))))'); - 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 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/objpascal/stepA_mal.pas b/objpascal/stepA_mal.pas deleted file mode 100644 index 93002dff22..0000000000 --- a/objpascal/stepA_mal.pas +++ /dev/null @@ -1,345 +0,0 @@ -program Mal; - -{$H+} // Use AnsiString - -Uses sysutils, - CMem, - 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 is_pair(x: TMal) : Boolean; -begin - is_pair := _sequential_Q(x) and (Length((x as TMalList).Val) > 0); -end; - -function quasiquote(Ast: TMal) : TMal; -var - Arr, Arr0 : TMalArray; - A0, A00 : TMal; -begin - if not is_pair(Ast) then - Exit(_list(TMalSymbol.Create('quote'), Ast)) - else - begin - Arr := (Ast as TMalList).Val; - A0 := Arr[0]; - if (A0 is TMalSymbol) and - ((A0 as TMalSymbol).Val = 'unquote') then - Exit(Arr[1]) - else if is_pair(A0) then - begin - Arr0 := (Arr[0] as TMalList).Val; - A00 := Arr0[0]; - if (A00 is TMalSymbol) and - ((A00 as TMalSymbol).Val = 'splice-unquote') then - Exit(_list(TMalSymbol.Create('concat'), - Arr0[1], - quasiquote((Ast as TMalList).Rest))); - end; - quasiquote := _list(TMalSymbol.Create('cons'), - quasiquote(A0), - quasiquote((Ast as TMalList).Rest)); - end; -end; - -function is_macro_call(Ast: TMal; Env: TEnv): Boolean; -var - A0 : TMal; - Mac : TMal; -begin - is_macro_call := false; - if (Ast.ClassType = TMalList) and - (Length((Ast as TMalList).Val) > 0) then - begin - A0 := (Ast as TMalList).Val[0]; - if (A0 is TMalSymbol) and - (Env.Find(A0 as TMalSymbol) <> nil) then - begin - Mac := Env.Get((A0 as TMalSymbol)); - if Mac is TMalFunc then - is_macro_call := (Mac as TMalFunc).isMacro; - end; - end; - -end; - -// Forward declation since eval_ast call it -function EVAL(Ast: TMal; Env: TEnv) : TMal; forward; - -function macroexpand(Ast: TMal; Env: TEnv): TMal; -var - A0 : TMal; - Arr : TMalArray; - Args : TMalArray; - Mac : TMalFunc; -begin - while is_macro_call(Ast, Env) do - begin - Arr := (Ast as TMalList).Val; - A0 := Arr[0]; - Mac := Env.Get((A0 as TMalSymbol)) as TMalFunc; - Args := (Ast as TMalList).Rest.Val; - if Mac.Ast = nil then - Ast := Mac.Val(Args) - else - Ast := EVAL(Mac.Ast, - TEnv.Create(Mac.Env, Mac.Params, Args)); - end; - macroexpand := Ast; -end; - -function eval_ast(Ast: TMal; Env: TEnv) : TMal; -var - OldArr, NewArr : TMalArray; - OldDict, NewDict : TMalDict; - I : longint; -begin - if Ast is TMalSymbol then - begin - eval_ast := Env.Get((Ast as TMalSymbol)); - end - else if Ast is TMalList then - begin - OldArr := (Ast as TMalList).Val; - SetLength(NewArr, Length(OldArr)); - for I := 0 to Length(OldArr)-1 do - begin - NewArr[I] := EVAL(OldArr[I], Env); - end; - if Ast is TMalVector then - eval_ast := TMalVector.Create(NewArr) - else - eval_ast := TMalList.Create(NewArr); - end - else if Ast is TMalHashMap then - begin - OldDict := (Ast as TMalHashMap).Val; - NewDict := TMalDict.Create; - I := 0; - while I < OldDict.Count do - begin - NewDict[OldDict.Keys[I]] := EVAL(OldDict[OldDict.Keys[I]], Env); - I := I + 1; - end; - eval_ast := TMalHashMap.Create(NewDict); - end - else - eval_ast := Ast; -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; -begin - while true do - begin - if Ast.ClassType <> TMalList then - Exit(eval_ast(Ast, Env)); - - Ast := macroexpand(Ast, Env); - if Ast.ClassType <> TMalList then - Exit(eval_ast(Ast, Env)); - - // 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.isMacro := true; - Exit(Env.Add((Arr[1] as TMalSymbol), Fn)); - end; - 'macroexpand': - Exit(macroexpand(Arr[1], Env)); - 'try*': - begin - try - Exit(EVAL(Arr[1], Env)); - except - On E : Exception do - begin - 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 - eval_ast(TMalList.Create(copy(Arr,1, Length(Arr)-2)), 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 - Arr := (eval_ast(Ast, Env) as TMalList).Val; - if Arr[0] is TMalFunc then - begin - Fn := Arr[0] as TMalFunc; - if Length(Arr) < 2 then - SetLength(Args, 0) - else - Args := copy(Arr, 1, Length(Arr)-1); - 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) ")")))))'); - 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! *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)))))))))'); - - - 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 - WriteLn('Error: ' + E.message); - WriteLn('Backtrace:'); - WriteLn(GetBacktrace(E)); - end; - end; - end; -end. diff --git a/ocaml/Dockerfile b/ocaml/Dockerfile deleted file mode 100644 index fbad0fc2d3..0000000000 --- a/ocaml/Dockerfile +++ /dev/null @@ -1,25 +0,0 @@ -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 -########################################################## - -RUN apt-get -y install ocaml-batteries-included - diff --git a/ocaml/Makefile b/ocaml/Makefile deleted file mode 100644 index 6a2bb69ae1..0000000000 --- a/ocaml/Makefile +++ /dev/null @@ -1,40 +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) - -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 $@ - -$(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 $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*\(\*|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: env.ml core.ml stepA_mal.ml - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*\(\*|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" - -.PHONY: all repl clean stats stats-lisp diff --git a/ocaml/core.ml b/ocaml/core.ml deleted file mode 100644 index b1633406fc..0000000000 --- a/ocaml/core.ml +++ /dev/null @@ -1,217 +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 mal_seq = function - | [T.Nil] -> T.Nil - | [T.List {T.value = []}] - | [T.Vector {T.value = []}] -> T.Nil - | [T.List _ as lst] -> lst - | [T.Vector {T.value = xs}] -> Types.list xs - | [T.String ""] -> T.Nil - | [T.String s] -> Types.list (List.map (fun x -> T.String x) (Str.split (Str.regexp "") s)) - | _ -> T.Nil - -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 - | [a; b] -> T.Bool (Types.mal_equal 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 "string?") - (Types.fn (function [T.String _] -> T.Bool true | _ -> T.Bool false)); - 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 "seq") (Types.fn mal_seq); - - 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 74a8c64502..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 fa009e255a..0000000000 --- a/ocaml/reader.ml +++ /dev/null @@ -1,116 +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) - | '-' -> (match String.length token with - | 1 -> Types.symbol token - | _ -> (match token.[1] with - | '0'..'9' -> T.Int (int_of_string token) - | _ -> Types.symbol 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/run b/ocaml/run deleted file mode 100755 index 8ba68a5484..0000000000 --- a/ocaml/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec $(dirname $0)/${STEP:-stepA_mal} "${@}" 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 ef7d131675..0000000000 --- a/ocaml/step3_env.ml +++ /dev/null @@ -1,74 +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 = [] } -> ast - | 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 0e0cbaf76f..0000000000 --- a/ocaml/step4_if_fn_do.ml +++ /dev/null @@ -1,84 +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 = [] } -> ast - | 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 07df7c4fe1..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 = [] } -> ast - | 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)); - 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); - - 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 e855133ec5..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 = [] } -> ast - | 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)); - 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); - - 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 93113e5ad5..0000000000 --- a/ocaml/step8_macros.ml +++ /dev/null @@ -1,145 +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 = [] } -> ast - | 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 1885359ffe..0000000000 --- a/ocaml/step9_try.ml +++ /dev/null @@ -1,165 +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 = [] } -> ast - | 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 - try - ignore (rep ("(load-file \"" ^ Sys.argv.(1) ^ "\")") repl_env); - with - | Types.MalExn exc -> - output_string stderr ("Exception: " ^ (print exc) ^ "\n"); - flush stderr - else - while true do - print_string "user> "; - let line = read_line () in - try - print_endline (rep line repl_env); - with End_of_file -> () - | Types.MalExn exc -> - output_string stderr ("Exception: " ^ (print exc) ^ "\n"); - flush stderr - | 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 c36e6c87e3..0000000000 --- a/ocaml/stepA_mal.ml +++ /dev/null @@ -1,170 +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 = [] } -> ast - | 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 "(def! *gensym-counter* (atom 0))" repl_env); - ignore (rep "(def! gensym (fn* [] (symbol (str \"G__\" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))" repl_env); - ignore (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)))))))))" repl_env); - - if Array.length Sys.argv > 1 then - try - ignore (rep ("(load-file \"" ^ Sys.argv.(1) ^ "\")") repl_env); - with - | Types.MalExn exc -> - output_string stderr ("Exception: " ^ (print exc) ^ "\n"); - flush stderr - 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 -> () - | Types.MalExn exc -> - output_string stderr ("Exception: " ^ (print exc) ^ "\n"); - flush stderr - | 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 45d10bdb30..0000000000 --- a/ocaml/types.ml +++ /dev/null @@ -1,69 +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") - -let rec mal_list_equal a b = - List.length a = List.length b && List.for_all2 mal_equal a b - -and mal_hash_equal a b = - if MalMap.cardinal a = MalMap.cardinal b - then - let identical_to_b k v = MalMap.mem k b && mal_equal v (MalMap.find k b) in - MalMap.for_all identical_to_b a - else false - -and mal_equal a b = - match (a, b) with - | (Types.List a, Types.List b) - | (Types.List a, Types.Vector b) - | (Types.Vector a, Types.List b) - | (Types.Vector a, Types.Vector b) -> mal_list_equal a.Types.value b.Types.value - | (Types.Map a, Types.Map b) -> mal_hash_equal a.Types.value b.Types.value - | _ -> a = b 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/Dockerfile b/perl/Dockerfile deleted file mode 100644 index b36833e072..0000000000 --- a/perl/Dockerfile +++ /dev/null @@ -1,24 +0,0 @@ -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 -########################################################## - -RUN apt-get -y install perl libapp-fatpacker-perl diff --git a/perl/Makefile b/perl/Makefile deleted file mode 100644 index 947edc46ef..0000000000 --- a/perl/Makefile +++ /dev/null @@ -1,42 +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: - -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/* - [ -d fatlib ] && rmdir fatlib || true - -.PHONY: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*#|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*#|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" - -tests: $(TESTS) - -$(TESTS): - @echo "Running $@"; \ - ruby $@ || exit 1; \ diff --git a/perl/core.pm b/perl/core.pm deleted file mode 100644 index 7810ab38ab..0000000000 --- a/perl/core.pm +++ /dev/null @@ -1,278 +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 _string_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 $nil if (_nil_Q($seq)); - return scalar(@{$seq->{val}}) > 0 ? $seq->nth(0) : $nil; -} - -sub rest { return _nil_Q($_[0]) ? List->new([]) : $_[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); -} - -sub conj { - my ($lst, @args) = @{$_[0]->{val}}; - my $new_lst = _clone($lst); - if (_list_Q($new_lst)) { - unshift @{$new_lst->{val}}, reverse @args; - } else { - push @{$new_lst->{val}}, @args; - } - return $new_lst; -} - -sub seq { - my ($arg) = @_; - if (_nil_Q($arg)) { - return $nil; - } elsif (_list_Q($arg)) { - return $nil if scalar(@{$arg->{val}}) == 0; - return $arg; - # return scalar(@{$arg->{val}}) > 0 ? $arg : $nil; - } elsif (_vector_Q($arg)) { - return $nil if scalar(@{$arg->{val}}) == 0; - return List->new($arg->{val}); - } elsif (_string_Q($arg)) { - return $nil if length($$arg) == 0; - my @chars = map { String->new($_) } split(//, $$arg); - return List->new(\@chars); - } else { - die "seq requires list or vector or string or nil"; - } -} - -# 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 }, - 'string?' => sub { _string_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' => \&conj, - 'seq' => sub { seq($_[0]->nth(0)) }, - - '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 441dbe3a94..0000000000 --- a/perl/printer.pm +++ /dev/null @@ -1,58 +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 9527231df3..0000000000 --- a/perl/reader.pm +++ /dev/null @@ -1,120 +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; - $str =~ s/\\\\/\\/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 149c3fb1d8..0000000000 --- a/perl/readline.pm +++ /dev/null @@ -1,73 +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); - chomp $line; - return $line; - } else { - return undef; - } - } else { - print "$prompt"; - if (defined ($line = readline(*STDIN))) { - save_line($line); - chomp($line); - return $line; - } else { - return undef; - } - } -} -1; diff --git a/perl/run b/perl/run deleted file mode 100755 index 05a286f8af..0000000000 --- a/perl/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec perl $(dirname $0)/${STEP:-stepA_mal}.pl "${@}" 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 a2f15cbd37..0000000000 --- a/perl/step0_repl.pl +++ /dev/null @@ -1,38 +0,0 @@ -use strict; -use warnings FATAL => qw(all); -use File::Basename; -use lib dirname (__FILE__); -use readline qw(mal_readline set_rl_mode); - -# 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), {})); -} - -if (scalar(@ARGV) > 0 && $ARGV[0] eq "--raw") { - set_rl_mode("raw"); -} -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 1b136f3206..0000000000 --- a/perl/step2_eval.pl +++ /dev/null @@ -1,110 +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 - if (scalar(@{$ast->{val}}) == 0) { return $ast; } - 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 c9bd85d710..0000000000 --- a/perl/step3_env.pl +++ /dev/null @@ -1,123 +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}}; - if (!$a0) { return $ast; } - 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 b9f8cc96b2..0000000000 --- a/perl/step4_if_fn_do.pl +++ /dev/null @@ -1,146 +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}}; - if (!$a0) { return $ast; } - 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 a28c0d9eb2..0000000000 --- a/perl/step5_tco.pl +++ /dev/null @@ -1,157 +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}}; - if (!$a0) { return $ast; } - 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 2eef3544c3..0000000000 --- a/perl/step6_file.pl +++ /dev/null @@ -1,166 +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}}; - if (!$a0) { return $ast; } - 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 b8503489e5..0000000000 --- a/perl/step7_quote.pl +++ /dev/null @@ -1,196 +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}}; - if (!$a0) { return $ast; } - 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 62b4723c17..0000000000 --- a/perl/step8_macros.pl +++ /dev/null @@ -1,235 +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 eval_ast($ast, $env); - } - - my ($a0, $a1, $a2, $a3) = @{$ast->{val}}; - if (!$a0) { return $ast; } - 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 8b4b06a9ec..0000000000 --- a/perl/step9_try.pl +++ /dev/null @@ -1,263 +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 eval_ast($ast, $env); - } - - my ($a0, $a1, $a2, $a3) = @{$ast->{val}}; - if (!$a0) { return $ast; } - 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 2911ccf15b..0000000000 --- a/perl/stepA_mal.pl +++ /dev/null @@ -1,270 +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 eval_ast($ast, $env); - } - - my ($a0, $a1, $a2, $a3) = @{$ast->{val}}; - if (!$a0) { return $ast; } - 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* \"perl\")"); -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! *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)))))))))"); - - -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 4e80f3f495..0000000000 --- a/perl/types.pm +++ /dev/null @@ -1,242 +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 _string_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/) { - if (! (scalar(keys %{ $a->{val} }) == scalar(keys %{ $b->{val} }))) { - return 0; - } - foreach my $k (keys %{ $a->{val} }) { - if (!_equal_Q($a->{val}->{$k}, $b->{val}->{$k})) { - return 0; - } - } - return 1; - } - default { - return $$a eq $$b; - } - } - return 0; -} - -sub _clone { - my ($obj) = @_; - given (ref $obj) { - when (/^CODE/) { - return FunctionRef->new( $obj ); - } - default { - return bless {%{$obj}}, ref $obj; - } - } -} - -# 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 \do { my $x=$_[0] }, $class } -} - - -{ - package Symbol; - sub new { my $class = shift; bless \do { my $x=$_[0] }, $class } -} -sub _symbol_Q { (ref $_[0]) =~ /^Symbol/ } - - -sub _string_Q { ((ref $_[0]) =~ /^String/) && ${$_[0]} !~ /^\x{029e}/; } - - -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 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])); - } -} - - -# FunctionRef - -{ - package FunctionRef; - sub new { - my ($class, $code) = @_; - bless {'meta'=>$nil, - 'code'=>$code}, $class - } - sub apply { - my $self = $_[0]; - return &{ $self->{code} }($_[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/perl6/Makefile b/perl6/Makefile deleted file mode 100644 index 09f99ce2e1..0000000000 --- a/perl6/Makefile +++ /dev/null @@ -1,2 +0,0 @@ -all: - @true diff --git a/perl6/core.pm b/perl6/core.pm deleted file mode 100644 index a3f20253bd..0000000000 --- a/perl6/core.pm +++ /dev/null @@ -1,101 +0,0 @@ -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})]) }), - 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 }), - 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/perl6/env.pm b/perl6/env.pm deleted file mode 100644 index c0f483726c..0000000000 --- a/perl6/env.pm +++ /dev/null @@ -1,36 +0,0 @@ -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 find ($key) { - return %.data{$key} ?? self !! $.outer && $.outer.find($key); -} - -method get ($key) { - my $env = self.find($key) or die X::MalNotFound.new(name => $key); - return $env.data{$key}; -} diff --git a/perl6/reader.pm b/perl6/reader.pm deleted file mode 100644 index c8f7ed32c7..0000000000 --- a/perl6/reader.pm +++ /dev/null @@ -1,85 +0,0 @@ -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 /^\"/ { - die X::MalIncomplete.new(end => '"') if $atom !~~ /\"$/; - s:g/^\"|\"$//; - MalString(.trans(/\\\"/ => '"', /\\n/ => "\n", /\\\\/ => '\\')); - } - 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/perl6/run b/perl6/run deleted file mode 100755 index d22ca7b7cf..0000000000 --- a/perl6/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec perl6 $(dirname $0)/${STEP:-stepA_mal}.pl "${@}" diff --git a/perl6/step2_eval.pl b/perl6/step2_eval.pl deleted file mode 100644 index a2d010f91b..0000000000 --- a/perl6/step2_eval.pl +++ /dev/null @@ -1,52 +0,0 @@ -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 ($ast, $env) { - given $ast { - when MalSymbol { $env{$ast.val} || die X::MalNotFound.new(name => $ast.val) } - when MalList { MalList([$ast.map({ eval($_, $env) })]) } - when MalVector { MalVector([$ast.map({ eval($_, $env) })]) } - when MalHashMap { MalHashMap($ast.kv.map({ $^a => eval($^b, $env) }).Hash) } - default { $ast // $NIL } - } -} - -sub eval ($ast, $env) { - return eval_ast($ast, $env) if $ast !~~ MalList; - return $ast if !$ast.elems; - - my ($func, @args) = eval_ast($ast, $env).val; - 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/perl6/step3_env.pl b/perl6/step3_env.pl deleted file mode 100644 index 2730211ced..0000000000 --- a/perl6/step3_env.pl +++ /dev/null @@ -1,67 +0,0 @@ -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 ($ast, $env) { - given $ast { - when MalSymbol { $env.get($ast.val) || die X::MalNotFound.new(name => $ast.val) } - when MalList { MalList([$ast.map({ eval($_, $env) })]) } - when MalVector { MalVector([$ast.map({ eval($_, $env) })]) } - when MalHashMap { MalHashMap($ast.kv.map({ $^a => eval($^b, $env) }).Hash) } - default { $ast // $NIL } - } -} - -sub eval ($ast, $env) { - return eval_ast($ast, $env) if $ast !~~ MalList; - 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) = eval_ast($ast, $env).val; - 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/perl6/step4_if_fn_do.pl b/perl6/step4_if_fn_do.pl deleted file mode 100644 index 0aa8d61598..0000000000 --- a/perl6/step4_if_fn_do.pl +++ /dev/null @@ -1,80 +0,0 @@ -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 ($ast, $env) { - given $ast { - when MalSymbol { $env.get($ast.val) || die X::MalNotFound.new(name => $ast.val) } - when MalList { MalList([$ast.map({ eval($_, $env) })]) } - when MalVector { MalVector([$ast.map({ eval($_, $env) })]) } - when MalHashMap { MalHashMap($ast.kv.map({ $^a => eval($^b, $env) }).Hash) } - default { $ast // $NIL } - } -} - -sub eval ($ast, $env) { - return eval_ast($ast, $env) if $ast !~~ MalList; - 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' { - return eval_ast(MalList([$ast[1..*]]), $env)[*-1]; - } - 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) = eval_ast($ast, $env).val; - 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/perl6/step5_tco.pl b/perl6/step5_tco.pl deleted file mode 100644 index 7e7cbb7eed..0000000000 --- a/perl6/step5_tco.pl +++ /dev/null @@ -1,91 +0,0 @@ -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 ($ast, $env) { - given $ast { - when MalSymbol { $env.get($ast.val) || die X::MalNotFound.new(name => $ast.val) } - when MalList { MalList([$ast.map({ eval($_, $env) })]) } - when MalVector { MalVector([$ast.map({ eval($_, $env) })]) } - when MalHashMap { MalHashMap($ast.kv.map({ $^a => eval($^b, $env) }).Hash) } - default { $ast // $NIL } - } -} - -sub eval ($ast is copy, $env is copy) { - loop { - return eval_ast($ast, $env) if $ast !~~ MalList; - 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' { - eval_ast(MalList([$ast[1..*-2]]), $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) = eval_ast($ast, $env).val; - 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/perl6/step6_file.pl b/perl6/step6_file.pl deleted file mode 100644 index 7a9c198a54..0000000000 --- a/perl6/step6_file.pl +++ /dev/null @@ -1,99 +0,0 @@ -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 ($ast, $env) { - given $ast { - when MalSymbol { $env.get($ast.val) || die X::MalNotFound.new(name => $ast.val) } - when MalList { MalList([$ast.map({ eval($_, $env) })]) } - when MalVector { MalVector([$ast.map({ eval($_, $env) })]) } - when MalHashMap { MalHashMap($ast.kv.map({ $^a => eval($^b, $env) }).Hash) } - default { $ast // $NIL } - } -} - -sub eval ($ast is copy, $env is copy) { - loop { - return eval_ast($ast, $env) if $ast !~~ MalList; - 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' { - eval_ast(MalList([$ast[1..*-2]]), $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) = eval_ast($ast, $env).val; - 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) ")")))))}); - - 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/perl6/step7_quote.pl b/perl6/step7_quote.pl deleted file mode 100644 index 33e69f14ae..0000000000 --- a/perl6/step7_quote.pl +++ /dev/null @@ -1,120 +0,0 @@ -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 ($ast, $env) { - given $ast { - when MalSymbol { $env.get($ast.val) || die X::MalNotFound.new(name => $ast.val) } - when MalList { MalList([$ast.map({ eval($_, $env) })]) } - when MalVector { MalVector([$ast.map({ eval($_, $env) })]) } - when MalHashMap { MalHashMap($ast.kv.map({ $^a => eval($^b, $env) }).Hash) } - default { $ast // $NIL } - } -} - -sub is_pair ($ast) { - return so $ast ~~ MalList|MalVector && $ast.elems; -} - -sub quasiquote ($ast) { - if !is_pair($ast) { - return MalList([MalSymbol('quote'), $ast]); - } - elsif $ast[0] ~~ MalSymbol && $ast[0].val eq 'unquote' { - return $ast[1]; - } - elsif is_pair($ast[0]) && $ast[0][0] ~~ MalSymbol && $ast[0][0].val eq 'splice-unquote' { - return MalList([MalSymbol('concat'), $ast[0][1], quasiquote(MalList([$ast[1..*]]))]); - } - else { - return MalList([MalSymbol('cons'), quasiquote($ast[0]), quasiquote(MalList([$ast[1..*]]))]); - } -} - -sub eval ($ast is copy, $env is copy) { - loop { - return eval_ast($ast, $env) if $ast !~~ MalList; - 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' { - eval_ast(MalList([$ast[1..*-2]]), $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) = eval_ast($ast, $env).val; - 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) ")")))))}); - - 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/perl6/step8_macros.pl b/perl6/step8_macros.pl deleted file mode 100644 index 39491593fc..0000000000 --- a/perl6/step8_macros.pl +++ /dev/null @@ -1,143 +0,0 @@ -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 ($ast, $env) { - given $ast { - when MalSymbol { $env.get($ast.val) || die X::MalNotFound.new(name => $ast.val) } - when MalList { MalList([$ast.map({ eval($_, $env) })]) } - when MalVector { MalVector([$ast.map({ eval($_, $env) })]) } - when MalHashMap { MalHashMap($ast.kv.map({ $^a => eval($^b, $env) }).Hash) } - default { $ast // $NIL } - } -} - -sub is_pair ($ast) { - return so $ast ~~ MalList|MalVector && $ast.elems; -} - -sub quasiquote ($ast) { - if !is_pair($ast) { - return MalList([MalSymbol('quote'), $ast]); - } - elsif $ast[0] ~~ MalSymbol && $ast[0].val eq 'unquote' { - return $ast[1]; - } - elsif is_pair($ast[0]) && $ast[0][0] ~~ MalSymbol && $ast[0][0].val eq 'splice-unquote' { - return MalList([MalSymbol('concat'), $ast[0][1], quasiquote(MalList([$ast[1..*]]))]); - } - else { - return MalList([MalSymbol('cons'), quasiquote($ast[0]), quasiquote(MalList([$ast[1..*]]))]); - } -} - -sub is_macro_call ($ast, $env) { - return so $ast ~~ MalList && $ast[0] ~~ MalSymbol - && $env.find($ast[0].val).?get($ast[0].val).?is_macro; -} - -sub macroexpand ($ast is copy, $env is copy) { - while is_macro_call($ast, $env) { - my $func = $env.get($ast[0].val); - $ast = $func.apply($ast[1..*]); - } - return $ast; -} - -sub eval ($ast is copy, $env is copy) { - loop { - return eval_ast($ast, $env) if $ast !~~ MalList; - $ast = macroexpand($ast, $env); - return eval_ast($ast, $env) if $ast !~~ MalList; - 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' { - eval_ast(MalList([$ast[1..*-2]]), $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.is_macro = True; - return $env.set($a1.val, $func); - } - when 'macroexpand' { return macroexpand($a1, $env) } - default { - my ($func, @args) = eval_ast($ast, $env).val; - 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) ")")))))}); - 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)))))))}); - rep(q{(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 ($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/perl6/step9_try.pl b/perl6/step9_try.pl deleted file mode 100644 index 30c3a4ce74..0000000000 --- a/perl6/step9_try.pl +++ /dev/null @@ -1,152 +0,0 @@ -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 ($ast, $env) { - given $ast { - when MalSymbol { $env.get($ast.val) || die X::MalNotFound.new(name => $ast.val) } - when MalList { MalList([$ast.map({ eval($_, $env) })]) } - when MalVector { MalVector([$ast.map({ eval($_, $env) })]) } - when MalHashMap { MalHashMap($ast.kv.map({ $^a => eval($^b, $env) }).Hash) } - default { $ast // $NIL } - } -} - -sub is_pair ($ast) { - return so $ast ~~ MalList|MalVector && $ast.elems; -} - -sub quasiquote ($ast) { - if !is_pair($ast) { - return MalList([MalSymbol('quote'), $ast]); - } - elsif $ast[0] ~~ MalSymbol && $ast[0].val eq 'unquote' { - return $ast[1]; - } - elsif is_pair($ast[0]) && $ast[0][0] ~~ MalSymbol && $ast[0][0].val eq 'splice-unquote' { - return MalList([MalSymbol('concat'), $ast[0][1], quasiquote(MalList([$ast[1..*]]))]); - } - else { - return MalList([MalSymbol('cons'), quasiquote($ast[0]), quasiquote(MalList([$ast[1..*]]))]); - } -} - -sub is_macro_call ($ast, $env) { - return so $ast ~~ MalList && $ast[0] ~~ MalSymbol - && $env.find($ast[0].val).?get($ast[0].val).?is_macro; -} - -sub macroexpand ($ast is copy, $env is copy) { - while is_macro_call($ast, $env) { - my $func = $env.get($ast[0].val); - $ast = $func.apply($ast[1..*]); - } - return $ast; -} - -sub eval ($ast is copy, $env is copy) { - loop { - return eval_ast($ast, $env) if $ast !~~ MalList; - $ast = macroexpand($ast, $env); - return eval_ast($ast, $env) if $ast !~~ MalList; - 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' { - eval_ast(MalList([$ast[1..*-2]]), $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.is_macro = True; - return $env.set($a1.val, $func); - } - when 'macroexpand' { return macroexpand($a1, $env) } - when 'try*' { - return eval($a1, $env); - CATCH { - 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, @args) = eval_ast($ast, $env).val; - 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) ")")))))}); - 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)))))))}); - rep(q{(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 ($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/perl6/stepA_mal.pl b/perl6/stepA_mal.pl deleted file mode 100644 index 76c843ad2a..0000000000 --- a/perl6/stepA_mal.pl +++ /dev/null @@ -1,156 +0,0 @@ -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 ($ast, $env) { - given $ast { - when MalSymbol { $env.get($ast.val) || die X::MalNotFound.new(name => $ast.val) } - when MalList { MalList([$ast.map({ eval($_, $env) })]) } - when MalVector { MalVector([$ast.map({ eval($_, $env) })]) } - when MalHashMap { MalHashMap($ast.kv.map({ $^a => eval($^b, $env) }).Hash) } - default { $ast // $NIL } - } -} - -sub is_pair ($ast) { - return so $ast ~~ MalList|MalVector && $ast.elems; -} - -sub quasiquote ($ast) { - if !is_pair($ast) { - return MalList([MalSymbol('quote'), $ast]); - } - elsif $ast[0] ~~ MalSymbol && $ast[0].val eq 'unquote' { - return $ast[1]; - } - elsif is_pair($ast[0]) && $ast[0][0] ~~ MalSymbol && $ast[0][0].val eq 'splice-unquote' { - return MalList([MalSymbol('concat'), $ast[0][1], quasiquote(MalList([$ast[1..*]]))]); - } - else { - return MalList([MalSymbol('cons'), quasiquote($ast[0]), quasiquote(MalList([$ast[1..*]]))]); - } -} - -sub is_macro_call ($ast, $env) { - return so $ast ~~ MalList && $ast[0] ~~ MalSymbol - && $env.find($ast[0].val).?get($ast[0].val).?is_macro; -} - -sub macroexpand ($ast is copy, $env is copy) { - while is_macro_call($ast, $env) { - my $func = $env.get($ast[0].val); - $ast = $func.apply($ast[1..*]); - } - return $ast; -} - -sub eval ($ast is copy, $env is copy) { - loop { - return eval_ast($ast, $env) if $ast !~~ MalList; - $ast = macroexpand($ast, $env); - return eval_ast($ast, $env) if $ast !~~ MalList; - 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' { - eval_ast(MalList([$ast[1..*-2]]), $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.is_macro = True; - return $env.set($a1.val, $func); - } - when 'macroexpand' { return macroexpand($a1, $env) } - when 'try*' { - return eval($a1, $env); - CATCH { - 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, @args) = eval_ast($ast, $env).val; - 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) ")")))))}); - 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)))))))}); - rep(q{(def! *gensym-counter* (atom 0))}); - rep(q{(def! gensym (fn* [] (symbol (str "G__" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))}); - rep(q{(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 ($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::MalException { .Str.say } - } - } -} diff --git a/perl6/tests/stepA_mal.mal b/perl6/tests/stepA_mal.mal deleted file mode 100644 index a1b4a38a72..0000000000 --- a/perl6/tests/stepA_mal.mal +++ /dev/null @@ -1,48 +0,0 @@ -;; 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/php/Dockerfile b/php/Dockerfile deleted file mode 100644 index 87709d4d9a..0000000000 --- a/php/Dockerfile +++ /dev/null @@ -1,24 +0,0 @@ -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 -########################################################## - -RUN apt-get -y install php5-cli diff --git a/php/Makefile b/php/Makefile deleted file mode 100644 index 35f585458e..0000000000 --- a/php/Makefile +++ /dev/null @@ -1,36 +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) - -all: - -dist: mal.php mal - -mal.php: $(SOURCES) - cat $+ | grep -v "^require_once" > $@ - -mal: mal.php - echo "#!/usr/bin/env php" > $@ - cat $< >> $@ - chmod +x $@ - -clean: - rm -f mal.php mal - -.PHONY: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*#|^[[:space:]]*//|^[[:space:]]/\*|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*#|^[[:space:]]*//|^[[:space:]]/\*|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" - -tests: $(TESTS) - -$(TESTS): - @echo "Running $@"; \ - php $@ || exit 1; \ diff --git a/php/readline.php b/php/readline.php deleted file mode 100644 index a31210993a..0000000000 --- a/php/readline.php +++ /dev/null @@ -1,38 +0,0 @@ - diff --git a/php/run b/php/run deleted file mode 100755 index 1b090b61ba..0000000000 --- a/php/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec php $(dirname $0)/${STEP:-stepA_mal}.php "${@}" diff --git a/php/step7_quote.php b/php/step7_quote.php deleted file mode 100644 index 8bcc71077e..0000000000 --- a/php/step7_quote.php +++ /dev/null @@ -1,171 +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); - } - 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": - 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); -} - -// 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) . "\n"); - } - } 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 0537d61b26..0000000000 --- a/php/step8_macros.php +++ /dev/null @@ -1,200 +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 eval_ast($ast, $env); - } - 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->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); -} - -// 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) . "\n"); - } - } 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 1f6e8b0612..0000000000 --- a/php/step9_try.php +++ /dev/null @@ -1,218 +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 eval_ast($ast, $env); - } - 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->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); -} - -// 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) . "\n"); - } - } 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 3292645b97..0000000000 --- a/php/stepA_mal.php +++ /dev/null @@ -1,236 +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 eval_ast($ast, $env); - } - 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->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); -} - -// 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("(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)))))))))"); - -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 (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/plpgsql/Dockerfile b/plpgsql/Dockerfile deleted file mode 100644 index bde9fcdd23..0000000000 --- a/plpgsql/Dockerfile +++ /dev/null @@ -1,35 +0,0 @@ -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 user ID 1001 so add that user -RUN useradd -ou 1001 -m -s /bin/bash -G sudo,postgres travis - -# 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 - -# Add entrypoint.sh which starts postgres then run bash/command -ADD entrypoint.sh /entrypoint.sh -ENTRYPOINT ["/entrypoint.sh"] diff --git a/plpgsql/Makefile b/plpgsql/Makefile deleted file mode 100644 index c7eb4a47ae..0000000000 --- a/plpgsql/Makefile +++ /dev/null @@ -1,14 +0,0 @@ -SOURCES_LISP = envs.sql core.sql stepA_mal.sql -SOURCES = wrap.sh io.sql init.sql types.sql reader.sql printer.sql $(SOURCES_LISP) - -all: - -.PHONY: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*--|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*--|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" - diff --git a/plpgsql/core.sql b/plpgsql/core.sql deleted file mode 100644 index 25614e7524..0000000000 --- a/plpgsql/core.sql +++ /dev/null @@ -1,556 +0,0 @@ -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.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; - - --- 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.vget(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.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'), - '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'), - - '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'), - '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/plpgsql/entrypoint.sh b/plpgsql/entrypoint.sh deleted file mode 100755 index 76b614af31..0000000000 --- a/plpgsql/entrypoint.sh +++ /dev/null @@ -1,25 +0,0 @@ -#!/bin/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} \ - /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/plpgsql/reader.sql b/plpgsql/reader.sql deleted file mode 100644 index f0b96bb2a1..0000000000 --- a/plpgsql/reader.sql +++ /dev/null @@ -1,185 +0,0 @@ --- --------------------------------------------------------- --- 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, '\"', '"'); - str := replace(str, '\n', E'\n'); - str := replace(str, '\\', E'\\'); - result := types._stringv(str); - 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 ''%''', first; - END IF; - items := ARRAY[]::integer[]; - LOOP - IF p > array_length(tokens, 1) THEN - RAISE EXCEPTION 'expected ''%''', 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/plpgsql/run b/plpgsql/run deleted file mode 100755 index 8613ff915a..0000000000 --- a/plpgsql/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec $(dirname $0)/wrap.sh $(dirname $0)/${STEP:-stepA_mal}.sql "${@}" diff --git a/plpgsql/step2_eval.sql b/plpgsql/step2_eval.sql deleted file mode 100644 index ba818ec27f..0000000000 --- a/plpgsql/step2_eval.sql +++ /dev/null @@ -1,162 +0,0 @@ --- --------------------------------------------------------- --- 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_ast(ast integer, env hstore) RETURNS integer AS $$ -DECLARE - type integer; - symkey varchar; - seq integer[]; - eseq integer[]; - hash hstore; - ehash hstore; - kv RECORD; - e integer; - result integer; -BEGIN - SELECT type_id INTO type FROM types.value WHERE value_id = ast; - CASE - WHEN type = 7 THEN - BEGIN - symkey := types._valueToString(ast); - IF env ? symkey THEN - result := env -> symkey; - ELSE - RAISE EXCEPTION '''%'' not found', symkey; - END IF; - END; - WHEN type IN (8, 9) THEN - BEGIN - SELECT val_seq INTO seq FROM types.value WHERE value_id = ast; - -- 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 (type, eseq) - RETURNING value_id INTO result; - END; - WHEN type = 10 THEN - 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 (type, ehash) - RETURNING value_id INTO result; - END; - ELSE - result := ast; - END CASE; - - RETURN result; -END; $$ LANGUAGE plpgsql; - -CREATE FUNCTION mal.EVAL(ast integer, env hstore) RETURNS integer AS $$ -DECLARE - type integer; - el integer; - fname varchar; - args integer[]; - result integer; -BEGIN - SELECT type_id INTO type FROM types.value WHERE value_id = ast; - IF type <> 8 THEN - RETURN mal.eval_ast(ast, env); - END IF; - IF types._count(ast) = 0 THEN - RETURN ast; - END IF; - - el := mal.eval_ast(ast, env); - SELECT val_string INTO fname FROM types.value - WHERE value_id = types._first(el); - args := types._restArray(el); - 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/plpgsql/step3_env.sql b/plpgsql/step3_env.sql deleted file mode 100644 index 085c41b598..0000000000 --- a/plpgsql/step3_env.sql +++ /dev/null @@ -1,196 +0,0 @@ --- --------------------------------------------------------- --- 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_ast(ast integer, env integer) RETURNS integer AS $$ -DECLARE - type integer; - seq integer[]; - eseq integer[]; - hash hstore; - ehash hstore; - kv RECORD; - e integer; - result integer; -BEGIN - SELECT type_id INTO type FROM types.value WHERE value_id = ast; - CASE - WHEN type = 7 THEN - BEGIN - result := envs.get(env, ast); - END; - WHEN type IN (8, 9) THEN - BEGIN - SELECT val_seq INTO seq FROM types.value WHERE value_id = ast; - -- 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 (type, eseq) - RETURNING value_id INTO result; - END; - WHEN type = 10 THEN - 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 (type, ehash) - RETURNING value_id INTO result; - END; - ELSE - result := ast; - END CASE; - - RETURN result; -END; $$ LANGUAGE plpgsql; - -CREATE FUNCTION mal.EVAL(ast integer, env integer) RETURNS integer AS $$ -DECLARE - type integer; - a0 integer; - a0sym varchar; - a1 integer; - let_env integer; - idx integer; - binds integer[]; - el integer; - fname varchar; - args integer[]; - result integer; -BEGIN - -- PERFORM writeline(format('EVAL: %s [%s]', pr_str(ast), ast)); - SELECT type_id INTO type FROM types.value WHERE value_id = ast; - IF type <> 8 THEN - RETURN mal.eval_ast(ast, env); - END IF; - IF types._count(ast) = 0 THEN - RETURN ast; - END IF; - - a0 := types._first(ast); - IF types._symbol_Q(a0) THEN - a0sym := (SELECT val_string FROM types.value WHERE value_id = a0); - ELSE - a0sym := '__<*fn*>__'; - END IF; - - CASE - WHEN a0sym = 'def!' THEN - BEGIN - RETURN envs.set(env, types._nth(ast, 1), - mal.EVAL(types._nth(ast, 2), env)); - END; - WHEN a0sym = 'let*' THEN - BEGIN - let_env := envs.new(env); - a1 := types._nth(ast, 1); - binds := (SELECT val_seq FROM types.value WHERE value_id = a1); - idx := 1; - WHILE idx < array_length(binds, 1) LOOP - PERFORM envs.set(let_env, binds[idx], - mal.EVAL(binds[idx+1], let_env)); - idx := idx + 2; - END LOOP; - RETURN mal.EVAL(types._nth(ast, 2), let_env); - END; - ELSE - BEGIN - el := mal.eval_ast(ast, env); - SELECT val_string INTO fname FROM types.value - WHERE value_id = types._first(el); - args := types._restArray(el); - EXECUTE format('SELECT %s($1);', fname) - INTO result USING args; - RETURN result; - END; - END CASE; -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/plpgsql/step4_if_fn_do.sql b/plpgsql/step4_if_fn_do.sql deleted file mode 100644 index 904e44126e..0000000000 --- a/plpgsql/step4_if_fn_do.sql +++ /dev/null @@ -1,213 +0,0 @@ --- --------------------------------------------------------- --- 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_ast(ast integer, env integer) RETURNS integer AS $$ -DECLARE - type integer; - seq integer[]; - eseq integer[]; - hash hstore; - ehash hstore; - kv RECORD; - e integer; - result integer; -BEGIN - SELECT type_id INTO type FROM types.value WHERE value_id = ast; - CASE - WHEN type = 7 THEN - BEGIN - result := envs.get(env, ast); - END; - WHEN type IN (8, 9) THEN - BEGIN - SELECT val_seq INTO seq FROM types.value WHERE value_id = ast; - -- 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 (type, eseq) - RETURNING value_id INTO result; - END; - WHEN type = 10 THEN - 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 (type, ehash) - RETURNING value_id INTO result; - END; - ELSE - result := ast; - END CASE; - - RETURN result; -END; $$ LANGUAGE plpgsql; - -CREATE FUNCTION mal.EVAL(ast integer, env integer) RETURNS integer AS $$ -DECLARE - type integer; - a0 integer; - a0sym varchar; - a1 integer; - let_env integer; - idx integer; - binds integer[]; - el integer; - fn integer; - fname varchar; - args integer[]; - cond integer; - fast integer; - fparams integer; - fenv integer; - result integer; -BEGIN - -- PERFORM writeline(format('EVAL: %s [%s]', pr_str(ast), ast)); - SELECT type_id INTO type FROM types.value WHERE value_id = ast; - IF type <> 8 THEN - RETURN mal.eval_ast(ast, env); - END IF; - IF types._count(ast) = 0 THEN - RETURN ast; - END IF; - - a0 := types._first(ast); - IF types._symbol_Q(a0) THEN - a0sym := (SELECT val_string FROM types.value WHERE value_id = a0); - ELSE - a0sym := '__<*fn*>__'; - END IF; - - CASE - WHEN a0sym = 'def!' THEN - BEGIN - RETURN envs.set(env, types._nth(ast, 1), - mal.EVAL(types._nth(ast, 2), env)); - END; - WHEN a0sym = 'let*' THEN - BEGIN - let_env := envs.new(env); - a1 := types._nth(ast, 1); - binds := (SELECT val_seq FROM types.value WHERE value_id = a1); - idx := 1; - WHILE idx < array_length(binds, 1) LOOP - PERFORM envs.set(let_env, binds[idx], - mal.EVAL(binds[idx+1], let_env)); - idx := idx + 2; - END LOOP; - RETURN mal.EVAL(types._nth(ast, 2), let_env); - END; - WHEN a0sym = 'do' THEN - BEGIN - el := mal.eval_ast(types._rest(ast), env); - RETURN types._nth(el, types._count(el)-1); - END; - WHEN a0sym = 'if' THEN - BEGIN - cond := mal.EVAL(types._nth(ast, 1), env); - SELECT type_id INTO type FROM types.value WHERE value_id = cond; - IF type = 0 OR type = 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; - END; - WHEN a0sym = 'fn*' THEN - BEGIN - RETURN types._malfunc(types._nth(ast, 2), types._nth(ast, 1), env); - END; - ELSE - BEGIN - el := mal.eval_ast(ast, env); - SELECT type_id, val_string, ast_id, params_id, env_id - INTO type, fname, fast, fparams, fenv - FROM types.value WHERE value_id = types._first(el); - args := types._restArray(el); - 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 CASE; -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/plpgsql/step5_tco.sql b/plpgsql/step5_tco.sql deleted file mode 100644 index 20737be2c2..0000000000 --- a/plpgsql/step5_tco.sql +++ /dev/null @@ -1,222 +0,0 @@ --- --------------------------------------------------------- --- 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_ast(ast integer, env integer) RETURNS integer AS $$ -DECLARE - type integer; - seq integer[]; - eseq integer[]; - hash hstore; - ehash hstore; - kv RECORD; - e integer; - result integer; -BEGIN - SELECT type_id INTO type FROM types.value WHERE value_id = ast; - CASE - WHEN type = 7 THEN - BEGIN - result := envs.get(env, ast); - END; - WHEN type IN (8, 9) THEN - BEGIN - SELECT val_seq INTO seq FROM types.value WHERE value_id = ast; - -- 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 (type, eseq) - RETURNING value_id INTO result; - END; - WHEN type = 10 THEN - 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 (type, ehash) - RETURNING value_id INTO result; - END; - ELSE - result := ast; - END CASE; - - RETURN result; -END; $$ LANGUAGE plpgsql; - -CREATE FUNCTION mal.EVAL(ast integer, env integer) RETURNS integer AS $$ -DECLARE - type integer; - a0 integer; - a0sym varchar; - a1 integer; - let_env integer; - idx integer; - binds integer[]; - el integer; - fn integer; - fname varchar; - args integer[]; - cond integer; - fast integer; - fparams integer; - fenv integer; - result integer; -BEGIN - LOOP - -- PERFORM writeline(format('EVAL: %s [%s]', pr_str(ast), ast)); - SELECT type_id INTO type FROM types.value WHERE value_id = ast; - IF type <> 8 THEN - RETURN mal.eval_ast(ast, env); - END IF; - IF types._count(ast) = 0 THEN - RETURN ast; - END IF; - - a0 := types._first(ast); - IF types._symbol_Q(a0) THEN - a0sym := (SELECT val_string FROM types.value WHERE value_id = a0); - ELSE - a0sym := '__<*fn*>__'; - END IF; - - CASE - WHEN a0sym = 'def!' THEN - BEGIN - RETURN envs.set(env, types._nth(ast, 1), - mal.EVAL(types._nth(ast, 2), env)); - END; - WHEN a0sym = 'let*' THEN - BEGIN - let_env := envs.new(env); - a1 := types._nth(ast, 1); - binds := (SELECT val_seq FROM types.value WHERE value_id = a1); - idx := 1; - WHILE idx < array_length(binds, 1) LOOP - PERFORM envs.set(let_env, binds[idx], - mal.EVAL(binds[idx+1], let_env)); - idx := idx + 2; - END LOOP; - env := let_env; - ast := types._nth(ast, 2); - CONTINUE; -- TCO - END; - WHEN a0sym = 'do' THEN - BEGIN - PERFORM mal.eval_ast(types._slice(ast, 1, types._count(ast)-1), env); - ast := types._nth(ast, types._count(ast)-1); - CONTINUE; -- TCO - END; - WHEN a0sym = 'if' THEN - BEGIN - cond := mal.EVAL(types._nth(ast, 1), env); - SELECT type_id INTO type FROM types.value WHERE value_id = cond; - IF type = 0 OR type = 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; - END; - WHEN a0sym = 'fn*' THEN - BEGIN - RETURN types._malfunc(types._nth(ast, 2), types._nth(ast, 1), env); - END; - ELSE - BEGIN - el := mal.eval_ast(ast, env); - SELECT type_id, val_string, ast_id, params_id, env_id - INTO type, fname, fast, fparams, fenv - FROM types.value WHERE value_id = types._first(el); - args := types._restArray(el); - 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 CASE; - 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/plpgsql/step6_file.sql b/plpgsql/step6_file.sql deleted file mode 100644 index 61c8732783..0000000000 --- a/plpgsql/step6_file.sql +++ /dev/null @@ -1,249 +0,0 @@ --- --------------------------------------------------------- --- 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_ast(ast integer, env integer) RETURNS integer AS $$ -DECLARE - type integer; - seq integer[]; - eseq integer[]; - hash hstore; - ehash hstore; - kv RECORD; - e integer; - result integer; -BEGIN - SELECT type_id INTO type FROM types.value WHERE value_id = ast; - CASE - WHEN type = 7 THEN - BEGIN - result := envs.get(env, ast); - END; - WHEN type IN (8, 9) THEN - BEGIN - SELECT val_seq INTO seq FROM types.value WHERE value_id = ast; - -- 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 (type, eseq) - RETURNING value_id INTO result; - END; - WHEN type = 10 THEN - 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 (type, ehash) - RETURNING value_id INTO result; - END; - ELSE - result := ast; - END CASE; - - RETURN result; -END; $$ LANGUAGE plpgsql; - -CREATE FUNCTION mal.EVAL(ast integer, env integer) RETURNS integer AS $$ -DECLARE - type integer; - a0 integer; - a0sym varchar; - a1 integer; - let_env integer; - idx integer; - binds integer[]; - el integer; - fn integer; - fname varchar; - args integer[]; - cond integer; - fast integer; - fparams integer; - fenv integer; - result integer; -BEGIN - LOOP - -- PERFORM writeline(format('EVAL: %s [%s]', pr_str(ast), ast)); - SELECT type_id INTO type FROM types.value WHERE value_id = ast; - IF type <> 8 THEN - RETURN mal.eval_ast(ast, env); - END IF; - IF types._count(ast) = 0 THEN - RETURN ast; - END IF; - - a0 := types._first(ast); - IF types._symbol_Q(a0) THEN - a0sym := (SELECT val_string FROM types.value WHERE value_id = a0); - ELSE - a0sym := '__<*fn*>__'; - END IF; - - CASE - WHEN a0sym = 'def!' THEN - BEGIN - RETURN envs.set(env, types._nth(ast, 1), - mal.EVAL(types._nth(ast, 2), env)); - END; - WHEN a0sym = 'let*' THEN - BEGIN - let_env := envs.new(env); - a1 := types._nth(ast, 1); - binds := (SELECT val_seq FROM types.value WHERE value_id = a1); - idx := 1; - WHILE idx < array_length(binds, 1) LOOP - PERFORM envs.set(let_env, binds[idx], - mal.EVAL(binds[idx+1], let_env)); - idx := idx + 2; - END LOOP; - env := let_env; - ast := types._nth(ast, 2); - CONTINUE; -- TCO - END; - WHEN a0sym = 'do' THEN - BEGIN - PERFORM mal.eval_ast(types._slice(ast, 1, types._count(ast)-1), env); - ast := types._nth(ast, types._count(ast)-1); - CONTINUE; -- TCO - END; - WHEN a0sym = 'if' THEN - BEGIN - cond := mal.EVAL(types._nth(ast, 1), env); - SELECT type_id INTO type FROM types.value WHERE value_id = cond; - IF type = 0 OR type = 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; - END; - WHEN a0sym = 'fn*' THEN - BEGIN - RETURN types._malfunc(types._nth(ast, 2), types._nth(ast, 1), env); - END; - ELSE - BEGIN - el := mal.eval_ast(ast, env); - SELECT type_id, val_string, ast_id, params_id, env_id - INTO type, fname, fast, fparams, fenv - FROM types.value WHERE value_id = types._first(el); - args := types._restArray(el); - 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 CASE; - 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) ")")))))') \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/plpgsql/step7_quote.sql b/plpgsql/step7_quote.sql deleted file mode 100644 index 5602aef723..0000000000 --- a/plpgsql/step7_quote.sql +++ /dev/null @@ -1,289 +0,0 @@ --- --------------------------------------------------------- --- 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.is_pair(ast integer) RETURNS boolean AS $$ -BEGIN - RETURN types._sequential_Q(ast) AND types._count(ast) > 0; -END; $$ LANGUAGE plpgsql; - -CREATE FUNCTION mal.quasiquote(ast integer) RETURNS integer AS $$ -DECLARE - a0 integer; - a00 integer; -BEGIN - IF NOT mal.is_pair(ast) THEN - RETURN types._list(ARRAY[types._symbolv('quote'), ast]); - ELSE - a0 := types._nth(ast, 0); - IF types._symbol_Q(a0) AND a0 = types._symbolv('unquote') THEN - RETURN types._nth(ast, 1); - ELSE - a00 := types._nth(a0, 0); - IF types._symbol_Q(a00) AND - a00 = types._symbolv('splice-unquote') THEN - RETURN types._list(ARRAY[types._symbolv('concat'), - types._nth(a0, 1), - mal.quasiquote(types._rest(ast))]); - END IF; - END IF; - RETURN types._list(ARRAY[types._symbolv('cons'), - mal.quasiquote(types._first(ast)), - mal.quasiquote(types._rest(ast))]); - END IF; -END; $$ LANGUAGE plpgsql; - -CREATE FUNCTION mal.eval_ast(ast integer, env integer) RETURNS integer AS $$ -DECLARE - type integer; - seq integer[]; - eseq integer[]; - hash hstore; - ehash hstore; - kv RECORD; - e integer; - result integer; -BEGIN - SELECT type_id INTO type FROM types.value WHERE value_id = ast; - CASE - WHEN type = 7 THEN - BEGIN - result := envs.get(env, ast); - END; - WHEN type IN (8, 9) THEN - BEGIN - SELECT val_seq INTO seq FROM types.value WHERE value_id = ast; - -- 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 (type, eseq) - RETURNING value_id INTO result; - END; - WHEN type = 10 THEN - 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 (type, ehash) - RETURNING value_id INTO result; - END; - ELSE - result := ast; - END CASE; - - RETURN result; -END; $$ LANGUAGE plpgsql; - -CREATE FUNCTION mal.EVAL(ast integer, env integer) RETURNS integer AS $$ -DECLARE - type integer; - a0 integer; - a0sym varchar; - a1 integer; - let_env integer; - idx integer; - binds integer[]; - el integer; - fn integer; - fname varchar; - args integer[]; - cond integer; - fast integer; - fparams integer; - fenv integer; - result integer; -BEGIN - LOOP - -- PERFORM writeline(format('EVAL: %s [%s]', pr_str(ast), ast)); - SELECT type_id INTO type FROM types.value WHERE value_id = ast; - IF type <> 8 THEN - RETURN mal.eval_ast(ast, env); - END IF; - IF types._count(ast) = 0 THEN - RETURN ast; - END IF; - - a0 := types._first(ast); - IF types._symbol_Q(a0) THEN - a0sym := (SELECT val_string FROM types.value WHERE value_id = a0); - ELSE - a0sym := '__<*fn*>__'; - END IF; - - CASE - WHEN a0sym = 'def!' THEN - BEGIN - RETURN envs.set(env, types._nth(ast, 1), - mal.EVAL(types._nth(ast, 2), env)); - END; - WHEN a0sym = 'let*' THEN - BEGIN - let_env := envs.new(env); - a1 := types._nth(ast, 1); - binds := (SELECT val_seq FROM types.value WHERE value_id = a1); - idx := 1; - WHILE idx < array_length(binds, 1) LOOP - PERFORM envs.set(let_env, binds[idx], - mal.EVAL(binds[idx+1], let_env)); - idx := idx + 2; - END LOOP; - env := let_env; - ast := types._nth(ast, 2); - CONTINUE; -- TCO - END; - WHEN a0sym = 'quote' THEN - BEGIN - RETURN types._nth(ast, 1); - END; - WHEN a0sym = 'quasiquote' THEN - BEGIN - ast := mal.quasiquote(types._nth(ast, 1)); - CONTINUE; -- TCO - END; - WHEN a0sym = 'do' THEN - BEGIN - PERFORM mal.eval_ast(types._slice(ast, 1, types._count(ast)-1), env); - ast := types._nth(ast, types._count(ast)-1); - CONTINUE; -- TCO - END; - WHEN a0sym = 'if' THEN - BEGIN - cond := mal.EVAL(types._nth(ast, 1), env); - SELECT type_id INTO type FROM types.value WHERE value_id = cond; - IF type = 0 OR type = 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; - END; - WHEN a0sym = 'fn*' THEN - BEGIN - RETURN types._malfunc(types._nth(ast, 2), types._nth(ast, 1), env); - END; - ELSE - BEGIN - el := mal.eval_ast(ast, env); - SELECT type_id, val_string, ast_id, params_id, env_id - INTO type, fname, fast, fparams, fenv - FROM types.value WHERE value_id = types._first(el); - args := types._restArray(el); - 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 CASE; - 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) ")")))))') \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/plpgsql/step8_macros.sql b/plpgsql/step8_macros.sql deleted file mode 100644 index c89acfdf5d..0000000000 --- a/plpgsql/step8_macros.sql +++ /dev/null @@ -1,336 +0,0 @@ --- --------------------------------------------------------- --- 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.is_pair(ast integer) RETURNS boolean AS $$ -BEGIN - RETURN types._sequential_Q(ast) AND types._count(ast) > 0; -END; $$ LANGUAGE plpgsql; - -CREATE FUNCTION mal.quasiquote(ast integer) RETURNS integer AS $$ -DECLARE - a0 integer; - a00 integer; -BEGIN - IF NOT mal.is_pair(ast) THEN - RETURN types._list(ARRAY[types._symbolv('quote'), ast]); - ELSE - a0 := types._nth(ast, 0); - IF types._symbol_Q(a0) AND a0 = types._symbolv('unquote') THEN - RETURN types._nth(ast, 1); - ELSE - a00 := types._nth(a0, 0); - IF types._symbol_Q(a00) AND - a00 = types._symbolv('splice-unquote') THEN - RETURN types._list(ARRAY[types._symbolv('concat'), - types._nth(a0, 1), - mal.quasiquote(types._rest(ast))]); - END IF; - END IF; - RETURN types._list(ARRAY[types._symbolv('cons'), - mal.quasiquote(types._first(ast)), - mal.quasiquote(types._rest(ast))]); - END IF; -END; $$ LANGUAGE plpgsql; - -CREATE FUNCTION mal.is_macro_call(ast integer, env integer) RETURNS boolean AS $$ -DECLARE - a0 integer; - f integer; - result boolean = false; -BEGIN - IF types._list_Q(ast) THEN - a0 = types._first(ast); - IF types._symbol_Q(a0) AND - envs.find(env, types._valueToString(a0)) IS NOT NULL THEN - f := envs.get(env, a0); - SELECT macro INTO result FROM types.value WHERE value_id = f; - END IF; - END IF; - RETURN result; -END; $$ LANGUAGE plpgsql; - -CREATE FUNCTION mal.macroexpand(ast integer, env integer) RETURNS integer AS $$ -DECLARE - mac integer; -BEGIN - WHILE mal.is_macro_call(ast, env) - LOOP - mac := envs.get(env, types._first(ast)); - ast := types._apply(mac, types._valueToArray(types._rest(ast))); - END LOOP; - RETURN ast; -END; $$ LANGUAGE plpgsql; - -CREATE FUNCTION mal.eval_ast(ast integer, env integer) RETURNS integer AS $$ -DECLARE - type integer; - seq integer[]; - eseq integer[]; - hash hstore; - ehash hstore; - kv RECORD; - e integer; - result integer; -BEGIN - SELECT type_id INTO type FROM types.value WHERE value_id = ast; - CASE - WHEN type = 7 THEN - BEGIN - result := envs.get(env, ast); - END; - WHEN type IN (8, 9) THEN - BEGIN - SELECT val_seq INTO seq FROM types.value WHERE value_id = ast; - -- 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 (type, eseq) - RETURNING value_id INTO result; - END; - WHEN type = 10 THEN - 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 (type, ehash) - RETURNING value_id INTO result; - END; - ELSE - result := ast; - END CASE; - - RETURN result; -END; $$ LANGUAGE plpgsql; - -CREATE FUNCTION mal.EVAL(ast integer, env integer) RETURNS integer AS $$ -DECLARE - type integer; - a0 integer; - a0sym varchar; - a1 integer; - let_env integer; - idx integer; - binds integer[]; - el integer; - fn integer; - fname varchar; - args integer[]; - cond integer; - fast integer; - fparams integer; - fenv integer; - result integer; -BEGIN - LOOP - -- PERFORM writeline(format('EVAL: %s [%s]', pr_str(ast), ast)); - SELECT type_id INTO type FROM types.value WHERE value_id = ast; - IF type <> 8 THEN - RETURN mal.eval_ast(ast, env); - END IF; - - ast := mal.macroexpand(ast, env); - SELECT type_id INTO type FROM types.value WHERE value_id = ast; - IF type <> 8 THEN - RETURN mal.eval_ast(ast, env); - END IF; - IF types._count(ast) = 0 THEN - RETURN ast; - END IF; - - a0 := types._first(ast); - IF types._symbol_Q(a0) THEN - a0sym := (SELECT val_string FROM types.value WHERE value_id = a0); - ELSE - a0sym := '__<*fn*>__'; - END IF; - - CASE - WHEN a0sym = 'def!' THEN - BEGIN - RETURN envs.set(env, types._nth(ast, 1), - mal.EVAL(types._nth(ast, 2), env)); - END; - WHEN a0sym = 'let*' THEN - BEGIN - let_env := envs.new(env); - a1 := types._nth(ast, 1); - binds := (SELECT val_seq FROM types.value WHERE value_id = a1); - idx := 1; - WHILE idx < array_length(binds, 1) LOOP - PERFORM envs.set(let_env, binds[idx], - mal.EVAL(binds[idx+1], let_env)); - idx := idx + 2; - END LOOP; - env := let_env; - ast := types._nth(ast, 2); - CONTINUE; -- TCO - END; - WHEN a0sym = 'quote' THEN - BEGIN - RETURN types._nth(ast, 1); - END; - WHEN a0sym = 'quasiquote' THEN - BEGIN - ast := mal.quasiquote(types._nth(ast, 1)); - CONTINUE; -- TCO - END; - WHEN a0sym = 'defmacro!' THEN - BEGIN - fn := mal.EVAL(types._nth(ast, 2), env); - fn := types._macro(fn); - RETURN envs.set(env, types._nth(ast, 1), fn); - END; - WHEN a0sym = 'macroexpand' THEN - BEGIN - RETURN mal.macroexpand(types._nth(ast, 1), env); - END; - WHEN a0sym = 'do' THEN - BEGIN - PERFORM mal.eval_ast(types._slice(ast, 1, types._count(ast)-1), env); - ast := types._nth(ast, types._count(ast)-1); - CONTINUE; -- TCO - END; - WHEN a0sym = 'if' THEN - BEGIN - cond := mal.EVAL(types._nth(ast, 1), env); - SELECT type_id INTO type FROM types.value WHERE value_id = cond; - IF type = 0 OR type = 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; - END; - WHEN a0sym = 'fn*' THEN - BEGIN - RETURN types._malfunc(types._nth(ast, 2), types._nth(ast, 1), env); - END; - ELSE - BEGIN - el := mal.eval_ast(ast, env); - SELECT type_id, val_string, ast_id, params_id, env_id - INTO type, fname, fast, fparams, fenv - FROM types.value WHERE value_id = types._first(el); - args := types._restArray(el); - 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 CASE; - 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) ")")))))') \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' -SELECT mal.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))))))))') \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/plpgsql/step9_try.sql b/plpgsql/step9_try.sql deleted file mode 100644 index 291cdaac1e..0000000000 --- a/plpgsql/step9_try.sql +++ /dev/null @@ -1,355 +0,0 @@ --- --------------------------------------------------------- --- 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.is_pair(ast integer) RETURNS boolean AS $$ -BEGIN - RETURN types._sequential_Q(ast) AND types._count(ast) > 0; -END; $$ LANGUAGE plpgsql; - -CREATE FUNCTION mal.quasiquote(ast integer) RETURNS integer AS $$ -DECLARE - a0 integer; - a00 integer; -BEGIN - IF NOT mal.is_pair(ast) THEN - RETURN types._list(ARRAY[types._symbolv('quote'), ast]); - ELSE - a0 := types._nth(ast, 0); - IF types._symbol_Q(a0) AND a0 = types._symbolv('unquote') THEN - RETURN types._nth(ast, 1); - ELSE - a00 := types._nth(a0, 0); - IF types._symbol_Q(a00) AND - a00 = types._symbolv('splice-unquote') THEN - RETURN types._list(ARRAY[types._symbolv('concat'), - types._nth(a0, 1), - mal.quasiquote(types._rest(ast))]); - END IF; - END IF; - RETURN types._list(ARRAY[types._symbolv('cons'), - mal.quasiquote(types._first(ast)), - mal.quasiquote(types._rest(ast))]); - END IF; -END; $$ LANGUAGE plpgsql; - -CREATE FUNCTION mal.is_macro_call(ast integer, env integer) RETURNS boolean AS $$ -DECLARE - a0 integer; - f integer; - result boolean = false; -BEGIN - IF types._list_Q(ast) THEN - a0 = types._first(ast); - IF types._symbol_Q(a0) AND - envs.find(env, types._valueToString(a0)) IS NOT NULL THEN - f := envs.get(env, a0); - SELECT macro INTO result FROM types.value WHERE value_id = f; - END IF; - END IF; - RETURN result; -END; $$ LANGUAGE plpgsql; - -CREATE FUNCTION mal.macroexpand(ast integer, env integer) RETURNS integer AS $$ -DECLARE - mac integer; -BEGIN - WHILE mal.is_macro_call(ast, env) - LOOP - mac := envs.get(env, types._first(ast)); - ast := types._apply(mac, types._valueToArray(types._rest(ast))); - END LOOP; - RETURN ast; -END; $$ LANGUAGE plpgsql; - -CREATE FUNCTION mal.eval_ast(ast integer, env integer) RETURNS integer AS $$ -DECLARE - type integer; - seq integer[]; - eseq integer[]; - hash hstore; - ehash hstore; - kv RECORD; - e integer; - result integer; -BEGIN - SELECT type_id INTO type FROM types.value WHERE value_id = ast; - CASE - WHEN type = 7 THEN - BEGIN - result := envs.get(env, ast); - END; - WHEN type IN (8, 9) THEN - BEGIN - SELECT val_seq INTO seq FROM types.value WHERE value_id = ast; - -- 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 (type, eseq) - RETURNING value_id INTO result; - END; - WHEN type = 10 THEN - 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 (type, ehash) - RETURNING value_id INTO result; - END; - ELSE - result := ast; - END CASE; - - RETURN result; -END; $$ LANGUAGE plpgsql; - -CREATE FUNCTION mal.EVAL(ast integer, env integer) RETURNS integer AS $$ -DECLARE - type integer; - a0 integer; - a0sym varchar; - a1 integer; - a2 integer; - let_env integer; - idx integer; - binds integer[]; - exprs integer[]; - el integer; - fn integer; - fname varchar; - args integer[]; - cond integer; - fast integer; - fparams integer; - fenv integer; - result integer; -BEGIN - LOOP - -- PERFORM writeline(format('EVAL: %s [%s]', pr_str(ast), ast)); - SELECT type_id INTO type FROM types.value WHERE value_id = ast; - IF type <> 8 THEN - RETURN mal.eval_ast(ast, env); - END IF; - - ast := mal.macroexpand(ast, env); - SELECT type_id INTO type FROM types.value WHERE value_id = ast; - IF type <> 8 THEN - RETURN mal.eval_ast(ast, env); - END IF; - IF types._count(ast) = 0 THEN - RETURN ast; - END IF; - - a0 := types._first(ast); - IF types._symbol_Q(a0) THEN - a0sym := (SELECT val_string FROM types.value WHERE value_id = a0); - ELSE - a0sym := '__<*fn*>__'; - END IF; - - CASE - WHEN a0sym = 'def!' THEN - BEGIN - RETURN envs.set(env, types._nth(ast, 1), - mal.EVAL(types._nth(ast, 2), env)); - END; - WHEN a0sym = 'let*' THEN - BEGIN - let_env := envs.new(env); - a1 := types._nth(ast, 1); - binds := (SELECT val_seq FROM types.value WHERE value_id = a1); - idx := 1; - WHILE idx < array_length(binds, 1) LOOP - PERFORM envs.set(let_env, binds[idx], - mal.EVAL(binds[idx+1], let_env)); - idx := idx + 2; - END LOOP; - env := let_env; - ast := types._nth(ast, 2); - CONTINUE; -- TCO - END; - WHEN a0sym = 'quote' THEN - BEGIN - RETURN types._nth(ast, 1); - END; - WHEN a0sym = 'quasiquote' THEN - BEGIN - ast := mal.quasiquote(types._nth(ast, 1)); - CONTINUE; -- TCO - END; - WHEN a0sym = 'defmacro!' THEN - BEGIN - fn := mal.EVAL(types._nth(ast, 2), env); - fn := types._macro(fn); - RETURN envs.set(env, types._nth(ast, 1), fn); - END; - WHEN a0sym = 'macroexpand' THEN - BEGIN - RETURN mal.macroexpand(types._nth(ast, 1), env); - END; - WHEN a0sym = 'try*' THEN - BEGIN - BEGIN - RETURN mal.EVAL(types._nth(ast, 1), env); - EXCEPTION WHEN OTHERS THEN - IF types._count(ast) >= 3 THEN - a2 = types._nth(ast, 2); - IF types._valueToString(types._nth(a2, 0)) = 'catch*' THEN - binds := ARRAY[types._nth(a2, 1)]; - exprs := ARRAY[types._stringv(SQLERRM)]; - env := envs.new(env, types._list(binds), exprs); - RETURN mal.EVAL(types._nth(a2, 2), env); - END IF; - END IF; - RAISE; - END; - END; - WHEN a0sym = 'do' THEN - BEGIN - PERFORM mal.eval_ast(types._slice(ast, 1, types._count(ast)-1), env); - ast := types._nth(ast, types._count(ast)-1); - CONTINUE; -- TCO - END; - WHEN a0sym = 'if' THEN - BEGIN - cond := mal.EVAL(types._nth(ast, 1), env); - SELECT type_id INTO type FROM types.value WHERE value_id = cond; - IF type = 0 OR type = 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; - END; - WHEN a0sym = 'fn*' THEN - BEGIN - RETURN types._malfunc(types._nth(ast, 2), types._nth(ast, 1), env); - END; - ELSE - BEGIN - el := mal.eval_ast(ast, env); - SELECT type_id, val_string, ast_id, params_id, env_id - INTO type, fname, fast, fparams, fenv - FROM types.value WHERE value_id = types._first(el); - args := types._restArray(el); - 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 CASE; - 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) ")")))))') \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' -SELECT mal.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))))))))') \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/plpgsql/stepA_mal.sql b/plpgsql/stepA_mal.sql deleted file mode 100644 index 494e7225d7..0000000000 --- a/plpgsql/stepA_mal.sql +++ /dev/null @@ -1,359 +0,0 @@ --- --------------------------------------------------------- --- 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.is_pair(ast integer) RETURNS boolean AS $$ -BEGIN - RETURN types._sequential_Q(ast) AND types._count(ast) > 0; -END; $$ LANGUAGE plpgsql; - -CREATE FUNCTION mal.quasiquote(ast integer) RETURNS integer AS $$ -DECLARE - a0 integer; - a00 integer; -BEGIN - IF NOT mal.is_pair(ast) THEN - RETURN types._list(ARRAY[types._symbolv('quote'), ast]); - ELSE - a0 := types._nth(ast, 0); - IF types._symbol_Q(a0) AND a0 = types._symbolv('unquote') THEN - RETURN types._nth(ast, 1); - ELSE - a00 := types._nth(a0, 0); - IF types._symbol_Q(a00) AND - a00 = types._symbolv('splice-unquote') THEN - RETURN types._list(ARRAY[types._symbolv('concat'), - types._nth(a0, 1), - mal.quasiquote(types._rest(ast))]); - END IF; - END IF; - RETURN types._list(ARRAY[types._symbolv('cons'), - mal.quasiquote(types._first(ast)), - mal.quasiquote(types._rest(ast))]); - END IF; -END; $$ LANGUAGE plpgsql; - -CREATE FUNCTION mal.is_macro_call(ast integer, env integer) RETURNS boolean AS $$ -DECLARE - a0 integer; - f integer; - result boolean = false; -BEGIN - IF types._list_Q(ast) THEN - a0 = types._first(ast); - IF types._symbol_Q(a0) AND - envs.find(env, types._valueToString(a0)) IS NOT NULL THEN - f := envs.get(env, a0); - SELECT macro INTO result FROM types.value WHERE value_id = f; - END IF; - END IF; - RETURN result; -END; $$ LANGUAGE plpgsql; - -CREATE FUNCTION mal.macroexpand(ast integer, env integer) RETURNS integer AS $$ -DECLARE - mac integer; -BEGIN - WHILE mal.is_macro_call(ast, env) - LOOP - mac := envs.get(env, types._first(ast)); - ast := types._apply(mac, types._valueToArray(types._rest(ast))); - END LOOP; - RETURN ast; -END; $$ LANGUAGE plpgsql; - -CREATE FUNCTION mal.eval_ast(ast integer, env integer) RETURNS integer AS $$ -DECLARE - type integer; - seq integer[]; - eseq integer[]; - hash hstore; - ehash hstore; - kv RECORD; - e integer; - result integer; -BEGIN - SELECT type_id INTO type FROM types.value WHERE value_id = ast; - CASE - WHEN type = 7 THEN - BEGIN - result := envs.get(env, ast); - END; - WHEN type IN (8, 9) THEN - BEGIN - SELECT val_seq INTO seq FROM types.value WHERE value_id = ast; - -- 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 (type, eseq) - RETURNING value_id INTO result; - END; - WHEN type = 10 THEN - 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 (type, ehash) - RETURNING value_id INTO result; - END; - ELSE - result := ast; - END CASE; - - RETURN result; -END; $$ LANGUAGE plpgsql; - -CREATE FUNCTION mal.EVAL(ast integer, env integer) RETURNS integer AS $$ -DECLARE - type integer; - a0 integer; - a0sym varchar; - a1 integer; - a2 integer; - let_env integer; - idx integer; - binds integer[]; - exprs integer[]; - el integer; - fn integer; - fname varchar; - args integer[]; - cond integer; - fast integer; - fparams integer; - fenv integer; - result integer; -BEGIN - LOOP - -- PERFORM writeline(format('EVAL: %s [%s]', pr_str(ast), ast)); - SELECT type_id INTO type FROM types.value WHERE value_id = ast; - IF type <> 8 THEN - RETURN mal.eval_ast(ast, env); - END IF; - - ast := mal.macroexpand(ast, env); - SELECT type_id INTO type FROM types.value WHERE value_id = ast; - IF type <> 8 THEN - RETURN mal.eval_ast(ast, env); - END IF; - IF types._count(ast) = 0 THEN - RETURN ast; - END IF; - - a0 := types._first(ast); - IF types._symbol_Q(a0) THEN - a0sym := (SELECT val_string FROM types.value WHERE value_id = a0); - ELSE - a0sym := '__<*fn*>__'; - END IF; - - CASE - WHEN a0sym = 'def!' THEN - BEGIN - RETURN envs.set(env, types._nth(ast, 1), - mal.EVAL(types._nth(ast, 2), env)); - END; - WHEN a0sym = 'let*' THEN - BEGIN - let_env := envs.new(env); - a1 := types._nth(ast, 1); - binds := (SELECT val_seq FROM types.value WHERE value_id = a1); - idx := 1; - WHILE idx < array_length(binds, 1) LOOP - PERFORM envs.set(let_env, binds[idx], - mal.EVAL(binds[idx+1], let_env)); - idx := idx + 2; - END LOOP; - env := let_env; - ast := types._nth(ast, 2); - CONTINUE; -- TCO - END; - WHEN a0sym = 'quote' THEN - BEGIN - RETURN types._nth(ast, 1); - END; - WHEN a0sym = 'quasiquote' THEN - BEGIN - ast := mal.quasiquote(types._nth(ast, 1)); - CONTINUE; -- TCO - END; - WHEN a0sym = 'defmacro!' THEN - BEGIN - fn := mal.EVAL(types._nth(ast, 2), env); - fn := types._macro(fn); - RETURN envs.set(env, types._nth(ast, 1), fn); - END; - WHEN a0sym = 'macroexpand' THEN - BEGIN - RETURN mal.macroexpand(types._nth(ast, 1), env); - END; - WHEN a0sym = 'try*' THEN - BEGIN - BEGIN - RETURN mal.EVAL(types._nth(ast, 1), env); - EXCEPTION WHEN OTHERS THEN - IF types._count(ast) >= 3 THEN - a2 = types._nth(ast, 2); - IF types._valueToString(types._nth(a2, 0)) = 'catch*' THEN - binds := ARRAY[types._nth(a2, 1)]; - exprs := ARRAY[types._stringv(SQLERRM)]; - env := envs.new(env, types._list(binds), exprs); - RETURN mal.EVAL(types._nth(a2, 2), env); - END IF; - END IF; - RAISE; - END; - END; - WHEN a0sym = 'do' THEN - BEGIN - PERFORM mal.eval_ast(types._slice(ast, 1, types._count(ast)-1), env); - ast := types._nth(ast, types._count(ast)-1); - CONTINUE; -- TCO - END; - WHEN a0sym = 'if' THEN - BEGIN - cond := mal.EVAL(types._nth(ast, 1), env); - SELECT type_id INTO type FROM types.value WHERE value_id = cond; - IF type = 0 OR type = 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; - END; - WHEN a0sym = 'fn*' THEN - BEGIN - RETURN types._malfunc(types._nth(ast, 2), types._nth(ast, 1), env); - END; - ELSE - BEGIN - el := mal.eval_ast(ast, env); - SELECT type_id, val_string, ast_id, params_id, env_id - INTO type, fname, fast, fparams, fenv - FROM types.value WHERE value_id = types._first(el); - args := types._restArray(el); - 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 CASE; - 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) ")")))))') \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' -SELECT mal.REP('(def! *gensym-counter* (atom 0))') \g '/dev/null' -SELECT mal.REP('(def! gensym (fn* [] (symbol (str "G__" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))') \g '/dev/null' -SELECT mal.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)))))))))') \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/plpgsql/types.sql b/plpgsql/types.sql deleted file mode 100644 index 62a63cc83b..0000000000 --- a/plpgsql/types.sql +++ /dev/null @@ -1,672 +0,0 @@ --- --------------------------------------------------------- --- 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; - - --- _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; - --- --------------------------------------------------------- --- 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/plpgsql/wrap.sh b/plpgsql/wrap.sh deleted file mode 100755 index 3e7c921a80..0000000000 --- a/plpgsql/wrap.sh +++ /dev/null @@ -1,75 +0,0 @@ -#!/bin/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/plsql/Makefile b/plsql/Makefile deleted file mode 100644 index 2660df0919..0000000000 --- a/plsql/Makefile +++ /dev/null @@ -1,12 +0,0 @@ -SOURCES_LISP = env.sql core.sql stepA_mal.sql -SOURCES = wrap.sh login.sql io.sql types.sql reader.sql printer.sql $(SOURCES_LISP) - -.PHONY: stats - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*--|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*--|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" - diff --git a/plsql/core.sql b/plsql/core.sql deleted file mode 100644 index ceaaaf32c5..0000000000 --- a/plsql/core.sql +++ /dev/null @@ -1,610 +0,0 @@ -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 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 = '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 = '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?', - - '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', - '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/plsql/entrypoint.sh b/plsql/entrypoint.sh deleted file mode 100755 index ff4dd8d69b..0000000000 --- a/plsql/entrypoint.sh +++ /dev/null @@ -1,10 +0,0 @@ -#!/bin/bash - -echo "Starting Oracle XE" -sudo /usr/sbin/startup.sh - -if [ "${*}" ]; then - exec "${@}" -else - exec bash -fi diff --git a/plsql/reader.sql b/plsql/reader.sql deleted file mode 100644 index b48e7c0906..0000000000 --- a/plsql/reader.sql +++ /dev/null @@ -1,233 +0,0 @@ --- --------------------------------------------------------- --- 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 -- 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 || '''', 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/plsql/run b/plsql/run deleted file mode 100755 index 8613ff915a..0000000000 --- a/plsql/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec $(dirname $0)/wrap.sh $(dirname $0)/${STEP:-stepA_mal}.sql "${@}" diff --git a/plsql/step6_file.sql b/plsql/step6_file.sql deleted file mode 100644 index 020bc37f37..0000000000 --- a/plsql/step6_file.sql +++ /dev/null @@ -1,274 +0,0 @@ -@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) ")")))))'); - - 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/plsql/step7_quote.sql b/plsql/step7_quote.sql deleted file mode 100644 index 2c8643157e..0000000000 --- a/plsql/step7_quote.sql +++ /dev/null @@ -1,309 +0,0 @@ -@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 is_pair(ast integer) RETURN BOOLEAN IS - BEGIN - RETURN M(ast).type_id IN (8,9) AND types.count(M, ast) > 0; - END; - - FUNCTION quasiquote(ast integer) RETURN integer IS - a0 integer; - a00 integer; - BEGIN - IF NOT is_pair(ast) THEN - RETURN types.list(M, types.symbol(M, 'quote'), ast); - ELSE - a0 := types.nth(M, ast, 0); - IF M(a0).type_id = 7 AND - TREAT(m(a0) AS mal_str_T).val_str = 'unquote' THEN - RETURN types.nth(M, ast, 1); - ELSIF is_pair(a0) THEN - a00 := types.nth(M, a0, 0); - IF M(a00).type_id = 7 AND - TREAT(M(a00) AS mal_str_T).val_str = 'splice-unquote' THEN - RETURN types.list(M, types.symbol(M, 'concat'), - types.nth(M, a0, 1), - quasiquote(types.slice(M, ast, 1))); - END IF; - END IF; - RETURN types.list(M, types.symbol(M, 'cons'), - quasiquote(a0), - quasiquote(types.slice(M, ast, 1))); - END IF; - 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, 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 = '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) ")")))))'); - - 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/plsql/step8_macros.sql b/plsql/step8_macros.sql deleted file mode 100644 index c05b10a941..0000000000 --- a/plsql/step8_macros.sql +++ /dev/null @@ -1,368 +0,0 @@ -@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 is_pair(ast integer) RETURN BOOLEAN IS - BEGIN - RETURN M(ast).type_id IN (8,9) AND types.count(M, ast) > 0; - END; - - FUNCTION quasiquote(ast integer) RETURN integer IS - a0 integer; - a00 integer; - BEGIN - IF NOT is_pair(ast) THEN - RETURN types.list(M, types.symbol(M, 'quote'), ast); - ELSE - a0 := types.nth(M, ast, 0); - IF M(a0).type_id = 7 AND - TREAT(m(a0) AS mal_str_T).val_str = 'unquote' THEN - RETURN types.nth(M, ast, 1); - ELSIF is_pair(a0) THEN - a00 := types.nth(M, a0, 0); - IF M(a00).type_id = 7 AND - TREAT(M(a00) AS mal_str_T).val_str = 'splice-unquote' THEN - RETURN types.list(M, types.symbol(M, 'concat'), - types.nth(M, a0, 1), - quasiquote(types.slice(M, ast, 1))); - END IF; - END IF; - RETURN types.list(M, types.symbol(M, 'cons'), - quasiquote(a0), - quasiquote(types.slice(M, ast, 1))); - END IF; - END; - - - 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 = '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) ")")))))'); - 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)))))))'); - line := 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 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/plsql/step9_try.sql b/plsql/step9_try.sql deleted file mode 100644 index a9205b49a1..0000000000 --- a/plsql/step9_try.sql +++ /dev/null @@ -1,454 +0,0 @@ -@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 is_pair(ast integer) RETURN BOOLEAN IS - BEGIN - RETURN M(ast).type_id IN (8,9) AND types.count(M, ast) > 0; - END; - - FUNCTION quasiquote(ast integer) RETURN integer IS - a0 integer; - a00 integer; - BEGIN - IF NOT is_pair(ast) THEN - RETURN types.list(M, types.symbol(M, 'quote'), ast); - ELSE - a0 := types.nth(M, ast, 0); - IF M(a0).type_id = 7 AND - TREAT(m(a0) AS mal_str_T).val_str = 'unquote' THEN - RETURN types.nth(M, ast, 1); - ELSIF is_pair(a0) THEN - a00 := types.nth(M, a0, 0); - IF M(a00).type_id = 7 AND - TREAT(M(a00) AS mal_str_T).val_str = 'splice-unquote' THEN - RETURN types.list(M, types.symbol(M, 'concat'), - types.nth(M, a0, 1), - quasiquote(types.slice(M, ast, 1))); - END IF; - END IF; - RETURN types.list(M, types.symbol(M, 'cons'), - quasiquote(a0), - quasiquote(types.slice(M, ast, 1))); - END IF; - END; - - - 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 = '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) ")")))))'); - 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)))))))'); - line := 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 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/plsql/stepA_mal.sql b/plsql/stepA_mal.sql deleted file mode 100644 index 2391e3fefa..0000000000 --- a/plsql/stepA_mal.sql +++ /dev/null @@ -1,458 +0,0 @@ -@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 is_pair(ast integer) RETURN BOOLEAN IS - BEGIN - RETURN M(ast).type_id IN (8,9) AND types.count(M, ast) > 0; - END; - - FUNCTION quasiquote(ast integer) RETURN integer IS - a0 integer; - a00 integer; - BEGIN - IF NOT is_pair(ast) THEN - RETURN types.list(M, types.symbol(M, 'quote'), ast); - ELSE - a0 := types.nth(M, ast, 0); - IF M(a0).type_id = 7 AND - TREAT(m(a0) AS mal_str_T).val_str = 'unquote' THEN - RETURN types.nth(M, ast, 1); - ELSIF is_pair(a0) THEN - a00 := types.nth(M, a0, 0); - IF M(a00).type_id = 7 AND - TREAT(M(a00) AS mal_str_T).val_str = 'splice-unquote' THEN - RETURN types.list(M, types.symbol(M, 'concat'), - types.nth(M, a0, 1), - quasiquote(types.slice(M, ast, 1))); - END IF; - END IF; - RETURN types.list(M, types.symbol(M, 'cons'), - quasiquote(a0), - quasiquote(types.slice(M, ast, 1))); - END IF; - END; - - - 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 = '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) ")")))))'); - 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)))))))'); - line := REP('(def! *gensym-counter* (atom 0))'); - line := REP('(def! gensym (fn* [] (symbol (str "G__" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))'); - line := 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 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; - io.writeline('Error: ' || SQLERRM); - io.writeline(dbms_utility.format_error_backtrace); - END; - END LOOP; -END; - -END mal; -/ -show errors; - -quit; diff --git a/plsql/types.sql b/plsql/types.sql deleted file mode 100644 index a6fdc8ec9e..0000000000 --- a/plsql/types.sql +++ /dev/null @@ -1,603 +0,0 @@ --- --------------------------------------------------------- --- 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; - - -- 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; - - --- --------------------------------------------------------- --- 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/plsql/wrap.sh b/plsql/wrap.sh deleted file mode 100755 index 8822116bdf..0000000000 --- a/plsql/wrap.sh +++ /dev/null @@ -1,122 +0,0 @@ -#!/bin/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/process/guide.md b/process/guide.md index eba18051bf..bda640206d 100644 --- a/process/guide.md +++ b/process/guide.md @@ -32,9 +32,9 @@ So jump right in (er ... start the climb)! 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) @@ -74,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 @@ -94,32 +96,34 @@ 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_STEP_TO_PROG = impls/quux/$($(1)).qx ``` -* Add a "run" script to you implementation directory that listens to +* 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". The following are examples of "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"): ``` -#!/bin/bash +#!/usr/bin/env bash exec $(dirname $0)/${STEP:-stepA_mal} "${@}" ``` ``` -#!/bin/bash +#!/usr/bin/env bash exec quux $(dirname $0)/${STEP:-stepA_mal}.qx "${@}" ``` @@ -184,18 +188,25 @@ a textual diff/comparison tool to compare the previous pseudocode step 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/process/cheatsheet.html) that +[cheatsheet](http://kanaka.github.io/mal/cheatsheet.html) that summarizes the key changes at each step. If you get completely stuck and are feeling like giving up, then you should "cheat" by referring to the same step or functionality in -a existing implementation language. You are here to learn, not to take +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". @@ -208,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 @@ -299,7 +310,7 @@ 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 token at @@ -307,16 +318,16 @@ expression support. 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 +* 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. @@ -327,11 +338,13 @@ expression support. * `~@`: Captures the special two-characters `~@` (tokenized). * ```[\[\]{}()'`~^@]```: Captures any special single character, one of - ```[]{}'`~^@``` (tokenized). + ```[]{}()'`~^@``` (tokenized). - * `"(?:\\.|[^\\"])*"`: Starts capturing at a double-quote and stops at the - next double-quote unless it was proceeded by a backslash in which case it - includes it until the next double-quote (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). @@ -349,13 +362,13 @@ expression support. subclass type. For example, if your language is object oriented, 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 @@ -369,9 +382,9 @@ expression support. 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). @@ -423,8 +436,9 @@ and each step will give progressively more bang for the buck. * 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, the following transformations are + 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 @@ -459,7 +473,12 @@ and each step will give progressively more bang for the buck. 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. You can use the same reader function for both + 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 @@ -467,7 +486,13 @@ and each step will give progressively more bang for the buck. 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. Because of the representation of hash-maps as + 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 @@ -497,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`. @@ -516,23 +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 empty list: return ast unchanged. - * `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 @@ -549,7 +568,7 @@ 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. ``` @@ -560,13 +579,25 @@ You now have a simple prefix notation calculator! #### Deferrable: -* `eval_ast` should evaluate elements of vectors and hash-maps. Add the - following cases in `eval_ast`: +* 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. @@ -592,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`. @@ -606,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. + * 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: @@ -639,8 +670,7 @@ diff -urp ../process/step2_eval.txt ../process/step3_env.txt 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 @@ -663,7 +693,7 @@ Now go to the top level, run the step 3 tests and fix the errors. 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. @@ -711,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`. @@ -721,15 +751,15 @@ 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`: - * `do`: Evaluate all the elements of the list using `eval_ast` + * `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 @@ -759,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 @@ -774,7 +804,7 @@ Try out the basic functionality you have implemented: * Add the following functions to `core.ns`: * `prn`: call `pr_str` on the first parameter with `print_readably` - set to true, prints the result to the screen and then return + 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 @@ -818,7 +848,7 @@ from a neat toy to a full featured language. 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 (deferrable section of step 1). Each of the string functions takes multiple mal values, prints them (`pr_str`) and @@ -862,7 +892,7 @@ 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_if_fn_do.qx` to `step5_tco.qx`. @@ -877,7 +907,7 @@ 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 + * `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). @@ -896,19 +926,22 @@ diff -urp ../process/step4_if_fn_do.txt ../process/step5_tco.txt * `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 - needed for the `map` and `apply` core functions). + 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). * 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. @@ -949,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`. @@ -968,12 +1001,12 @@ diff -urp ../process/step5_tco.txt ../process/step6_file.txt * 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 the your `EVAL` function + 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 to this: + you can now do this: ``` (def! mal-prog (list + 1 2)) (eval mal-prog) @@ -981,7 +1014,7 @@ diff -urp ../process/step5_tco.txt ../process/step6_file.txt * 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` @@ -990,7 +1023,9 @@ 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 @@ -1021,7 +1056,7 @@ You'll need to add 5 functions to the core namespace to support atoms: 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 `read_form` function and add a case which deals with +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`). @@ -1045,7 +1080,7 @@ 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. -You mal implementation is quite powerful already but the set of +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 @@ -1086,7 +1121,7 @@ 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 @@ -1104,9 +1139,10 @@ 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 @@ -1118,13 +1154,13 @@ 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. @@ -1143,37 +1179,66 @@ 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 the 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 the 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" ``` +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. @@ -1184,8 +1249,8 @@ macros. 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`). @@ -1199,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`. @@ -1225,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`. @@ -1242,35 +1315,28 @@ 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 the result of calling `eval_ast` - on it, 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: ``` @@ -1281,14 +1347,15 @@ 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 @@ -1317,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. @@ -1344,7 +1417,7 @@ functional programming pedigree of your implementation by adding the 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`. @@ -1390,9 +1463,12 @@ diff -urp ../process/step8_macros.txt ../process/step9_try.txt * 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*`, the you will need to do so now. + `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 list (or vector). The + 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 @@ -1403,7 +1479,7 @@ diff -urp ../process/step8_macros.txt ../process/step9_try.txt function against every element of the list (or vector) one at a time and returns the results as a list. -* Add some type predicates core functions. In Lisp, predicates are +* 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) @@ -1442,6 +1518,9 @@ self-hosting. * `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 @@ -1469,9 +1548,6 @@ self-hosting. 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. - * `sequential?`: takes a single arguments and returns true (mal true - value) if it is a list or a vector, otherwise returns false (mal - false value). @@ -1498,7 +1574,7 @@ 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`. @@ -1508,18 +1584,21 @@ diff -urp ../process/step9_try.txt ../process/stepA_mal.txt 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 meta-data support to mal functions. TODO. Should be separate - from the function macro flag. - * Add a new "\*host-language\*" (symbol) entry to your REPL environment. The value of this entry should be a mal string - containing thename of the current implementation. + 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* \"]\"))". + "(println (str \"Mal [\" \*host-language\* \"]\"))". +* 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: ``` @@ -1528,7 +1607,7 @@ 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 a each of the step +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 @@ -1572,44 +1651,38 @@ implementation to run a mal implementation which itself runs the mal implementation. -#### Optional: gensym - -The `or` macro we introduced at step 8 has a bug. It defines a -variable called `or_FIXME`, which "shadows" such a binding from the -user's code (which uses the macro). If a user has a variable called -`or_FIXME`, it cannot be used as an `or` macro argument. In order to -fix that, we'll introduce `gensym`: a function which returns a symbol -which was never used before anywhere in the program. This is also an -example for the use of mal atoms to keep state (the state here being -the number of symbols produced by `gensym` so far). - -Previously you used `rep` to define the `or` macro. Remove that -definition and use `rep` to define the new counter, `gensym` function -and the clean `or` macro. Here are the string arguments you need to -pass to `rep`: -``` -"(def! *gensym-counter* (atom 0))" - -"(def! gensym (fn* [] (symbol (str \"G__\" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))" - -"(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)))))))))" -``` - -For extra information read [Peter Seibel's thorough discussion about -`gensym` and leaking macros in Common Lisp](http://www.gigamonkeys.com/book/macros-defining-your-own.html#plugging-the-leaks). - - #### Optional additions -* Add metadata support to composite data types, symbols and native - functions. TODO -* Add the following new core functions: +* 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 mal implementation performance - benchmarks by running `make perf^quux`. + 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 @@ -1618,28 +1691,55 @@ For extra information read [Peter Seibel's thorough discussion about 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 that + 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 + 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 `quux/tests/stepA_mal.mal` (see the - [tests for `lua-eval`](../lua/tests/stepA_mal.mal) as an example). - - -## TODO: - -* simplify: "X argument (list element Y)" -> ast[Y] -* 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) + 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 71f8750308..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 2013ae9835..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 b9681cccc0..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 9cd2e08c32..d3eb5b1a80 100644 --- a/process/step2_eval.txt +++ b/process/step2_eval.txt @@ -3,18 +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) - if empty?(ast): return ast - 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 2fe4de7e65..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 0210efccf8..8729698e45 100644 --- a/process/step3_env.txt +++ b/process/step3_env.txt @@ -3,21 +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) - if empty?(ast): return ast - 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) @@ -35,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 631c6d6d5c..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 f1a32d0f82..8085df5c12 100644 --- a/process/step4_if_fn_do.txt +++ b/process/step4_if_fn_do.txt @@ -3,31 +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) - if empty?(ast): return ast - 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 @@ -44,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 25f1d67bff..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 0c81b5e2be..1fd6d0540c 100644 --- a/process/step5_tco.txt +++ b/process/step5_tco.txt @@ -3,33 +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) - if empty?(ast): return ast - 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 @@ -46,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 2db6fc18fc..0000000000 --- a/process/step6_file.gliffy +++ /dev/null @@ -1 +0,0 @@ -{"contentType":"application/gliffy+json","version":"1.3","stage":{"background":"#FFFFFF","width":960,"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":959.5,"y":724.5}},"printModel":{"pageSize":"Letter","portrait":true,"fitToOnePage":false,"displayPageBreaks":false},"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"},{"x":31.5,"y":64.0,"rotation":0.0,"id":207,"width":225.0,"height":132.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

 

 atom atom? deref reset! swap!

 

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"linkMap":[],"children":[],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"}],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"}],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"}],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"}],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"}],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"}],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"}],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"}],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"}],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"}],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"}],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"}],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"}],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"}],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"}],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"}],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"}],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"}],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"}],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"}],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"}],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"}],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"}],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"}],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"}],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"}],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"}],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"}],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"}],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"}],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"},{"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":[],"hidden":false,"layerId":"T8vCf3WiHoia"}],"hidden":false,"layerId":"T8vCf3WiHoia"}],"layers":[{"guid":"T8vCf3WiHoia","order":0,"name":"Layer 0","active":true,"locked":false,"visible":true,"nodeIndex":0}],"shapeStyles":{"com.gliffy.shape.basic.basic_v1.default":{"fill":"#c9daf8","stroke":"#333333","strokeWidth":2}},"lineStyles":{"global":{"strokeWidth":2,"endArrow":2}},"textStyles":{"global":{"face":"Arial","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,"lastSerialized":1451710575671,"analyticsProduct":"Online"},"embeddedResources":{"index":0,"resources":[]}} \ No newline at end of file diff --git a/process/step6_file.png b/process/step6_file.png index f2e1b9a555..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 9f14f351a0..221f4ba7e5 100644 --- a/process/step6_file.txt +++ b/process/step6_file.txt @@ -3,40 +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) - if empty?(ast): return ast - 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) (eval (read-string (str \"(do \" (slurp 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 @@ -51,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?, diff --git a/process/step7_quote.gliffy b/process/step7_quote.gliffy deleted file mode 100644 index d505f95a2a..0000000000 --- a/process/step7_quote.gliffy +++ /dev/null @@ -1 +0,0 @@ -{"contentType":"application/gliffy+json","version":"1.3","stage":{"background":"#FFFFFF","width":960,"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":959.5,"y":724.5}},"printModel":{"pageSize":"Letter","portrait":true,"fitToOnePage":false,"displayPageBreaks":false},"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"},{"x":32.0,"y":64.0,"rotation":0.0,"id":207,"width":225.0,"height":121.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

 

 atom atom? deref reset! swap!

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"linkMap":[],"children":[],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"}],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"}],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"}],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"}],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"}],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"}],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"}],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"}],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"}],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"}],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"}],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"}],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"}],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"}],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"}],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"}],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"}],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"}],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"}],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"}],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"}],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"}],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"}],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"}],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"}],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"}],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"}],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"}],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"}],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"}],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"}],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"}],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"},{"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":[],"hidden":false,"layerId":"7tUQXVB5TDot"}],"hidden":false,"layerId":"7tUQXVB5TDot"}],"layers":[{"guid":"7tUQXVB5TDot","order":0,"name":"Layer 0","active":true,"locked":false,"visible":true,"nodeIndex":0}],"shapeStyles":{"com.gliffy.shape.basic.basic_v1.default":{"fill":"#c9daf8","stroke":"#cc0000","strokeWidth":2}},"lineStyles":{"global":{"strokeWidth":2,"endArrow":2}},"textStyles":{"global":{"face":"Arial","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,"lastSerialized":1451710582543,"analyticsProduct":"Online"},"embeddedResources":{"index":0,"resources":[]}} \ No newline at end of file diff --git a/process/step7_quote.png b/process/step7_quote.png index a4ee66bf7f..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 1000a09727..fb103551fc 100644 --- a/process/step7_quote.txt +++ b/process/step7_quote.txt @@ -3,45 +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) - if empty?(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 - '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) (eval (read-string (str \"(do \" (slurp 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 @@ -56,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?, @@ -83,6 +90,7 @@ ns = {'=: equal?, 'cons: (a) -> concat([a[0]], a[1]), 'concat: (a) -> reduce(concat, [], a), + 'vec: (l) -> l converted to vector, 'empty?: empty?, 'count: count, diff --git a/process/step8_macros.gliffy b/process/step8_macros.gliffy deleted file mode 100644 index da7427f383..0000000000 --- a/process/step8_macros.gliffy +++ /dev/null @@ -1 +0,0 @@ -{"contentType":"application/gliffy+json","version":"1.3","stage":{"background":"#FFFFFF","width":960,"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":959.5,"y":724.5}},"printModel":{"pageSize":"Letter","portrait":true,"fitToOnePage":false,"displayPageBreaks":false},"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"x":32.0,"y":64.0,"rotation":0.0,"id":207,"width":225.0,"height":121.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

 

 atom atom? deref reset! swap!

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"linkMap":[],"children":[],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"},{"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":[],"hidden":false,"layerId":"kMEDuSAA6XW0"}],"layers":[{"guid":"kMEDuSAA6XW0","order":0,"name":"Layer 0","active":true,"locked":false,"visible":true,"nodeIndex":0}],"shapeStyles":{"com.gliffy.shape.basic.basic_v1.default":{"fill":"#c9daf8","stroke":"#cc0000","strokeWidth":2}},"lineStyles":{"global":{"stroke":"#cc0000","strokeWidth":2,"endArrow":2}},"textStyles":{"global":{"face":"Arial","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,"lastSerialized":1451710588588,"analyticsProduct":"Online"},"embeddedResources":{"index":0,"resources":[]}} \ No newline at end of file diff --git a/process/step8_macros.png b/process/step8_macros.png index a717e79ead..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 b84b73a339..87cabd7e62 100644 --- a/process/step8_macros.txt +++ b/process/step8_macros.txt @@ -3,56 +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 eval_ast(ast, env) - if empty?(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) (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))))))))"); if cmdline_args: rep("(load-file \"" + args[0] + "\")"); exit 0 @@ -67,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?, @@ -94,6 +94,7 @@ 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(), diff --git a/process/step9_try.gliffy b/process/step9_try.gliffy deleted file mode 100644 index cb98ab1378..0000000000 --- a/process/step9_try.gliffy +++ /dev/null @@ -1 +0,0 @@ -{"contentType":"application/gliffy+json","version":"1.3","stage":{"background":"#FFFFFF","width":960,"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,"imageCache":null,"viewportType":"default","fitBB":{"min":{"x":20,"y":18.5},"max":{"x":959.5,"y":724.5}},"printModel":{"pageSize":"Letter","portrait":true,"fitToOnePage":false,"displayPageBreaks":false},"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":[],"hidden":false,"layerId":"wexc89lJgCr2"},{"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 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

 

 atom atom? deref reset! swap!

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"linkMap":[],"children":[],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"},{"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":[],"hidden":false,"layerId":"wexc89lJgCr2"}],"hidden":false,"layerId":"wexc89lJgCr2"}],"layers":[{"guid":"wexc89lJgCr2","order":0,"name":"Layer 0","active":true,"locked":false,"visible":true,"nodeIndex":0}],"shapeStyles":{"com.gliffy.shape.basic.basic_v1.default":{"fill":"#c9daf8","stroke":"#cc0000","strokeWidth":2}},"lineStyles":{"global":{"stroke":"#cc0000","strokeWidth":2,"endArrow":2}},"textStyles":{"global":{"bold":true,"size":"10px","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,"lastSerialized":1462634720646,"analyticsProduct":"Online"},"embeddedResources":{"index":0,"resources":[]}} \ No newline at end of file diff --git a/process/step9_try.png b/process/step9_try.png index 8c83561f2c..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 0c070e8de3..a27c785a36 100644 --- a/process/step9_try.txt +++ b/process/step9_try.txt @@ -3,57 +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 eval_ast(ast, env) - if empty?(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) (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))))))))"); if cmdline_args: rep("(load-file \"" + args[0] + "\")"); exit 0 @@ -68,8 +74,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?, @@ -115,6 +120,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(), diff --git a/process/stepA_mal.gliffy b/process/stepA_mal.gliffy deleted file mode 100644 index ce238485a2..0000000000 --- a/process/stepA_mal.gliffy +++ /dev/null @@ -1 +0,0 @@ -{"contentType":"application/gliffy+json","version":"1.3","stage":{"background":"#FFFFFF","width":960,"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,"imageCache":null,"viewportType":"default","fitBB":{"min":{"x":20,"y":18.5},"max":{"x":959.5,"y":724.5}},"printModel":{"pageSize":"Letter","portrait":true,"fitToOnePage":false,"displayPageBreaks":false},"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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? string? 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 seq

 

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

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"linkMap":[],"children":[],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"},{"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":[],"hidden":false,"layerId":"rMdIym7ggHJm"},{"x":561.5,"y":63.5,"rotation":0.0,"id":212,"width":77.5,"height":33.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

gensym

or

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"linkMap":[],"children":[],"hidden":false,"layerId":"rMdIym7ggHJm"}],"layers":[{"guid":"rMdIym7ggHJm","order":0,"name":"Layer 0","active":true,"locked":false,"visible":true,"nodeIndex":0}],"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,"lastSerialized":1462634615141,"analyticsProduct":"Online"},"embeddedResources":{"index":0,"resources":[]}} \ No newline at end of file diff --git a/process/stepA_mal.png b/process/stepA_mal.png index 9bc0286d9d..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 431a4b98ee..432bdef706 100644 --- a/process/stepA_mal.txt +++ b/process/stepA_mal.txt @@ -3,60 +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 eval_ast(ast, env) - if empty?(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) (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("(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)))))))))") if cmdline_args: rep("(load-file \"" + args[0] + "\")"); exit 0 @@ -72,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?, @@ -87,6 +90,9 @@ ns = {'=: equal?, '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("")), @@ -122,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(), 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/Dockerfile b/ps/Dockerfile deleted file mode 100644 index d91f68e1ea..0000000000 --- a/ps/Dockerfile +++ /dev/null @@ -1,25 +0,0 @@ -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 -########################################################## - -# PostScript/ghostscript -RUN apt-get -y install ghostscript diff --git a/ps/Makefile b/ps/Makefile deleted file mode 100644 index 67741380c3..0000000000 --- a/ps/Makefile +++ /dev/null @@ -1,39 +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) - -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 - - -.PHONY: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*%|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*%|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" - -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/run b/ps/run deleted file mode 100755 index 221d2db29b..0000000000 --- a/ps/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec gs -q -I$(dirname $0) -dNODISPLAY -- $(dirname $0)/${STEP:-stepA_mal}.ps "${@}" diff --git a/ps/step2_eval.ps b/ps/step2_eval.ps deleted file mode 100644 index 57bed6d928..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 0db73a2dfc..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 87b43cf3db..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 5b24490e16..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 b1a7ddebaf..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 51de0dbf4a..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 51eabc98d2..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 c09432f9d0..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 8e6611a41a..0000000000 Binary files a/ps/stepA_mal.ps and /dev/null differ diff --git a/python/Dockerfile b/python/Dockerfile deleted file mode 100644 index 3e64cc116c..0000000000 --- a/python/Dockerfile +++ /dev/null @@ -1,28 +0,0 @@ -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 -########################################################## - -# Nothing additional needed for python -RUN apt-get -y install python3 - -# For dist packaging -RUN apt-get -y install zip diff --git a/python/Makefile b/python/Makefile deleted file mode 100644 index c16b83ffe9..0000000000 --- a/python/Makefile +++ /dev/null @@ -1,41 +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: - 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 - -.PHONY: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*#|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*#|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" - -tests: $(TESTS) - -$(TESTS): - @echo "Running $@"; \ - python $@ || exit 1; \ diff --git a/python/core.py b/python/core.py deleted file mode 100644 index d87f1e8da0..0000000000 --- a/python/core.py +++ /dev/null @@ -1,189 +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): - print(" ".join(map(lambda exp: printer._pr_str(exp, False), args))) - 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): - if types._nil_Q(lst): return None - else: return lst[0] - -def rest(lst): - if types._nil_Q(lst): return List([]) - else: 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) - -def apply(f, *args): return f(*(list(args[0:-1])+args[-1])) - -def mapf(f, lst): return List(map(f, 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 seq(obj): - if types._list_Q(obj): - return obj if len(obj) > 0 else None - elif types._vector_Q(obj): - return List(obj) if len(obj) > 0 else None - elif types._string_Q(obj): - return List([c for c in obj]) if len(obj) > 0 else None - elif obj == None: - return None - 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): - 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, - 'string?': types._string_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, - '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/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 340f3f64d6..0000000000 --- a/python/mal_readline.py +++ /dev/null @@ -1,32 +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") - except IOError: - pass - except EOFError: - return None - return line diff --git a/python/mal_types.py b/python/mal_types.py deleted file mode 100644 index 57cbde2c7d..0000000000 --- a/python/mal_types.py +++ /dev/null @@ -1,140 +0,0 @@ -import sys, copy, types as pytypes - -# python 3.0 differences -if sys.hexversion > 0x3000000: - _u = lambda x: x - _s2u = lambda x: x -else: - import codecs - _u = lambda x: codecs.unicode_escape_decode(x)[0] - _s2u = lambda x: unicode(x) - -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 _string_Q(a) and _string_Q(b): - return a == 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): - if type(exp) in str_types: - return len(exp) == 0 or exp[0] != _u("\u029e") - else: - return False - -# 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): - if type(exp) in str_types: - return len(exp) != 0 and exp[0] == _u("\u029e") - else: - return False - -# Functions -def _function(Eval, Env, ast, env, params): - def fn(*args): - return Eval(ast, Env(env, params, List(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 - -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/python/printer.py b/python/printer.py deleted file mode 100644 index 32d2708387..0000000000 --- a/python/printer.py +++ /dev/null @@ -1,34 +0,0 @@ -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 "(" + " ".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 type(obj) in types.str_types: - if len(obj) > 0 and obj[0] == types._u('\u029e'): - return ':' + obj[1:] - elif print_readably: - 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 obj.__str__() - diff --git a/python/reader.py b/python/reader.py deleted file mode 100644 index 44c9d741cc..0000000000 --- a/python/reader.py +++ /dev/null @@ -1,110 +0,0 @@ -import re -from mal_types import (_symbol, _keyword, _list, _vector, _hash_map, _s2u) - -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('\\"', '"').replace('\\n', '\n').replace('\\\\', '\\') - -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] == '"': - if token[-1] == '"': return _s2u(_unescape(token[1:-1])) - else: 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, 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/run b/python/run deleted file mode 100755 index 09220ec06a..0000000000 --- a/python/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec python $(dirname $0)/${STEP:-stepA_mal}.py "${@}" diff --git a/python/step0_repl.py b/python/step0_repl.py deleted file mode 100644 index 3e5801b55f..0000000000 --- a/python/step0_repl.py +++ /dev/null @@ -1,29 +0,0 @@ -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), {})) - -# 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 c167e38613..0000000000 --- a/python/step1_read_print.py +++ /dev/null @@ -1,32 +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 - -# print -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 ba9d616023..0000000000 --- a/python/step2_eval.py +++ /dev/null @@ -1,64 +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 - if len(ast) == 0: return ast - el = eval_ast(ast, env) - f = el[0] - return f(*el[1:]) - -# print -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 016aae8ed3..0000000000 --- a/python/step8_macros.py +++ /dev/null @@ -1,153 +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 eval_ast(ast, env) - 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 9cebe9c662..0000000000 --- a/python/step9_try.py +++ /dev/null @@ -1,170 +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 eval_ast(ast, env) - 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 6f2f6dabf2..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 eval_ast(ast, env) - 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: - exec(compile(ast[1], '', 'single'), globals()) - return None - elif "py*" == a0: - return types.py_to_mal(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("(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)))))))))") - -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/python/tests/stepA_mal.mal b/python/tests/stepA_mal.mal deleted file mode 100644 index dfe05106e9..0000000000 --- a/python/tests/stepA_mal.mal +++ /dev/null @@ -1,23 +0,0 @@ -;; Testing Python interop - -;; Testing Python experesions -(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/r/Dockerfile b/r/Dockerfile deleted file mode 100644 index 42611aeca2..0000000000 --- a/r/Dockerfile +++ /dev/null @@ -1,24 +0,0 @@ -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 -########################################################## - -RUN apt-get -y install r-base-core diff --git a/r/Makefile b/r/Makefile deleted file mode 100644 index 85e3247fac..0000000000 --- a/r/Makefile +++ /dev/null @@ -1,39 +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 - -dist: mal.r mal - -mal.r: $(SOURCES) - cat $+ | grep -v " source(" > $@ - -mal: mal.r - echo "#!/usr/bin/env Rscript" > $@ - cat $< >> $@ - chmod +x $@ - -clean: - rm -f mal.r mal - -.PHONY: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*#|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*#|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" - - -.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/run b/r/run deleted file mode 100755 index 711ef09092..0000000000 --- a/r/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec Rscript $(dirname $0)/${STEP:-stepA_mal}.r "${@}" diff --git a/r/step2_eval.r b/r/step2_eval.r deleted file mode 100644 index 68cd4061bc..0000000000 --- a/r/step2_eval.r +++ /dev/null @@ -1,66 +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 - if (length(ast) == 0) { - return(ast) - } - 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 272ff2929d..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(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/r/step8_macros.r b/r/step8_macros.r deleted file mode 100644 index 012aa7c9bc..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(eval_ast(ast, env)) - - 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(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/r/step9_try.r b/r/step9_try.r deleted file mode 100644 index 80c49487e3..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(eval_ast(ast, env)) - - 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(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: ", 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 7db7972ee9..0000000000 --- a/r/stepA_mal.r +++ /dev/null @@ -1,200 +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(eval_ast(ast, env)) - - 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("(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)))))))))") - - -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: ", get_error(err),"\n", sep="") - }) - # R debug/fatal with tracebacks: - #cat(rep(line),"\n", sep="") -} diff --git a/racket/Dockerfile b/racket/Dockerfile deleted file mode 100644 index 1b05ee258b..0000000000 --- a/racket/Dockerfile +++ /dev/null @@ -1,25 +0,0 @@ -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 -########################################################## - -# Racket -RUN apt-get -y install racket diff --git a/racket/Makefile b/racket/Makefile deleted file mode 100644 index 17b07dcd28..0000000000 --- a/racket/Makefile +++ /dev/null @@ -1,23 +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: - -dist: mal - -mal: $(SOURCES) - raco exe stepA_mal.rkt - mv stepA_mal $@ - -clean: - rm -f mal - -.PHONY: stats - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*;|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*;|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" 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/run b/racket/run deleted file mode 100755 index 923de9df0d..0000000000 --- a/racket/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec racket $(dirname $0)/${STEP:-stepA_mal}.rkt "${@}" diff --git a/racket/step3_env.rkt b/racket/step3_env.rkt deleted file mode 100755 index 91eff03e5b..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 (or (not (list? ast)) (empty? 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 bf13e00d03..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 (or (not (list? ast)) (empty? 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* (_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) \")\")))))") - -) - -(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 ca281057d8..0000000000 --- a/racket/step8_macros.rkt +++ /dev/null @@ -1,144 +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) - (not (empty? 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 (or (not (list? ast)) (empty? 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? '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* (_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 "(defmacro! cond (fn* (& xs) (if (> (count xs) 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 9cecd2af6f..0000000000 --- a/racket/step9_try.rkt +++ /dev/null @@ -1,161 +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) - (not (empty? 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 (or (not (list? ast)) (empty? 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? '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* (_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 "(defmacro! cond (fn* (& xs) (if (> (count xs) 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 813d0eb708..0000000000 --- a/racket/stepA_mal.rkt +++ /dev/null @@ -1,168 +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) - (not (empty? 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 (or (not (list? ast)) (empty? 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? '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* (_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) \")\")))))") -(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! *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)))))))))") - -) - -(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/rpython/Dockerfile b/rpython/Dockerfile deleted file mode 100644 index f7b2015577..0000000000 --- a/rpython/Dockerfile +++ /dev/null @@ -1,47 +0,0 @@ -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/pypy-4.0.1-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 - -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/rpython/Makefile b/rpython/Makefile deleted file mode 100644 index a86b4dd499..0000000000 --- a/rpython/Makefile +++ /dev/null @@ -1,43 +0,0 @@ - -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) - -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: $(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 stats stats-lisp - -clean: - rm -f mal $(STEPS) *.pyc - rm -rf __pycache__ - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*#|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*#|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" - diff --git a/rpython/core.py b/rpython/core.py deleted file mode 100644 index 5539a89963..0000000000 --- a/rpython/core.py +++ /dev/null @@ -1,431 +0,0 @@ -#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])) - - -# 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 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, - - '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, - '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/rpython/env.py b/rpython/env.py deleted file mode 100644 index 258874623f..0000000000 --- a/rpython/env.py +++ /dev/null @@ -1,40 +0,0 @@ -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 find(self, key): - assert isinstance(key, MalSym) - if key.value in self.data: return self - elif self.outer: return self.outer.find(key) - else: return None - - 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, MalSym) - env = self.find(key) - if not env: throw_str("'" + str(key.value) + "' not found") - return env.data[key.value] diff --git a/rpython/reader.py b/rpython/reader.py deleted file mode 100644 index 1e5acf6cb4..0000000000 --- a/rpython/reader.py +++ /dev/null @@ -1,133 +0,0 @@ -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.]*$' - else: - int_re = re.compile('-?[0-9]+$') - float_re = re.compile('-?[0-9][0-9.]*$') - token = reader.next() - if re.match(int_re, token): return MalInt(int(token)) -## elif re.match(float_re, token): return int(token) - elif token[0] == '"': - end = len(token)-1 - if end < 2: - return MalStr(u"") - else: - s = unicode(token[1:end]) - s = types._replace(u'\\"', u'"', s) - s = types._replace(u'\\n', u"\n", s) - s = types._replace(u'\\\\', u"\\", s) - return MalStr(s) - 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/rpython/run b/rpython/run deleted file mode 100755 index 8ba68a5484..0000000000 --- a/rpython/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec $(dirname $0)/${STEP:-stepA_mal} "${@}" diff --git a/rpython/step2_eval.py b/rpython/step2_eval.py deleted file mode 100644 index 82d71c882d..0000000000 --- a/rpython/step2_eval.py +++ /dev/null @@ -1,111 +0,0 @@ -#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(ast, env): - 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._list_Q(ast): - res = [] - for a in ast.values: - res.append(EVAL(a, env)) - return MalList(res) - 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) - 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 - el = eval_ast(ast, env) - f = el.values[0] - if isinstance(f, MalFunc): - return f.apply(el.values[1:]) - 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/rpython/step3_env.py b/rpython/step3_env.py deleted file mode 100644 index f196dfcecc..0000000000 --- a/rpython/step3_env.py +++ /dev/null @@ -1,124 +0,0 @@ -#import sys, traceback -import mal_readline -import mal_types as types -from mal_types import (MalSym, MalInt, MalStr, - _symbol, _keywordu, - 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(ast, env): - if types._symbol_Q(ast): - assert isinstance(ast, MalSym) - return env.get(ast) - elif types._list_Q(ast): - res = [] - for a in ast.values: - res.append(EVAL(a, env)) - return MalList(res) - 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) - 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 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: - el = eval_ast(ast, env) - f = el.values[0] - if isinstance(f, MalFunc): - return f.apply(el.values[1:]) - 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/rpython/step4_if_fn_do.py b/rpython/step4_if_fn_do.py deleted file mode 100644 index 1ce49692c9..0000000000 --- a/rpython/step4_if_fn_do.py +++ /dev/null @@ -1,123 +0,0 @@ -import sys, traceback -import mal_readline -import mal_types as types -from mal_types import (MalSym, MalInt, MalStr, - nil, true, false, _symbol, _keywordu, - 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(ast, env): - if types._symbol_Q(ast): - assert isinstance(ast, MalSym) - return env.get(ast) - elif types._list_Q(ast): - res = [] - for a in ast.values: - res.append(EVAL(a, env)) - return MalList(res) - 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) - 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 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: - el = eval_ast(ast.rest(), env) - return el.values[-1] - 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: - el = eval_ast(ast, env) - f = el.values[0] - if isinstance(f, MalFunc): - return f.apply(el.rest()) - 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/rpython/step5_tco.py b/rpython/step5_tco.py deleted file mode 100644 index 8d24555c87..0000000000 --- a/rpython/step5_tco.py +++ /dev/null @@ -1,132 +0,0 @@ -import sys, traceback -import mal_readline -import mal_types as types -from mal_types import (MalSym, MalInt, MalStr, - nil, true, false, _symbol, _keywordu, - 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(ast, env): - if types._symbol_Q(ast): - assert isinstance(ast, MalSym) - return env.get(ast) - elif types._list_Q(ast): - res = [] - for a in ast.values: - res.append(EVAL(a, env)) - return MalList(res) - 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) - 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 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 - elif len(ast) > 1: - eval_ast(ast.slice2(1, len(ast)-1), 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: - el = eval_ast(ast, env) - f = el.values[0] - if isinstance(f, MalFunc): - if f.ast: - ast = f.ast - env = f.gen_env(el.rest()) # Continue loop (TCO) - else: - return f.apply(el.rest()) - 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/rpython/step6_file.py b/rpython/step6_file.py deleted file mode 100644 index 06b8794a91..0000000000 --- a/rpython/step6_file.py +++ /dev/null @@ -1,147 +0,0 @@ -import sys, traceback -import mal_readline -import mal_types as types -from mal_types import (MalSym, MalInt, MalStr, - nil, true, false, _symbol, _keywordu, - 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(ast, env): - if types._symbol_Q(ast): - assert isinstance(ast, MalSym) - return env.get(ast) - elif types._list_Q(ast): - res = [] - for a in ast.values: - res.append(EVAL(a, env)) - return MalList(res) - 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) - 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 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 - elif len(ast) > 1: - eval_ast(ast.slice2(1, len(ast)-1), 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: - el = eval_ast(ast, env) - f = el.values[0] - if isinstance(f, MalFunc): - if f.ast: - ast = f.ast - env = f.gen_env(el.rest()) # Continue loop (TCO) - else: - return f.apply(el.rest()) - 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) \")\")))))", 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/rpython/step7_quote.py b/rpython/step7_quote.py deleted file mode 100644 index 1db9669038..0000000000 --- a/rpython/step7_quote.py +++ /dev/null @@ -1,174 +0,0 @@ -import sys, traceback -import mal_readline -import mal_types as types -from mal_types import (MalSym, MalInt, MalStr, - nil, true, false, _symbol, _keywordu, - 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 is_pair(x): - return types._sequential_Q(x) and len(x) > 0 - -def quasiquote(ast): - if not is_pair(ast): - return _list(_symbol(u"quote"), ast) - else: - a0 = ast[0] - if isinstance(a0, MalSym): - if a0.value == u'unquote': - return ast[1] - if is_pair(a0) and isinstance(a0[0], MalSym): - a00 = a0[0] - if (isinstance(a00, MalSym) and - a00.value == u'splice-unquote'): - return _list(_symbol(u"concat"), - a0[1], - quasiquote(ast.rest())) - return _list(_symbol(u"cons"), - quasiquote(a0), - quasiquote(ast.rest())) - - -def eval_ast(ast, env): - if types._symbol_Q(ast): - assert isinstance(ast, MalSym) - return env.get(ast) - elif types._list_Q(ast): - res = [] - for a in ast.values: - res.append(EVAL(a, env)) - return MalList(res) - 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) - 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 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 - elif len(ast) > 1: - eval_ast(ast.slice2(1, len(ast)-1), 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: - el = eval_ast(ast, env) - f = el.values[0] - if isinstance(f, MalFunc): - if f.ast: - ast = f.ast - env = f.gen_env(el.rest()) # Continue loop (TCO) - else: - return f.apply(el.rest()) - 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) \")\")))))", 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/rpython/step8_macros.py b/rpython/step8_macros.py deleted file mode 100644 index 52a47c44fc..0000000000 --- a/rpython/step8_macros.py +++ /dev/null @@ -1,199 +0,0 @@ -import sys, traceback -import mal_readline -import mal_types as types -from mal_types import (MalSym, MalInt, MalStr, - nil, true, false, _symbol, _keywordu, - 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 is_pair(x): - return types._sequential_Q(x) and len(x) > 0 - -def quasiquote(ast): - if not is_pair(ast): - return _list(_symbol(u"quote"), ast) - else: - a0 = ast[0] - if isinstance(a0, MalSym): - if a0.value == u'unquote': - return ast[1] - if is_pair(a0) and isinstance(a0[0], MalSym): - a00 = a0[0] - if (isinstance(a00, MalSym) and - a00.value == u'splice-unquote'): - return _list(_symbol(u"concat"), - a0[1], - quasiquote(ast.rest())) - return _list(_symbol(u"cons"), - quasiquote(a0), - quasiquote(ast.rest())) - -def is_macro_call(ast, env): - if types._list_Q(ast): - a0 = ast[0] - if isinstance(a0, MalSym): - if not env.find(a0) is None: - return env.get(a0).ismacro - return False - -def macroexpand(ast, env): - while is_macro_call(ast, env): - assert isinstance(ast[0], MalSym) - mac = env.get(ast[0]) - ast = macroexpand(mac.apply(ast.rest()), env) - return ast - -def eval_ast(ast, env): - if types._symbol_Q(ast): - assert isinstance(ast, MalSym) - return env.get(ast) - elif types._list_Q(ast): - res = [] - for a in ast.values: - res.append(EVAL(a, env)) - return MalList(res) - 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) - 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 eval_ast(ast, env) - 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) - func.ismacro = True - return env.set(ast[1], func) - elif u"macroexpand" == a0sym: - return macroexpand(ast[1], env) - elif u"do" == a0sym: - if len(ast) == 0: - return nil - elif len(ast) > 1: - eval_ast(ast.slice2(1, len(ast)-1), 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: - el = eval_ast(ast, env) - f = el.values[0] - if isinstance(f, MalFunc): - if f.ast: - ast = f.ast - env = f.gen_env(el.rest()) # Continue loop (TCO) - else: - return f.apply(el.rest()) - 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) \")\")))))", 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 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/rpython/step9_try.py b/rpython/step9_try.py deleted file mode 100644 index c39f808a00..0000000000 --- a/rpython/step9_try.py +++ /dev/null @@ -1,215 +0,0 @@ -import sys, traceback -import mal_readline -import mal_types as types -from mal_types import (MalSym, MalInt, MalStr, - nil, true, false, _symbol, _keywordu, - 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 is_pair(x): - return types._sequential_Q(x) and len(x) > 0 - -def quasiquote(ast): - if not is_pair(ast): - return _list(_symbol(u"quote"), ast) - else: - a0 = ast[0] - if isinstance(a0, MalSym): - if a0.value == u'unquote': - return ast[1] - if is_pair(a0) and isinstance(a0[0], MalSym): - a00 = a0[0] - if (isinstance(a00, MalSym) and - a00.value == u'splice-unquote'): - return _list(_symbol(u"concat"), - a0[1], - quasiquote(ast.rest())) - return _list(_symbol(u"cons"), - quasiquote(a0), - quasiquote(ast.rest())) - -def is_macro_call(ast, env): - if types._list_Q(ast): - a0 = ast[0] - if isinstance(a0, MalSym): - if not env.find(a0) is None: - return env.get(a0).ismacro - return False - -def macroexpand(ast, env): - while is_macro_call(ast, env): - assert isinstance(ast[0], MalSym) - mac = env.get(ast[0]) - ast = macroexpand(mac.apply(ast.rest()), env) - return ast - -def eval_ast(ast, env): - if types._symbol_Q(ast): - assert isinstance(ast, MalSym) - return env.get(ast) - elif types._list_Q(ast): - res = [] - for a in ast.values: - res.append(EVAL(a, env)) - return MalList(res) - 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) - 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 eval_ast(ast, env) - 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) - func.ismacro = True - return env.set(ast[1], func) - elif u"macroexpand" == a0sym: - return macroexpand(ast[1], env) - elif u"try*" == a0sym: - 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 - elif len(ast) > 1: - eval_ast(ast.slice2(1, len(ast)-1), 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: - el = eval_ast(ast, env) - f = el.values[0] - if isinstance(f, MalFunc): - if f.ast: - ast = f.ast - env = f.gen_env(el.rest()) # Continue loop (TCO) - else: - return f.apply(el.rest()) - 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) \")\")))))", 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 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/rpython/stepA_mal.py b/rpython/stepA_mal.py deleted file mode 100644 index 68a9960798..0000000000 --- a/rpython/stepA_mal.py +++ /dev/null @@ -1,231 +0,0 @@ -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, - 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 is_pair(x): - return types._sequential_Q(x) and len(x) > 0 - -def quasiquote(ast): - if not is_pair(ast): - return _list(_symbol(u"quote"), ast) - else: - a0 = ast[0] - if isinstance(a0, MalSym): - if a0.value == u'unquote': - return ast[1] - if is_pair(a0) and isinstance(a0[0], MalSym): - a00 = a0[0] - if (isinstance(a00, MalSym) and - a00.value == u'splice-unquote'): - return _list(_symbol(u"concat"), - a0[1], - quasiquote(ast.rest())) - return _list(_symbol(u"cons"), - quasiquote(a0), - quasiquote(ast.rest())) - -def is_macro_call(ast, env): - if types._list_Q(ast): - a0 = ast[0] - if isinstance(a0, MalSym): - if not env.find(a0) is None: - return env.get(a0).ismacro - return False - -def macroexpand(ast, env): - while is_macro_call(ast, env): - assert isinstance(ast[0], MalSym) - mac = env.get(ast[0]) - ast = macroexpand(mac.apply(ast.rest()), env) - return ast - -def eval_ast(ast, env): - if types._symbol_Q(ast): - assert isinstance(ast, MalSym) - return env.get(ast) - elif types._list_Q(ast): - res = [] - for a in ast.values: - res.append(EVAL(a, env)) - return MalList(res) - 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) - 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 eval_ast(ast, env) - 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) - func.ismacro = True - return env.set(ast[1], func) - elif u"macroexpand" == a0sym: - return macroexpand(ast[1], env) - elif u"try*" == a0sym: - 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 - elif len(ast) > 1: - eval_ast(ast.slice2(1, len(ast)-1), 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: - el = eval_ast(ast, env) - f = el.values[0] - if isinstance(f, MalFunc): - if f.ast: - ast = f.ast - env = f.gen_env(el.rest()) # Continue loop (TCO) - else: - return f.apply(el.rest()) - 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) \")\")))))", 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! *gensym-counter* (atom 0))", repl_env) - REP("(def! gensym (fn* [] (symbol (str \"G__\" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))", repl_env) - 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)))))))))", 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/ruby/Dockerfile b/ruby/Dockerfile deleted file mode 100644 index 3bda3bf706..0000000000 --- a/ruby/Dockerfile +++ /dev/null @@ -1,24 +0,0 @@ -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 -########################################################## - -RUN apt-get -y install ruby diff --git a/ruby/Makefile b/ruby/Makefile deleted file mode 100644 index c677e1a237..0000000000 --- a/ruby/Makefile +++ /dev/null @@ -1,36 +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: - 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 - -.PHONY: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*#|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*#|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" - -tests: $(TESTS) - -$(TESTS): - @echo "Running $@"; \ - ruby $@ || exit 1; \ diff --git a/ruby/core.rb b/ruby/core.rb deleted file mode 100644 index 0b68c4a284..0000000000 --- a/ruby/core.rb +++ /dev/null @@ -1,69 +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}, - :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| "\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(:+) || [])}, - :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/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/reader.rb b/ruby/reader.rb deleted file mode 100644 index 1e601744e1..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) # trim and unescape - return t[1..-2].gsub(/\\"/, '"').gsub(/\\n/, "\n").gsub(/\\\\/, "\\") -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/run b/ruby/run deleted file mode 100755 index 000320bf5f..0000000000 --- a/ruby/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec ruby $(dirname $0)/${STEP:-stepA_mal}.rb "${@}" diff --git a/ruby/step2_eval.rb b/ruby/step2_eval.rb deleted file mode 100644 index c1e9d8c64b..0000000000 --- a/ruby/step2_eval.rb +++ /dev/null @@ -1,68 +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 - if ast.empty? - return ast - 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 9cf2abd4f2..0000000000 --- a/ruby/step3_env.rb +++ /dev/null @@ -1,80 +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 - if ast.empty? - return ast - 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 a85872da6c..0000000000 --- a/ruby/step4_if_fn_do.rb +++ /dev/null @@ -1,98 +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 - if ast.empty? - return ast - 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, List.new(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 a6a82d46da..0000000000 --- a/ruby/step5_tco.rb +++ /dev/null @@ -1,108 +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 - if ast.empty? - return ast - 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, List.new(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 0f44251ab5..0000000000 --- a/ruby/step6_file.rb +++ /dev/null @@ -1,116 +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 - if ast.empty? - return ast - 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, List.new(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 5cb273722f..0000000000 --- a/ruby/step7_quote.rb +++ /dev/null @@ -1,136 +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 - if ast.empty? - return ast - 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, List.new(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 e29e1e093f..0000000000 --- a/ruby/step8_macros.rb +++ /dev/null @@ -1,165 +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) - if not ast.is_a? List - return eval_ast(ast, env) - end - if ast.empty? - return ast - end - - 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, List.new(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 828f8c15ba..0000000000 --- a/ruby/step9_try.rb +++ /dev/null @@ -1,180 +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) - if not ast.is_a? List - return eval_ast(ast, env) - end - if ast.empty? - return ast - end - - 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, List.new(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 54a660cc40..0000000000 --- a/ruby/stepA_mal.rb +++ /dev/null @@ -1,190 +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) - if not ast.is_a? List - return eval_ast(ast, env) - end - if ast.empty? - return ast - end - - 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, List.new(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["(def! *gensym-counter* (atom 0))"] -RE["(def! gensym (fn* [] (symbol (str \"G__\" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))"] -RE["(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 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/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 71ff268d10..e470b7c15e 100755 --- a/runtest.py +++ b/runtest.py @@ -13,6 +13,7 @@ IS_PY_3 = sys.version_info[0] == 3 +verbose = 0 debug_file = None log_file = None @@ -21,20 +22,24 @@ def debug(data): debug_file.write(data) debug_file.flush() -def log(data, end='\n'): +def log(data, verbosity=0, end='\n'): if log_file: log_file.write(data + end) log_file.flush() - print(data, end=end) - sys.stdout.flush() + if verbose >= verbosity: + print(data, end=end) + sys.stdout.flush() -# TODO: do we need to support '\n' too -sep = "\r\n" -#sep = "\n" +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, @@ -48,9 +53,11 @@ def log(data, end='\n'): 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 interaction the named file") + help="Write all test interactions to the named file") parser.add_argument('--hard', action='store_true', - help="Turn soft tests following a ';>>> soft=True' into hard failures") + 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', @@ -64,14 +71,16 @@ def log(data, end='\n'): 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, no_pty=False): + def __init__(self, args, no_pty=False, line_break="\n"): #print "args: %s" % repr(args) self.no_pty = no_pty @@ -114,25 +123,30 @@ def __init__(self, args, no_pty=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) - new_data = new_data.decode("utf-8") if IS_PY_3 else new_data - #print("new_data: '%s'" % 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) - if self.no_pty: - self.buf += new_data.replace("\n", "\r\n") - else: - self.buf += 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 @@ -140,9 +154,11 @@ def read_to_prompt(self, prompts, timeout): def writeline(self, str): def _to_bytes(s): - return bytes(s, "utf-8") if IS_PY_3 else s + return bytes(s, "latin1") if IS_PY_3 else s - self.stdin.write(_to_bytes(str + "\n")) + 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" @@ -156,7 +172,8 @@ def cleanup(self): class TestReader: def __init__(self, test_file): self.line_num = 0 - self.data = test_file.read().split('\n') + 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 @@ -190,8 +207,7 @@ def next(self): return True continue elif line[0:1] == ";": # unexpected comment - log("Test data error at line %d:\n%s" % (self.line_num, line)) - return None + 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 @@ -202,18 +218,23 @@ def next(self): self.line_num += 1 self.data.pop(0) break - elif line[0:2] == "; ": + elif line[0:2] == ";/": self.out = self.out + line[2:] + sep self.line_num += 1 self.data.pop(0) else: - self.ret = "*" + self.ret = "" break - if 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:]) +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:] @@ -223,7 +244,7 @@ def next(self): 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) +r = Runner(args.mal_cmd, no_pty=args.no_pty, line_break="\r\n" if args.crlf else "\n") t = TestReader(args.test_file) @@ -232,27 +253,41 @@ def assert_prompt(runner, prompts, timeout): header = runner.read_to_prompt(prompts, timeout=timeout) if not header == None: if header: - log("Started with:\n%s" % header) + vvlog("Started with:\n%s" % header) else: - log("Did not one of following prompt(s): %s" % repr(prompts)) + 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(r, ['user> ', 'mal-user> '], 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 = "" + +class TestTimeout(Exception): + pass while t.next(): if args.deferrable == False and t.deferrable: @@ -264,49 +299,69 @@ def assert_prompt(runner, prompts, timeout): break if t.msg != None: - log(t.msg) + # omit blank test lines unless verbose + if verbose or t.msg: + log(t.msg) continue if t.form == None: continue - log("TEST: %s -> [%s,%s]" % (t.form, repr(t.out), t.ret), end='') + 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 - expected = ["%s%s%s%s" % (t.form, sep, t.out, t.ret), - "%s%s%s%s%s%s" % (t.form, sep, t.form, sep, t.out, t.ret)] + 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: test_cnt += 1 - res = r.read_to_prompt(['\r\nuser> ', '\nuser> ', - '\r\nmal-user> ', '\nmal-user> '], + 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 t.ret == "*" or res in expected: - log(" -> 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: - if t.soft and not args.hard: - log(" -> SOFT FAIL (line %d):" % t.line_num) + 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 " + fail_type = "SOFT FAILED" else: - log(" -> FAIL (line %d):" % t.line_num) + vlog(" -> FAIL:") fail_cnt += 1 - fail_type = "" - log(" Expected : %s" % repr(expected[0])) - log(" Got : %s" % repr(res)) - failed_test = """%sFAILED TEST (line %d): %s -> [%s,%s]: - Expected : %s - Got : %s""" % (fail_type, t.line_num, t.form, repr(t.out), t.ret, repr(expected[0]), repr(res)) + 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: _, exc, _ = sys.exc_info() log("\nException: %s" % repr(exc)) log("Output before exception:\n%s" % r.buf) - sys.exit(1) + break if len(failures) > 0: log("\nFAILURES:") @@ -318,9 +373,10 @@ def assert_prompt(runner, prompts, timeout): %3d: soft failing tests %3d: failing tests %3d: passing tests - %3d: total tests -""" % (args.test_file.name, soft_fail_cnt, fail_cnt, - pass_cnt, test_cnt) + %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 diff --git a/rust/Cargo.toml b/rust/Cargo.toml deleted file mode 100644 index 70e24d3beb..0000000000 --- a/rust/Cargo.toml +++ /dev/null @@ -1,11 +0,0 @@ -[package] - -name = "mal" -version = "0.0.1" -authors = [ "Your name " ] - -[dependencies] -time = "0.1" -regex = "0.1" -libc = "0.1" -num = "*" diff --git a/rust/Dockerfile b/rust/Dockerfile deleted file mode 100644 index 2fc5bb72c9..0000000000 --- a/rust/Dockerfile +++ /dev/null @@ -1,35 +0,0 @@ -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++ - -RUN apt-get -y install pkg-config - -# rust install script requirements -RUN apt-get -y install git sudo - -ENV MULTIRUST_HOME /opt/multirust -RUN curl -sf https://raw.githubusercontent.com/brson/multirust/master/blastoff.sh > /tmp/blastoff.sh && chmod +x /tmp/blastoff.sh && /tmp/blastoff.sh --yes && rm /tmp/blastoff.sh - -ENV CARGO_HOME /tmp/.cargo diff --git a/rust/Makefile b/rust/Makefile deleted file mode 100644 index cb2d4326b5..0000000000 --- a/rust/Makefile +++ /dev/null @@ -1,40 +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/bin/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: $(BINS) - -dist: mal - -mal: target/release/stepA_mal - cp $< $@ - -# TODO: would be nice to build just the step requested -$(BINS): target/release/%: src/bin/%.rs $(wildcard src/*.rs) - cargo build --release - -clean: - cargo clean - rm -f mal - -.PHONY: stats stats-lisp mal - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" diff --git a/rust/run b/rust/run deleted file mode 100755 index 06764851ce..0000000000 --- a/rust/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec $(dirname $0)/target/release/${STEP:-stepA_mal} "${@}" diff --git a/rust/src/bin/step0_repl.rs b/rust/src/bin/step0_repl.rs deleted file mode 100644 index ba5f5fe08b..0000000000 --- a/rust/src/bin/step0_repl.rs +++ /dev/null @@ -1,26 +0,0 @@ -extern crate mal; - -use mal::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 = readline::mal_readline("user> "); - match line { None => break, _ => () } - println!("{}", print(eval(read(line.unwrap())))); - } -} diff --git a/rust/src/bin/step1_read_print.rs b/rust/src/bin/step1_read_print.rs deleted file mode 100644 index 02b2da7bf8..0000000000 --- a/rust/src/bin/step1_read_print.rs +++ /dev/null @@ -1,39 +0,0 @@ -extern crate mal; - -use mal::types::{MalVal, MalRet, MalError}; -use mal::types::MalError::{ErrString, ErrMalVal}; -use mal::{readline, reader}; - -// 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: &str) -> Result { - let ast = try!(read(str.to_string())); - //println!("read: {}", ast); - let exp = try!(eval(ast)); - 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/bin/step2_eval.rs b/rust/src/bin/step2_eval.rs deleted file mode 100644 index c807e3d73c..0000000000 --- a/rust/src/bin/step2_eval.rs +++ /dev/null @@ -1,114 +0,0 @@ -extern crate mal; - -use std::collections::HashMap; - -use mal::types::{MalVal, MalRet, MalError, err_str, err_string}; -use mal::types::{list, vector, hash_map, _int, func}; -use mal::types::MalError::{ErrString, ErrMalVal}; -use mal::types::MalType::{Sym, List, Vector, Hash_Map, Int}; -use mal::{readline, reader}; - -// 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.get(sym) { - Some(mv) => Ok(mv.clone()), - //None => Ok(_nil()), - None => err_string(format!("'{}' not found", sym)), - } - }, - List(ref a,_) | Vector(ref a,_) => { - let mut ast_vec : Vec = vec![]; - for mv in a.iter() { - let mv2 = mv.clone(); - ast_vec.push(try!(eval(mv2, env))); - } - 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() { - new_hm.insert(key.to_string(), - try!(eval(value.clone(), env))); - } - Ok(hash_map(new_hm)) - } - _ => Ok(ast.clone()), - } -} - -fn eval(ast: MalVal, env: &HashMap) -> MalRet { - //println!("eval: {}", ast); - match *ast { - List(_,_) => (), // continue - _ => return eval_ast(ast, env), - } - - // apply list - match *try!(eval_ast(ast, env)) { - List(ref args,_) => { - match args.len() { - 0 => - Ok(list(vec![])), - _ => { - let ref f = args.clone()[0]; - f.apply(args[1..].to_vec()) - } - } - }, - _ => return err_str("Expected list"), - } -} - -// print -fn print(exp: MalVal) -> String { - exp.pr_str(true) -} - -fn rep(str: &str, env: &HashMap) -> Result { - let ast = try!(read(str.to_string())); - //println!("read: {}", ast); - let exp = try!(eval(ast, env)); - Ok(print(exp)) -} - -fn int_op(f: F, a:Vec) -> MalRet - where F: FnOnce(isize, isize) -> isize -{ - 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(), &repl_env) { - Ok(str) => println!("{}", str), - Err(ErrMalVal(_)) => (), // Blank line - Err(ErrString(s)) => println!("Error: {}", s), - } - } -} diff --git a/rust/src/bin/step3_env.rs b/rust/src/bin/step3_env.rs deleted file mode 100644 index afadc178d8..0000000000 --- a/rust/src/bin/step3_env.rs +++ /dev/null @@ -1,165 +0,0 @@ -extern crate mal; - -use std::collections::HashMap; - -use mal::types::{MalVal, MalRet, MalError, err_str}; -use mal::types::{symbol, _int, list, vector, hash_map, func}; -use mal::types::MalError::{ErrString, ErrMalVal}; -use mal::types::MalType::{Int, Sym, List, Vector, Hash_Map}; -use mal::{readline, reader}; -use mal::env::{Env, env_new, env_set, env_get}; - - -// read -fn read(str: String) -> MalRet { - reader::read_str(str) -} - -// eval -fn eval_ast(ast: MalVal, env: Env) -> MalRet { - match *ast { - Sym(_) => env_get(&env, &ast), - List(ref a,_) | Vector(ref a,_) => { - let mut ast_vec : Vec = vec![]; - for mv in a.iter() { - let mv2 = mv.clone(); - ast_vec.push(try!(eval(mv2, env.clone()))); - } - 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() { - new_hm.insert(key.to_string(), - try!(eval(value.clone(), env.clone()))); - } - Ok(hash_map(new_hm)) - } - _ => Ok(ast.clone()), - } -} - -fn eval(ast: MalVal, env: Env) -> MalRet { - //println!("eval: {}, {}", ast, env.borrow()); - //println!("eval: {}", ast); - match *ast { - List(_,_) => (), // continue - _ => return eval_ast(ast, env), - } - - // apply list - match *ast { - List(_,_) => (), // continue - _ => return Ok(ast), - } - - let tmp = ast; - let (args, a0sym) = match *tmp { - List(ref args,_) => { - if args.len() == 0 { - return Ok(tmp.clone()); - } - let ref a0 = *args[0]; - match *a0 { - Sym(ref a0sym) => (args, &a0sym[..]), - _ => (args, "____"), - } - }, - _ => return err_str("Expected list"), - }; - - match a0sym { - "def!" => { - let a1 = (*args)[1].clone(); - let a2 = (*args)[2].clone(); - let r = try!(eval(a2, env.clone())); - match *a1 { - Sym(_) => { - env_set(&env.clone(), a1, r.clone()); - return Ok(r); - }, - _ => return err_str("def! of non-symbol"), - } - }, - "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(_) => { - let r = try!(eval(exp.clone(), let_env.clone())); - env_set(&let_env, b.clone(), r); - }, - _ => return err_str("let* with non-symbol binding"), - } - } - }, - _ => return err_str("let* with non-list bindings"), - } - return eval(a2, let_env.clone()); - }, - _ => { // function call - let el = try!(eval_ast(tmp.clone(), env.clone())); - let args = match *el { - List(ref args,_) => args, - _ => return err_str("Invalid apply"), - }; - let ref f = args.clone()[0]; - f.apply(args[1..].to_vec()) - }, - } -} - -// print -fn print(exp: MalVal) -> String { - exp.pr_str(true) -} - -fn rep(str: &str, env: Env) -> Result { - let ast = try!(read(str.to_string())); - //println!("read: {}", ast); - let exp = try!(eval(ast, env)); - Ok(print(exp)) -} - -fn int_op(f: F, a:Vec) -> MalRet - where F: FnOnce(isize, isize) -> isize -{ - 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)); - - // repl loop - loop { - let line = readline::mal_readline("user> "); - match line { None => break, _ => () } - match rep(&line.unwrap(), repl_env.clone()) { - Ok(str) => println!("{}", str), - Err(ErrMalVal(_)) => (), // Blank line - Err(ErrString(s)) => println!("Error: {}", s), - } - } -} diff --git a/rust/src/bin/step4_if_fn_do.rs b/rust/src/bin/step4_if_fn_do.rs deleted file mode 100644 index 2be0f6bd11..0000000000 --- a/rust/src/bin/step4_if_fn_do.rs +++ /dev/null @@ -1,185 +0,0 @@ -extern crate mal; - -use std::collections::HashMap; - -use mal::types::{MalVal, MalRet, MalError, err_str}; -use mal::types::{symbol, _nil, list, vector, hash_map, malfunc}; -use mal::types::MalError::{ErrString, ErrMalVal}; -use mal::types::MalType::{Nil, False, Sym, List, Vector, Hash_Map}; -use mal::{readline, reader, core}; -use mal::env::{env_set, env_get, env_new, Env}; - - -// read -fn read(str: String) -> MalRet { - reader::read_str(str) -} - -// eval -fn eval_ast(ast: MalVal, env: Env) -> MalRet { - match *ast { - Sym(_) => env_get(&env, &ast), - List(ref a,_) | Vector(ref a,_) => { - let mut ast_vec : Vec = vec![]; - for mv in a.iter() { - let mv2 = mv.clone(); - ast_vec.push(try!(eval(mv2, env.clone()))); - } - 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() { - new_hm.insert(key.to_string(), - try!(eval(value.clone(), env.clone()))); - } - Ok(hash_map(new_hm)) - } - _ => Ok(ast.clone()), - } -} - -fn eval(ast: MalVal, env: Env) -> MalRet { - //println!("eval: {}, {}", ast, env.borrow()); - //println!("eval: {}", ast); - match *ast { - List(_,_) => (), // continue - _ => return eval_ast(ast, env), - } - - // apply list - match *ast { - List(_,_) => (), // continue - _ => return Ok(ast), - } - - let tmp = ast; - let (args, a0sym) = match *tmp { - List(ref args,_) => { - if args.len() == 0 { - return Ok(tmp.clone()); - } - let ref a0 = *args[0]; - match *a0 { - Sym(ref a0sym) => (args, &a0sym[..]), - _ => (args, "____"), - } - }, - _ => return err_str("Expected list"), - }; - - match a0sym { - "def!" => { - let a1 = (*args)[1].clone(); - let a2 = (*args)[2].clone(); - let r = try!(eval(a2, env.clone())); - match *a1 { - Sym(_) => { - env_set(&env.clone(), a1, r.clone()); - return Ok(r); - }, - _ => return err_str("def! of non-symbol"), - } - }, - "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(_) => { - let r = try!(eval(exp.clone(), let_env.clone())); - env_set(&let_env, b.clone(), r); - }, - _ => 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[1..].to_vec()); - match *try!(eval_ast(el, env.clone())) { - 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 c = try!(eval(a1, env.clone())); - 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, a1, _nil())); - }, - _ => { // function call - let el = try!(eval_ast(tmp.clone(), env.clone())); - let args = match *el { - List(ref args,_) => args, - _ => return err_str("Invalid apply"), - }; - let ref f = args.clone()[0]; - f.apply(args[1..].to_vec()) - }, - } -} - -// print -fn print(exp: MalVal) -> String { - exp.pr_str(true) -} - -fn rep(str: &str, env: Env) -> Result { - let ast = try!(read(str.to_string())); - //println!("read: {}", ast); - let exp = try!(eval(ast, env)); - 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), v); - } - - // core.mal: defined using the language itself - let _ = rep("(def! not (fn* (a) (if a false true)))", repl_env.clone()); - - // repl loop - loop { - let line = readline::mal_readline("user> "); - match line { None => break, _ => () } - match rep(&line.unwrap(), repl_env.clone()) { - Ok(str) => println!("{}", str), - Err(ErrMalVal(_)) => (), // Blank line - Err(ErrString(s)) => println!("Error: {}", s), - } - } -} diff --git a/rust/src/bin/step5_tco.rs b/rust/src/bin/step5_tco.rs deleted file mode 100644 index 9a2a4ced0e..0000000000 --- a/rust/src/bin/step5_tco.rs +++ /dev/null @@ -1,202 +0,0 @@ -extern crate mal; - -use std::collections::HashMap; - -use mal::types::{MalVal, MalRet, MalError, err_str}; -use mal::types::{symbol, _nil, list, vector, hash_map, malfunc}; -use mal::types::MalError::{ErrString, ErrMalVal}; -use mal::types::MalType::{Nil, False, Sym, List, Vector, Hash_Map, Func, MalFunc}; -use mal::{readline, reader, core}; -use mal::env::{env_set, env_get, env_new, env_bind, Env}; - - -// read -fn read(str: String) -> MalRet { - reader::read_str(str) -} - -// eval -fn eval_ast(ast: MalVal, env: Env) -> MalRet { - match *ast { - Sym(_) => env_get(&env, &ast), - List(ref a,_) | Vector(ref a,_) => { - let mut ast_vec : Vec = vec![]; - for mv in a.iter() { - let mv2 = mv.clone(); - ast_vec.push(try!(eval(mv2, env.clone()))); - } - 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() { - new_hm.insert(key.to_string(), - try!(eval(value.clone(), env.clone()))); - } - Ok(hash_map(new_hm)) - } - _ => Ok(ast.clone()), - } -} - -fn eval(mut ast: MalVal, mut env: Env) -> MalRet { - 'tco: loop { - - //println!("eval: {}, {}", ast, env.borrow()); - //println!("eval: {}", ast); - match *ast { - List(_,_) => (), // continue - _ => return eval_ast(ast, env), - } - - // apply list - match *ast { - List(_,_) => (), // continue - _ => return Ok(ast), - } - - let tmp = ast; - let (args, a0sym) = match *tmp { - List(ref args,_) => { - if args.len() == 0 { - return Ok(tmp.clone()); - } - let ref a0 = *args[0]; - match *a0 { - Sym(ref a0sym) => (args, &a0sym[..]), - _ => (args, "____"), - } - }, - _ => return err_str("Expected list"), - }; - - match a0sym { - "def!" => { - let a1 = (*args)[1].clone(); - let a2 = (*args)[2].clone(); - let r = try!(eval(a2, env.clone())); - match *a1 { - Sym(_) => { - env_set(&env.clone(), a1, r.clone()); - return Ok(r); - }, - _ => return err_str("def! of non-symbol"), - } - }, - "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(_) => { - let r = try!(eval(exp.clone(), let_env.clone())); - env_set(&let_env, b.clone(), r); - }, - _ => 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[1..args.len()-1].to_vec()); - try!(eval_ast(el, env.clone())); - ast = args[args.len() - 1].clone(); - continue 'tco; - }, - "if" => { - let a1 = (*args)[1].clone(); - let c = try!(eval(a1, env.clone())); - match *c { - False | Nil => { - if args.len() >= 4 { - ast = args[3].clone(); - continue 'tco; - } else { - return Ok(_nil()); - } - }, - _ => { - ast = args[2].clone(); - continue 'tco; - }, - } - }, - "fn*" => { - let a1 = args[1].clone(); - let a2 = args[2].clone(); - return Ok(malfunc(eval, a2, env, a1, _nil())); - }, - _ => { // function call - let el = try!(eval_ast(tmp.clone(), env.clone())); - let args = match *el { - List(ref args,_) => args, - _ => return err_str("Invalid apply"), - }; - return match *args.clone()[0] { - Func(f,_) => f(args[1..].to_vec()), - MalFunc(ref mf,_) => { - let mfc = mf.clone(); - let alst = list(args[1..].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), - } - }, - _ => err_str("attempt to call non-function"), - } - }, - } - - } -} - -// print -fn print(exp: MalVal) -> String { - exp.pr_str(true) -} - -fn rep(str: &str, env: Env) -> Result { - let ast = try!(read(str.to_string())); - //println!("read: {}", ast); - let exp = try!(eval(ast, env)); - 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), v); - } - - // core.mal: defined using the language itself - let _ = rep("(def! not (fn* (a) (if a false true)))", repl_env.clone()); - - // repl loop - loop { - let line = readline::mal_readline("user> "); - match line { None => break, _ => () } - match rep(&line.unwrap(), repl_env.clone()) { - Ok(str) => println!("{}", str), - Err(ErrMalVal(_)) => (), // Blank line - Err(ErrString(s)) => println!("Error: {}", s), - } - } -} diff --git a/rust/src/bin/step6_file.rs b/rust/src/bin/step6_file.rs deleted file mode 100644 index c2f0d57754..0000000000 --- a/rust/src/bin/step6_file.rs +++ /dev/null @@ -1,232 +0,0 @@ - -extern crate mal; - -use std::collections::HashMap; -use std::env as stdenv; -use std::process as process; - -use mal::types::{MalVal, MalRet, MalError, err_str}; -use mal::types::{symbol, _nil, string, list, vector, hash_map, malfunc}; -use mal::types::MalError::{ErrString, ErrMalVal}; -use mal::types::MalType::{Nil, False, Sym, List, Vector, Hash_Map, Func, MalFunc}; -use mal::{readline, reader, core}; -use mal::env::{env_set, env_get, env_new, env_bind, env_root, Env}; - - -// read -fn read(str: String) -> MalRet { - reader::read_str(str) -} - -// eval -fn eval_ast(ast: MalVal, env: Env) -> MalRet { - match *ast { - Sym(_) => env_get(&env, &ast), - List(ref a,_) | Vector(ref a,_) => { - let mut ast_vec : Vec = vec![]; - for mv in a.iter() { - let mv2 = mv.clone(); - ast_vec.push(try!(eval(mv2, env.clone()))); - } - 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() { - new_hm.insert(key.to_string(), - try!(eval(value.clone(), env.clone()))); - } - Ok(hash_map(new_hm)) - } - _ => Ok(ast.clone()), - } -} - -fn eval(mut ast: MalVal, mut env: Env) -> MalRet { - 'tco: loop { - - //println!("eval: {}, {}", ast, env.borrow()); - //println!("eval: {}", ast); - match *ast { - List(_,_) => (), // continue - _ => return eval_ast(ast, env), - } - - // apply list - match *ast { - List(_,_) => (), // continue - _ => return Ok(ast), - } - - let tmp = ast; - let (args, a0sym) = match *tmp { - List(ref args,_) => { - if args.len() == 0 { - return Ok(tmp.clone()); - } - let ref a0 = *args[0]; - match *a0 { - Sym(ref a0sym) => (args, &a0sym[..]), - _ => (args, "____"), - } - }, - _ => return err_str("Expected list"), - }; - - match a0sym { - "def!" => { - let a1 = (*args)[1].clone(); - let a2 = (*args)[2].clone(); - let r = try!(eval(a2, env.clone())); - match *a1 { - Sym(_) => { - env_set(&env.clone(), a1, r.clone()); - return Ok(r); - }, - _ => return err_str("def! of non-symbol"), - } - }, - "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(_) => { - let r = try!(eval(exp.clone(), let_env.clone())); - env_set(&let_env, b.clone(), r); - }, - _ => 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[1..args.len()-1].to_vec()); - try!(eval_ast(el, env.clone())); - ast = args[args.len() - 1].clone(); - continue 'tco; - }, - "if" => { - let a1 = (*args)[1].clone(); - let c = try!(eval(a1, env.clone())); - match *c { - False | Nil => { - if args.len() >= 4 { - ast = args[3].clone(); - continue 'tco; - } else { - return Ok(_nil()); - } - }, - _ => { - ast = args[2].clone(); - continue 'tco; - }, - } - }, - "fn*" => { - let a1 = args[1].clone(); - let a2 = args[2].clone(); - return Ok(malfunc(eval, a2, env, a1, _nil())); - }, - "eval" => { - let a1 = (*args)[1].clone(); - ast = try!(eval(a1, env.clone())); - env = env_root(&env); - continue 'tco; - }, - _ => { // function call - let el = try!(eval_ast(tmp.clone(), env.clone())); - let args = match *el { - List(ref args,_) => args, - _ => return err_str("Invalid apply"), - }; - return match *args.clone()[0] { - Func(f,_) => f(args[1..].to_vec()), - MalFunc(ref mf,_) => { - let mfc = mf.clone(); - let alst = list(args[1..].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), - } - }, - _ => err_str("attempt to call non-function"), - } - }, - } - - } -} - -// print -fn print(exp: MalVal) -> String { - exp.pr_str(true) -} - -fn rep(str: &str, env: Env) -> Result { - let ast = try!(read(str.to_string())); - //println!("read: {}", ast); - let exp = try!(eval(ast, env)); - 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), v); - } - // see eval() for definition of "eval" - env_set(&repl_env, symbol("*ARGV*"), 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 = stdenv::args(); - if args.len() > 1 { - let mv_args = args.skip(2) - .map(|a| string(a)) - .collect::>(); - env_set(&repl_env, symbol("*ARGV*"), list(mv_args)); - let lf = format!("(load-file \"{}\")", - stdenv::args().skip(1).next().unwrap()); - return match rep(&lf, repl_env.clone()) { - Ok(_) => process::exit(0), - Err(str) => { - println!("Error: {:?}", str); - process::exit(1); - } - }; - } - - // repl loop - loop { - let line = readline::mal_readline("user> "); - match line { None => break, _ => () } - match rep(&line.unwrap(), repl_env.clone()) { - Ok(str) => println!("{}", str), - Err(ErrMalVal(_)) => (), // Blank line - Err(ErrString(s)) => println!("Error: {}", s), - } - } -} diff --git a/rust/src/bin/step7_quote.rs b/rust/src/bin/step7_quote.rs deleted file mode 100644 index 7b0788db2d..0000000000 --- a/rust/src/bin/step7_quote.rs +++ /dev/null @@ -1,281 +0,0 @@ - -extern crate mal; - -use std::collections::HashMap; -use std::env as stdenv; -use std::process as process; - -use mal::types::{MalVal, MalRet, MalError, err_str}; -use mal::types::{symbol, _nil, string, list, vector, hash_map, malfunc}; -use mal::types::MalError::{ErrString, ErrMalVal}; -use mal::types::MalType::{Nil, False, Sym, List, Vector, Hash_Map, Func, MalFunc}; -use mal::{readline, reader, core}; -use mal::env::{env_set, env_get, env_new, env_bind, env_root, Env}; - - -// 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 == "unquote" => return args[1].clone(), - _ => (), - } - if is_pair(a0.clone()) { - match **a0 { - List(ref a0args,_) | Vector(ref a0args,_) => { - match *a0args[0] { - Sym(ref s) if *s == "splice-unquote" => { - return list(vec![symbol("concat"), - a0args[1].clone(), - quasiquote(list(args[1..].to_vec()))]) - }, - _ => (), - } - }, - _ => (), - } - } - let rest = list(args[1..].to_vec()); - return list(vec![symbol("cons"), - quasiquote(a0.clone()), - quasiquote(rest)]) - }, - _ => _nil(), // should never reach - } -} - -fn eval_ast(ast: MalVal, env: Env) -> MalRet { - match *ast { - Sym(_) => env_get(&env, &ast), - List(ref a,_) | Vector(ref a,_) => { - let mut ast_vec : Vec = vec![]; - for mv in a.iter() { - let mv2 = mv.clone(); - ast_vec.push(try!(eval(mv2, env.clone()))); - } - 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() { - new_hm.insert(key.to_string(), - try!(eval(value.clone(), env.clone()))); - } - Ok(hash_map(new_hm)) - } - _ => Ok(ast.clone()), - } -} - -fn eval(mut ast: MalVal, mut env: Env) -> MalRet { - 'tco: loop { - - //println!("eval: {}, {}", ast, env.borrow()); - //println!("eval: {}", ast); - match *ast { - List(_,_) => (), // continue - _ => return eval_ast(ast, env), - } - - // apply list - match *ast { - List(_,_) => (), // continue - _ => return Ok(ast), - } - - let tmp = ast; - let (args, a0sym) = match *tmp { - List(ref args,_) => { - if args.len() == 0 { - return Ok(tmp.clone()); - } - let ref a0 = *args[0]; - match *a0 { - Sym(ref a0sym) => (args, &a0sym[..]), - _ => (args, "____"), - } - }, - _ => return err_str("Expected list"), - }; - - match a0sym { - "def!" => { - let a1 = (*args)[1].clone(); - let a2 = (*args)[2].clone(); - let r = try!(eval(a2, env.clone())); - match *a1 { - Sym(_) => { - env_set(&env.clone(), a1, r.clone()); - return Ok(r); - }, - _ => return err_str("def! of non-symbol"), - } - }, - "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(_) => { - let r = try!(eval(exp.clone(), let_env.clone())); - env_set(&let_env, b.clone(), r); - }, - _ => 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[1..args.len()-1].to_vec()); - try!(eval_ast(el, env.clone())); - ast = args[args.len() - 1].clone(); - continue 'tco; - }, - "if" => { - let a1 = (*args)[1].clone(); - let c = try!(eval(a1, env.clone())); - match *c { - False | Nil => { - if args.len() >= 4 { - ast = args[3].clone(); - continue 'tco; - } else { - return Ok(_nil()); - } - }, - _ => { - ast = args[2].clone(); - continue 'tco; - }, - } - }, - "fn*" => { - let a1 = args[1].clone(); - let a2 = args[2].clone(); - return Ok(malfunc(eval, a2, env, a1, _nil())); - }, - "eval" => { - let a1 = (*args)[1].clone(); - ast = try!(eval(a1, env.clone())); - env = env_root(&env); - continue 'tco; - }, - _ => { // function call - let el = try!(eval_ast(tmp.clone(), env.clone())); - let args = match *el { - List(ref args,_) => args, - _ => return err_str("Invalid apply"), - }; - return match *args.clone()[0] { - Func(f,_) => f(args[1..].to_vec()), - MalFunc(ref mf,_) => { - let mfc = mf.clone(); - let alst = list(args[1..].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), - } - }, - _ => err_str("attempt to call non-function"), - } - }, - } - - } -} - -// print -fn print(exp: MalVal) -> String { - exp.pr_str(true) -} - -fn rep(str: &str, env: Env) -> Result { - let ast = try!(read(str.to_string())); - //println!("read: {}", ast); - let exp = try!(eval(ast, env)); - 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), v); - } - // see eval() for definition of "eval" - env_set(&repl_env, symbol("*ARGV*"), 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 = stdenv::args(); - if args.len() > 1 { - let mv_args = args.skip(2) - .map(|a| string(a)) - .collect::>(); - env_set(&repl_env, symbol("*ARGV*"), list(mv_args)); - let lf = format!("(load-file \"{}\")", - stdenv::args().skip(1).next().unwrap()); - return match rep(&lf, repl_env.clone()) { - Ok(_) => process::exit(0), - Err(str) => { - println!("Error: {:?}", str); - process::exit(1); - } - }; - } - - // repl loop - loop { - let line = readline::mal_readline("user> "); - match line { None => break, _ => () } - match rep(&line.unwrap(), repl_env.clone()) { - Ok(str) => println!("{}", str), - Err(ErrMalVal(_)) => (), // Blank line - Err(ErrString(s)) => println!("Error: {}", s), - } - } -} diff --git a/rust/src/bin/step8_macros.rs b/rust/src/bin/step8_macros.rs deleted file mode 100644 index ea52d42b5b..0000000000 --- a/rust/src/bin/step8_macros.rs +++ /dev/null @@ -1,350 +0,0 @@ - -extern crate mal; - -use std::collections::HashMap; -use std::env as stdenv; -use std::process as process; - -use mal::types::{MalVal, MalRet, MalError, err_str}; -use mal::types::{symbol, _nil, string, list, vector, hash_map, malfunc, malfuncd}; -use mal::types::MalError::{ErrString, ErrMalVal}; -use mal::types::MalType::{Nil, False, Sym, List, Vector, Hash_Map, Func, MalFunc}; -use mal::{readline, reader, core}; -use mal::env::{env_set, env_get, env_new, env_bind, env_find, env_root, Env}; - - -// 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 == "unquote" => return args[1].clone(), - _ => (), - } - if is_pair(a0.clone()) { - match **a0 { - List(ref a0args,_) | Vector(ref a0args,_) => { - match *a0args[0] { - Sym(ref s) if *s == "splice-unquote" => { - return list(vec![symbol("concat"), - a0args[1].clone(), - quasiquote(list(args[1..].to_vec()))]) - }, - _ => (), - } - }, - _ => (), - } - } - let rest = list(args[1..].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 { - let lst = match *ast { - List(ref lst,_) => &lst[0], - _ => return false - }; - match **lst { - Sym(_) => {}, - _ => return false - } - if env_find(&env, lst).is_none() { - return false - } - let f = match env_get(&env, lst) { - Ok(f) => f, - _ => return false - }; - match *f { - MalFunc(ref mfd,_) => mfd.is_macro, - _ => 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(_) => try!(env_get(&env, &a0)), - _ => break, - }; - match *mf { - MalFunc(_,_) => ast = try!(mf.apply(args[1..].to_vec())), - _ => break, - } - } - Ok(ast) -} - -fn eval_ast(ast: MalVal, env: Env) -> MalRet { - match *ast { - Sym(_) => env_get(&env, &ast), - List(ref a,_) | Vector(ref a,_) => { - let mut ast_vec : Vec = vec![]; - for mv in a.iter() { - let mv2 = mv.clone(); - ast_vec.push(try!(eval(mv2, env.clone()))); - } - 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() { - new_hm.insert(key.to_string(), - try!(eval(value.clone(), env.clone()))); - } - Ok(hash_map(new_hm)) - } - _ => Ok(ast.clone()), - } -} - -fn eval(mut ast: MalVal, mut env: Env) -> MalRet { - 'tco: loop { - - //println!("eval: {}, {}", ast, env.borrow()); - //println!("eval: {}", ast); - match *ast { - List(_,_) => (), // continue - _ => return eval_ast(ast, env), - } - - // apply list - ast = try!(macroexpand(ast, env.clone())); - match *ast { - List(_,_) => (), // continue - _ => return eval_ast(ast, env), - } - - let tmp = ast; - let (args, a0sym) = match *tmp { - List(ref args,_) => { - if args.len() == 0 { - return Ok(tmp.clone()); - } - let ref a0 = *args[0]; - match *a0 { - Sym(ref a0sym) => (args, &a0sym[..]), - _ => (args, "____"), - } - }, - _ => return err_str("Expected list"), - }; - - match a0sym { - "def!" => { - let a1 = (*args)[1].clone(); - let a2 = (*args)[2].clone(); - let r = try!(eval(a2, env.clone())); - match *a1 { - Sym(_) => { - env_set(&env.clone(), a1, r.clone()); - return Ok(r); - }, - _ => return err_str("def! of non-symbol"), - } - }, - "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(_) => { - let r = try!(eval(exp.clone(), let_env.clone())); - env_set(&let_env, b.clone(), r); - }, - _ => 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(); - let r = try!(eval(a2, env.clone())); - 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"), - } - }, - "macroexpand" => { - let a1 = (*args)[1].clone(); - return macroexpand(a1, env.clone()) - }, - "do" => { - let el = list(args[1..args.len()-1].to_vec()); - try!(eval_ast(el, env.clone())); - ast = args[args.len() - 1].clone(); - continue 'tco; - }, - "if" => { - let a1 = (*args)[1].clone(); - let c = try!(eval(a1, env.clone())); - match *c { - False | Nil => { - if args.len() >= 4 { - ast = args[3].clone(); - continue 'tco; - } else { - return Ok(_nil()); - } - }, - _ => { - ast = args[2].clone(); - continue 'tco; - }, - } - }, - "fn*" => { - let a1 = args[1].clone(); - let a2 = args[2].clone(); - return Ok(malfunc(eval, a2, env, a1, _nil())); - }, - "eval" => { - let a1 = (*args)[1].clone(); - ast = try!(eval(a1, env.clone())); - env = env_root(&env); - continue 'tco; - }, - _ => { // function call - let el = try!(eval_ast(tmp.clone(), env.clone())); - let args = match *el { - List(ref args,_) => args, - _ => return err_str("Invalid apply"), - }; - return match *args.clone()[0] { - Func(f,_) => f(args[1..].to_vec()), - MalFunc(ref mf,_) => { - let mfc = mf.clone(); - let alst = list(args[1..].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), - } - }, - _ => err_str("attempt to call non-function"), - } - }, - } - - } -} - -// print -fn print(exp: MalVal) -> String { - exp.pr_str(true) -} - -fn rep(str: &str, env: Env) -> Result { - let ast = try!(read(str.to_string())); - //println!("read: {}", ast); - let exp = try!(eval(ast, env)); - 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), v); - } - // see eval() for definition of "eval" - env_set(&repl_env, symbol("*ARGV*"), 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 = stdenv::args(); - if args.len() > 1 { - let mv_args = args.skip(2) - .map(|a| string(a)) - .collect::>(); - env_set(&repl_env, symbol("*ARGV*"), list(mv_args)); - let lf = format!("(load-file \"{}\")", - stdenv::args().skip(1).next().unwrap()); - return match rep(&lf, repl_env.clone()) { - Ok(_) => process::exit(0), - Err(str) => { - println!("Error: {:?}", str); - process::exit(1); - } - }; - } - - // repl loop - loop { - let line = readline::mal_readline("user> "); - match line { None => break, _ => () } - match rep(&line.unwrap(), repl_env.clone()) { - Ok(str) => println!("{}", str), - Err(ErrMalVal(_)) => (), // Blank line - Err(ErrString(s)) => println!("Error: {}", s), - } - } -} diff --git a/rust/src/bin/step9_try.rs b/rust/src/bin/step9_try.rs deleted file mode 100644 index 10a70b0157..0000000000 --- a/rust/src/bin/step9_try.rs +++ /dev/null @@ -1,380 +0,0 @@ - -extern crate mal; - -use std::collections::HashMap; -use std::env as stdenv; -use std::process as process; - -use mal::types::{MalVal, MalRet, MalError, err_str}; -use mal::types::{symbol, _nil, string, list, vector, hash_map, malfunc, malfuncd}; -use mal::types::MalError::{ErrString, ErrMalVal}; -use mal::types::MalType::{Nil, False, Sym, List, Vector, Hash_Map, Func, MalFunc}; -use mal::{readline, reader, core}; -use mal::env::{env_set, env_get, env_new, env_bind, env_find, env_root, Env}; - - -// 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 == "unquote" => return args[1].clone(), - _ => (), - } - if is_pair(a0.clone()) { - match **a0 { - List(ref a0args,_) | Vector(ref a0args,_) => { - match *a0args[0] { - Sym(ref s) if *s == "splice-unquote" => { - return list(vec![symbol("concat"), - a0args[1].clone(), - quasiquote(list(args[1..].to_vec()))]) - }, - _ => (), - } - }, - _ => (), - } - } - let rest = list(args[1..].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 { - let lst = match *ast { - List(ref lst,_) => &lst[0], - _ => return false - }; - match **lst { - Sym(_) => {}, - _ => return false - } - if env_find(&env, lst).is_none() { - return false - } - let f = match env_get(&env, lst) { - Ok(f) => f, - _ => return false - }; - match *f { - MalFunc(ref mfd,_) => mfd.is_macro, - _ => 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(_) => try!(env_get(&env, &a0)), - _ => break, - }; - match *mf { - MalFunc(_,_) => ast = try!(mf.apply(args[1..].to_vec())), - _ => break, - } - } - Ok(ast) -} - -fn eval_ast(ast: MalVal, env: Env) -> MalRet { - match *ast { - Sym(_) => env_get(&env, &ast), - List(ref a,_) | Vector(ref a,_) => { - let mut ast_vec : Vec = vec![]; - for mv in a.iter() { - let mv2 = mv.clone(); - ast_vec.push(try!(eval(mv2, env.clone()))); - } - 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() { - new_hm.insert(key.to_string(), - try!(eval(value.clone(), env.clone()))); - } - Ok(hash_map(new_hm)) - } - _ => Ok(ast.clone()), - } -} - -fn eval(mut ast: MalVal, mut env: Env) -> MalRet { - 'tco: loop { - - //println!("eval: {}, {}", ast, env.borrow()); - //println!("eval: {}", ast); - match *ast { - List(_,_) => (), // continue - _ => return eval_ast(ast, env), - } - - // apply list - ast = try!(macroexpand(ast, env.clone())); - match *ast { - List(_,_) => (), // continue - _ => return eval_ast(ast, env), - } - - let tmp = ast; - let (args, a0sym) = match *tmp { - List(ref args,_) => { - if args.len() == 0 { - return Ok(tmp.clone()); - } - let ref a0 = *args[0]; - match *a0 { - Sym(ref a0sym) => (args, &a0sym[..]), - _ => (args, "____"), - } - }, - _ => return err_str("Expected list"), - }; - - match a0sym { - "def!" => { - let a1 = (*args)[1].clone(); - let a2 = (*args)[2].clone(); - let r = try!(eval(a2, env.clone())); - match *a1 { - Sym(_) => { - env_set(&env.clone(), a1, r.clone()); - return Ok(r); - }, - _ => return err_str("def! of non-symbol"), - } - }, - "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(_) => { - let r = try!(eval(exp.clone(), let_env.clone())); - env_set(&let_env, b.clone(), r); - }, - _ => 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(); - let r = try!(eval(a2, env.clone())); - 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"), - } - }, - "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[1..args.len()-1].to_vec()); - try!(eval_ast(el, env.clone())); - ast = args[args.len() - 1].clone(); - continue 'tco; - }, - "if" => { - let a1 = (*args)[1].clone(); - let c = try!(eval(a1, env.clone())); - match *c { - False | Nil => { - if args.len() >= 4 { - ast = args[3].clone(); - continue 'tco; - } else { - return Ok(_nil()); - } - }, - _ => { - ast = args[2].clone(); - continue 'tco; - }, - } - }, - "fn*" => { - let a1 = args[1].clone(); - let a2 = args[2].clone(); - return Ok(malfunc(eval, a2, env, a1, _nil())); - }, - "eval" => { - let a1 = (*args)[1].clone(); - ast = try!(eval(a1, env.clone())); - env = env_root(&env); - continue 'tco; - }, - _ => { // function call - let el = try!(eval_ast(tmp.clone(), env.clone())); - let args = match *el { - List(ref args,_) => args, - _ => return err_str("Invalid apply"), - }; - return match *args.clone()[0] { - Func(f,_) => f(args[1..].to_vec()), - MalFunc(ref mf,_) => { - let mfc = mf.clone(); - let alst = list(args[1..].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), - } - }, - _ => err_str("attempt to call non-function"), - } - }, - } - - } -} - -// print -fn print(exp: MalVal) -> String { - exp.pr_str(true) -} - -fn rep(str: &str, env: Env) -> Result { - let ast = try!(read(str.to_string())); - //println!("read: {}", ast); - let exp = try!(eval(ast, env)); - 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), v); - } - // see eval() for definition of "eval" - env_set(&repl_env, symbol("*ARGV*"), 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 = stdenv::args(); - if args.len() > 1 { - let mv_args = args.skip(2) - .map(|a| string(a)) - .collect::>(); - env_set(&repl_env, symbol("*ARGV*"), list(mv_args)); - let lf = format!("(load-file \"{}\")", - stdenv::args().skip(1).next().unwrap()); - return match rep(&lf, repl_env.clone()) { - Ok(_) => process::exit(0), - Err(str) => { - println!("Error: {:?}", str); - process::exit(1); - } - }; - } - - // repl loop - loop { - let line = readline::mal_readline("user> "); - match line { None => break, _ => () } - match rep(&line.unwrap(), repl_env.clone()) { - Ok(str) => println!("{}", str), - Err(ErrMalVal(_)) => (), // Blank line - Err(ErrString(s)) => println!("Error: {}", s), - } - } -} diff --git a/rust/src/bin/stepA_mal.rs b/rust/src/bin/stepA_mal.rs deleted file mode 100644 index 59b966e5a4..0000000000 --- a/rust/src/bin/stepA_mal.rs +++ /dev/null @@ -1,385 +0,0 @@ -#![allow(non_snake_case)] - -extern crate mal; - -use std::collections::HashMap; -use std::env as stdenv; -use std::process as process; - -use mal::types::{MalVal, MalRet, MalError, err_str}; -use mal::types::{symbol, _nil, string, list, vector, hash_map, malfunc, malfuncd}; -use mal::types::MalError::{ErrString, ErrMalVal}; -use mal::types::MalType::{Nil, False, Sym, List, Vector, Hash_Map, Func, MalFunc}; -use mal::{readline, reader, core}; -use mal::env::{env_set, env_get, env_new, env_bind, env_find, env_root, Env}; - - -// 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 == "unquote" => return args[1].clone(), - _ => (), - } - if is_pair(a0.clone()) { - match **a0 { - List(ref a0args,_) | Vector(ref a0args,_) => { - match *a0args[0] { - Sym(ref s) if *s == "splice-unquote" => { - return list(vec![symbol("concat"), - a0args[1].clone(), - quasiquote(list(args[1..].to_vec()))]) - }, - _ => (), - } - }, - _ => (), - } - } - let rest = list(args[1..].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 { - let lst = match *ast { - List(ref lst,_) => &lst[0], - _ => return false - }; - match **lst { - Sym(_) => {}, - _ => return false - } - if env_find(&env, lst).is_none() { - return false - } - let f = match env_get(&env, lst) { - Ok(f) => f, - _ => return false - }; - match *f { - MalFunc(ref mfd,_) => mfd.is_macro, - _ => 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(_) => try!(env_get(&env, &a0)), - _ => break, - }; - match *mf { - MalFunc(_,_) => ast = try!(mf.apply(args[1..].to_vec())), - _ => break, - } - } - Ok(ast) -} - -fn eval_ast(ast: MalVal, env: Env) -> MalRet { - match *ast { - Sym(_) => env_get(&env, &ast), - List(ref a,_) | Vector(ref a,_) => { - let mut ast_vec : Vec = vec![]; - for mv in a.iter() { - let mv2 = mv.clone(); - ast_vec.push(try!(eval(mv2, env.clone()))); - } - 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() { - new_hm.insert(key.to_string(), - try!(eval(value.clone(), env.clone()))); - } - Ok(hash_map(new_hm)) - } - _ => Ok(ast.clone()), - } -} - -fn eval(mut ast: MalVal, mut env: Env) -> MalRet { - 'tco: loop { - - //println!("eval: {}, {}", ast, env.borrow()); - //println!("eval: {}", ast); - match *ast { - List(_,_) => (), // continue - _ => return eval_ast(ast, env), - } - - // apply list - ast = try!(macroexpand(ast, env.clone())); - match *ast { - List(_,_) => (), // continue - _ => return eval_ast(ast, env), - } - - let tmp = ast; - let (args, a0sym) = match *tmp { - List(ref args,_) => { - if args.len() == 0 { - return Ok(tmp.clone()); - } - let ref a0 = *args[0]; - match *a0 { - Sym(ref a0sym) => (args, &a0sym[..]), - _ => (args, "____"), - } - }, - _ => return err_str("Expected list"), - }; - - match a0sym { - "def!" => { - let a1 = (*args)[1].clone(); - let a2 = (*args)[2].clone(); - let r = try!(eval(a2, env.clone())); - match *a1 { - Sym(_) => { - env_set(&env.clone(), a1, r.clone()); - return Ok(r); - }, - _ => return err_str("def! of non-symbol"), - } - }, - "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(_) => { - let r = try!(eval(exp.clone(), let_env.clone())); - env_set(&let_env, b.clone(), r); - }, - _ => 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(); - let r = try!(eval(a2, env.clone())); - 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"), - } - }, - "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[1..args.len()-1].to_vec()); - try!(eval_ast(el, env.clone())); - ast = args[args.len() - 1].clone(); - continue 'tco; - }, - "if" => { - let a1 = (*args)[1].clone(); - let c = try!(eval(a1, env.clone())); - match *c { - False | Nil => { - if args.len() >= 4 { - ast = args[3].clone(); - continue 'tco; - } else { - return Ok(_nil()); - } - }, - _ => { - ast = args[2].clone(); - continue 'tco; - }, - } - }, - "fn*" => { - let a1 = args[1].clone(); - let a2 = args[2].clone(); - return Ok(malfunc(eval, a2, env, a1, _nil())); - }, - "eval" => { - let a1 = (*args)[1].clone(); - ast = try!(eval(a1, env.clone())); - env = env_root(&env); - continue 'tco; - }, - _ => { // function call - let el = try!(eval_ast(tmp.clone(), env.clone())); - let args = match *el { - List(ref args,_) => args, - _ => return err_str("Invalid apply"), - }; - return match *args.clone()[0] { - Func(f,_) => f(args[1..].to_vec()), - MalFunc(ref mf,_) => { - let mfc = mf.clone(); - let alst = list(args[1..].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), - } - }, - _ => err_str("attempt to call non-function"), - } - }, - } - - } -} - -// print -fn print(exp: MalVal) -> String { - exp.pr_str(true) -} - -fn rep(str: &str, env: Env) -> Result { - let ast = try!(read(str.to_string())); - //println!("read: {}", ast); - let exp = try!(eval(ast, env)); - 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), v); - } - // see eval() for definition of "eval" - env_set(&repl_env, symbol("*ARGV*"), 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("(def! *gensym-counter* (atom 0))", repl_env.clone()); - let _ = rep("(def! gensym (fn* [] (symbol (str \"G__\" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))", repl_env.clone()); - let _ = 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)))))))))", repl_env.clone()); - - // Invoked with command line arguments - let args = stdenv::args(); - if args.len() > 1 { - let mv_args = args.skip(2) - .map(|a| string(a)) - .collect::>(); - env_set(&repl_env, symbol("*ARGV*"), list(mv_args)); - let lf = format!("(load-file \"{}\")", - stdenv::args().skip(1).next().unwrap()); - return match rep(&lf, repl_env.clone()) { - Ok(_) => process::exit(0), - Err(str) => { - println!("Error: {:?}", str); - process::exit(1); - } - }; - } - - // 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(), repl_env.clone()) { - Ok(str) => println!("{}", str), - Err(ErrMalVal(_)) => (), // Blank line - Err(ErrString(s)) => println!("Error: {}", s), - } - } -} diff --git a/rust/src/core.rs b/rust/src/core.rs deleted file mode 100644 index 00e3532d67..0000000000 --- a/rust/src/core.rs +++ /dev/null @@ -1,557 +0,0 @@ -#![allow(dead_code)] - -use std::collections::HashMap; -use std::fs::File; -use std::io::prelude::*; -//use std::num::ToPrimitive; -use num::traits::ToPrimitive; -use time; - -use types::{MalVal,MalRet,err_val,err_str,err_string, - _nil,_true,_false,_int,string, - list,vector,listm,vectorm,hash_mapm,func,funcm,malfuncd}; -use types::MalType::{Nil, Int, Strn, List, Vector, Hash_Map, Func, MalFunc, Atom}; -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"); - } - if a[0] == a[1] {Ok(_true())} else {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) { - 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) => { - let mut s = String::new(); - match File::open(a0).and_then(|mut f| f.read_to_string(&mut s)) { - Ok(_) => Ok(string(s)), - Err(e) => err_string(e.to_string()), - } - }, - _ => err_str("slurp called with non-string"), - } -} - - -// Numeric functions -fn int_op(f: F, a: Vec) -> MalRet - where F: FnOnce(isize, isize) -> isize -{ - 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: F, a: Vec) -> MalRet - where F: FnOnce(isize, isize) -> bool -{ - 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) } - -pub fn time_ms(_a: Vec) -> MalRet { - //let x = time::now(); - let now = time::get_time(); - let now_ms = (now.sec * 1000).to_isize().unwrap() + - (now.nsec.to_isize().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[1..].to_vec()), - Nil => types::hash_mapv(a[1..].to_vec()), - _ => 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[1..].to_vec()), - Nil => Ok(_nil()), - _ => 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 hm = match *a[0] { - 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.get(key) { - Some(v) => Ok(v.clone()), - None => Ok(_nil()), - } - }, - _ => 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 hm = match *a[0] { - 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()), - } - } - _ => 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 hm = match *a[0] { - Hash_Map(ref hm,_) => hm, - Nil => return Ok(_nil()), - _ => return err_str("contains? on non-hash map"), - }; - Ok(list(hm.keys().map(|s| string(s.to_string())).collect())) -} - -pub fn vals(a: Vec) -> MalRet { - if a.len() != 1 { - return err_str("Wrong arity to values call"); - } - let hm = match *a[0] { - Hash_Map(ref hm,_) => hm, - Nil => return Ok(_nil()), - _ => return err_str("contains? on non-hash map"), - }; - Ok(list(hm.values().map(|s| s.clone()).collect())) -} - -// 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.extend(l.clone()), - _ => 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 seq = match *a[0] { - List(ref v,_) | Vector(ref v,_) => v, - _ => return err_str("nth called with non-sequence"), - }; - let idx = match *a[1] { - Int(i) => { - match i.to_usize() { - Some(ui) => ui, - None => return Ok(_nil()), - } - }, - _ => return err_str("nth called with non-integer index"), - }; - if idx >= seq.len() { - 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 seq = match *a[0] { - List(ref v,_) | Vector(ref v,_) => v, - Nil => return Ok(_nil()), - _ => 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 seq = match *a[0] { - List(ref v,_) | Vector(ref v,_) => v, - Nil => return Ok(list(vec![])), - _ => return err_str("rest called with non-sequence"), - }; - if seq.len() == 0 { - Ok(list(vec![])) - } else { - Ok(list(seq[1..].to_vec())) - } -} - -pub fn empty_q(a: Vec) -> MalRet { - if a.len() != 1 { - return err_str("Wrong arity to empty? call"); - } - match *a[0] { - 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] { - List(ref v,_) | Vector(ref v,_) => Ok(_int(v.len().to_isize().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[1..a.len()-1].to_vec(); - match *a[a.len()-1] { - List(ref v, _) | Vector(ref v, _) => { - args.extend(v.clone()); - 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![]; - match *a[1] { - List(ref v,_) | Vector(ref v,_) => { - for mv in v.iter() { - let res = try!(a[0].apply(vec![mv.clone()])); - results.push(res); - } - }, - _ => 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] { - List(ref l,_) => { - new_v.extend(l.clone()); - for mv in a.iter().skip(1) { - new_v.insert(0, mv.clone()); - } - Ok(list(new_v)) - } - Vector(ref l,_) => { - new_v.extend(l.clone()); - for mv in a.iter().skip(1) { - new_v.push(mv.clone()); - } - Ok(vector(new_v)) - } - _ => err_str("conj called with non-sequence"), - } -} - -pub fn seq(a: Vec) -> MalRet { - if a.len() != 1 { - return err_str("Wrong arity to seq call"); - } - let mut new_v: Vec = vec![]; - match *a[0] { - List(ref l,_) | - Vector(ref l,_) => { - if l.len() == 0 { - Ok(_nil()) - } else { - new_v.extend(l.clone()); - Ok(list(new_v)) - } - }, - Strn(ref s) => { - if s.len() == 0 { - Ok(_nil()) - } else if s.starts_with("\u{29e}") { - err_str("seq: called with non-sequence") - } else { - for c in s.chars() { - new_v.push(string(c.to_string())); - } - Ok(list(new_v)) - } - }, - Nil => Ok(_nil()), - _ => err_str("seq: 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 meta = a[1].clone(); - match *a[0] { - 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] { - 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] { - Atom(ref val) => Ok(val.borrow().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"); - } - match *a[0] { - Atom(ref val) => { - let mut val_cell = val.borrow_mut(); - *val_cell = a[1].clone(); - Ok(a[1].clone()) - }, - _ => 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] { - Atom(ref val) => { - let mut val_cell = val.borrow_mut(); - let mut args = a[2..].to_vec(); - args.insert(0, val_cell.clone()); - *val_cell = try!(f.apply(args)); - Ok(val_cell.clone()) - }, - _ => err_str("swap! called on non-atom"), - } -} - - -pub fn ns() -> HashMap { - let mut ns = 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("string?".to_string(), func(types::string_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("seq".to_string(), func(seq)); - - 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 c27e499ec4..0000000000 --- a/rust/src/env.rs +++ /dev/null @@ -1,106 +0,0 @@ -use std::rc::Rc; -use std::cell::RefCell; -use std::collections::HashMap; - -use types::{MalVal, MalRet, _nil, list, err_string}; -use types::MalType::{Sym, List, Vector}; - -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.by_ref() { - match **b { - Sym(ref strn) => { - if *strn == "&" { - 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[i-1..].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) => { - let map = env.borrow(); - if map.data.contains_key(k) { - Some(env.clone()) - } else { - match map.outer { - Some(ref e) => env_find(e, key), - 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); } - _ => {}, - } -} - -pub fn env_get(env: &Env, key: &MalVal) -> MalRet { - match **key { - Sym(ref k) => { - match env_find(env, key) { - Some(e) => { - match e.borrow().data.get(k) { - Some(v) => Ok(v.clone()), - None => Ok(_nil()), - } - }, - None => err_string(format!("'{}' not found", k)), - } - } - _ => err_string("env_get called with non-symbol key".to_string()), - } -} diff --git a/rust/src/lib.rs b/rust/src/lib.rs deleted file mode 100644 index 0961bcc3e3..0000000000 --- a/rust/src/lib.rs +++ /dev/null @@ -1,15 +0,0 @@ -extern crate libc; -extern crate regex; -extern crate time; -extern crate num; - -macro_rules! regex { - ($e:expr) => (::regex::Regex::new($e).unwrap()) -} - -pub mod core; -pub mod env; -pub mod printer; -pub mod reader; -pub mod readline; -pub mod types; diff --git a/rust/src/printer.rs b/rust/src/printer.rs deleted file mode 100644 index 4150d39d27..0000000000 --- a/rust/src/printer.rs +++ /dev/null @@ -1,46 +0,0 @@ -use types::MalVal; - -pub fn escape_str(s: &str) -> String { - let mut escaped = String::new(); - escaped.push('"'); - for c in s.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"#); - let re3 = regex!(r#"\\\\"#); - re3.replace_all(&re2.replace_all(&re1.replace_all(&s, "\""), "\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)); - } - res.push_str(end); - res -} diff --git a/rust/src/reader.rs b/rust/src/reader.rs deleted file mode 100644 index 94093db2c4..0000000000 --- a/rust/src/reader.rs +++ /dev/null @@ -1,198 +0,0 @@ -use std::borrow::ToOwned; -use types::MalError::{ErrString, ErrMalVal}; -use types::{MalVal, MalRet, - _nil, _true, _false, _int, symbol, string, list, vector, hash_mapv, - err_str, err_string, err_val}; -use super::printer::unescape_str; - -#[derive(Debug, Clone)] -struct Reader { - tokens: Vec, - position: usize, -} - -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 = regex!(r###"[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"|;.*|[^\s\[\]{}('"`,;)]*)"###); - for cap in re.captures_iter(&str) { - let group = cap.at(1).unwrap_or(""); - if group == "" { break; } - if group.starts_with(";") { continue; } - results.push(group.to_owned()); - } - 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[..]; - if regex!(r"^-?[0-9]+$").is_match(token) { - let num : Option = token.parse().ok(); - Ok(_int(num.unwrap())) - } else if regex!(r#"^".*"$"#).is_match(token) { - let new_str = &token[1..token.len()-1]; - Ok(string(unescape_str(new_str))) - } else if regex!(r#"^:"#).is_match(token) { - Ok(string(format!("\u{29e}{}", &token[1..]))) - } 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[..]; - if token != start { - return Err(format!("expected '{}'", start)) - } - - let mut ast_vec : Vec = vec![]; - loop { - let otoken = rdr.peek(); - if otoken.is_none() { - return Err(format!("expected '{}', got EOF", end)); - } - let stoken = otoken.unwrap(); - let token = &stoken[..]; - 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[..]; - 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 37bf6745a3..0000000000 --- a/rust/src/readline.rs +++ /dev/null @@ -1,81 +0,0 @@ -// Based on: https://github.com/shaleh/rust-readline (MIT) -use libc; - -use std::ffi::{CStr, CString}; -use std::fs::{OpenOptions, File}; -use std::io::BufReader; -use std::io::prelude::*; -use std::str; - -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(CString::new(line).unwrap().as_ptr()); - } -} - -pub fn readline(prompt: &str) -> Option { - let cprmt = CString::new(prompt).unwrap(); - unsafe { - let ptr = ext_readline::readline(cprmt.as_ptr()); - if ptr.is_null() { // user pressed Ctrl-D - None - } else { - let ret = str::from_utf8(CStr::from_ptr(ptr).to_bytes()); - let ret = ret.ok().map(|s| s.to_string()); - libc::free(ptr as *mut _); - return ret; - } - } -} - -// -------------------------------------------- - -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 file = match File::open(HISTORY_FILE) { - Ok(f) => f, - Err(..) => return - }; - let file = BufReader::new(file); - for line in file.lines() { - let rt: &[_] = &['\r', '\n']; - let line2 = line.unwrap(); - let line3 = line2.trim_right_matches(rt); - add_history(line3); - } -} - -fn append_to_history(line: &str) { - let file = OpenOptions::new().append(true).write(true).create(true) - .open(HISTORY_FILE); - let mut file = match file { Ok(f) => f, Err(..) => return }; - let _ = file.write_all(line.as_bytes()); - let _ = file.write_all(b"\n"); -} - -pub fn mal_readline (prompt: &str) -> Option { - load_history(); - let line = readline(prompt); - if let Some(ref s) = line { - add_history(s); - append_to_history(s); - } - line -} diff --git a/rust/src/types.rs b/rust/src/types.rs deleted file mode 100644 index b85affa338..0000000000 --- a/rust/src/types.rs +++ /dev/null @@ -1,403 +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}; - -use self::MalType::*; -use self::MalError::*; - -#[derive(Clone)] -#[allow(non_camel_case_types)] -pub enum MalType { - Nil, - True, - False, - Int(isize), - Strn(String), - Sym(String), - List(Vec, MalVal), - Vector(Vec, MalVal), - Hash_Map(HashMap, MalVal), - Func(fn(Vec) -> MalRet, MalVal), - MalFunc(MalFuncData, MalVal), - Atom(RefCell), -} - -pub type MalVal = Rc; - -#[derive(Debug)] -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)) -} - -#[derive(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; - match *self { - Nil => "nil".to_string(), - True => "true".to_string(), - False => "false".to_string(), - Int(v) => v.to_string(), - Sym(ref v) => v.clone(), - Strn(ref v) => { - if v.starts_with("\u{29e}") { - format!(":{}", &v[2..]) - } else if print_readably { - escape_str(v) - } else { - v.clone() - } - }, - List(ref v,_) => { - pr_list(v, _r, "(", ")", " ") - }, - Vector(ref v,_) => { - pr_list(v, _r, "[", "]", " ") - }, - Hash_Map(ref v,_) => { - let mut res = String::new(); - res.push_str("{"); - for (i, (key, value)) in v.iter().enumerate() { - if i != 0 { res.push_str(" "); } - if key.starts_with("\u{29e}") { - res.push_str(":"); - res.push_str(&key[2..]) - } else if print_readably { - res.push_str(&escape_str(key)) - } else { - res.push_str(key) - } - res.push_str(" "); - res.push_str(&value.pr_str(_r)); - } - res.push_str("}"); - res - }, - // TODO: better native function representation - Func(_, _) => format!("#"), - MalFunc(ref mf,_) => format!("(fn* {:?} {:?})", mf.params, mf.exp), - Atom(ref v) => format!("(atom {:?})", &**v.borrow()), - } - } - - 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::Debug 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 string_q(a:Vec) -> MalRet { - if a.len() != 1 { - return err_str("Wrong arity to string? call"); - } - match *a[0].clone() { - Strn(ref s) => { - if s.starts_with("\u{29e}") { - Ok(_false()) - } else { - Ok(_true()) - } - }, - _ => Ok(_false()), - } -} - -pub fn _int(i: isize) -> 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] { - Strn(ref s) => Ok(Rc::new(Strn(format!("\u{29e}{}", s)))), - _ => 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.starts_with("\u{29e}") { - 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/rust/tests/step5_tco.mal b/rust/tests/step5_tco.mal deleted file mode 100644 index 5cf775f657..0000000000 --- a/rust/tests/step5_tco.mal +++ /dev/null @@ -1,2 +0,0 @@ -;; Rust: skipping non-TCO recursion -;; Reason: unrecoverable stack overflow diff --git a/scala/Dockerfile b/scala/Dockerfile deleted file mode 100644 index 989c32e17d..0000000000 --- a/scala/Dockerfile +++ /dev/null @@ -1,36 +0,0 @@ -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 -########################################################## - -# Java and maven -RUN apt-get -y install openjdk-7-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/scala/Makefile b/scala/Makefile deleted file mode 100644 index 1713ad5feb..0000000000 --- a/scala/Makefile +++ /dev/null @@ -1,38 +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) - -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 stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" - -tests: $(TESTS) - -$(TESTS): - @echo "Running $@"; \ - ruby $@ || exit 1; \ diff --git a/scala/assembly.sbt b/scala/assembly.sbt deleted file mode 100644 index 89a285dc1f..0000000000 --- a/scala/assembly.sbt +++ /dev/null @@ -1,8 +0,0 @@ -import AssemblyKeys._ // put this at the top of the file - -assemblySettings - -test in assembly := {} -jarName in assembly := "mal.jar" -mainClass in assembly := Some("stepA_mal") -assemblyOption in assembly ~= { _.copy(prependShellScript = Some(defaultShellScript)) } diff --git a/scala/project/assembly.sbt b/scala/project/assembly.sbt deleted file mode 100644 index 54c32528e9..0000000000 --- a/scala/project/assembly.sbt +++ /dev/null @@ -1 +0,0 @@ -addSbtPlugin("com.eed3si9n" % "sbt-assembly" % "0.11.2") diff --git a/scala/run b/scala/run deleted file mode 100755 index 49c913c26a..0000000000 --- a/scala/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec java -classpath "$(dirname $0)/target/scala-2.11/mal.jar" "${STEP:-stepA_mal}" "$@" diff --git a/scala/step7_quote.scala b/scala/step7_quote.scala deleted file mode 100644 index a8cbec410e..0000000000 --- a/scala/step7_quote.scala +++ /dev/null @@ -1,166 +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,v) => (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 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 => { - 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 48d15c252f..0000000000 --- a/scala/step8_macros.scala +++ /dev/null @@ -1,212 +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 (ml.value.length > 0 && - 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,v) => (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 eval_ast(ast, env) - - 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) - 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 068a43d65f..0000000000 --- a/scala/step9_try.scala +++ /dev/null @@ -1,232 +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 (ml.value.length > 0 && - 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,v) => (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 eval_ast(ast, env) - - 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) - 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 91a6169c76..0000000000 --- a/scala/stepA_mal.scala +++ /dev/null @@ -1,236 +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 (ml.value.length > 0 && - 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,v) => (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 eval_ast(ast, env) - - 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) - 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("(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)))))))))") - - - 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/swift/Makefile b/swift/Makefile deleted file mode 100644 index 472d7a0aff..0000000000 --- a/swift/Makefile +++ /dev/null @@ -1,241 +0,0 @@ -################################################################################ -# -# Makefile for the Swift implementation of MAL. -# -# The MAL project consists of building up a dialect/subset of Clojure over a -# series of steps. Each step implements a new feature or concept in an easily -# understandable and approachable manner. Each step can be built on its own and -# tested. Each step is built from a step-specific "step.swift" file and a set -# of files common to all steps. -# -# The general approach in this file is to discover the set of "step" source -# files (step0_repl.swift, etc.), and build corresponding executable files -# (step0_repl, etc) from them and from the set of supporting Swift files. -# Since the set of "step" files is discovered on-the-fly, the rules to make -# those files are also generated on-the-fly using $(eval). -# -# The various "step0_repl.swift", etc., source files are actually generated -# from a file called "templates/step.swift". Since each "step" file -# incrementally builds towards the final, complete "step" file, -# "templates/step.swift" is -- for the most part -- a copy of this final "step" -# file with each line annotated with the step in which that line is introduced. -# Through the use of a simple filter program, the "templates/step.swift" file -# can then be processed to produce each intermediate "step" file. This Makefile -# takes care of performing that processing any time "templates/step.swift" -# changes. -# -# MAKE TARGETS: -# -# all: -# Make all step targets, (re)generating source files if needed. -# alls: -# (Re)generate source files, if needed. -# step0_repl, step1_read_print, etc.: -# Make the corresponding step target. -# s0...sN: -# Shortcuts for the previous targets. -# step0_repl.swift, step1_read_print.swift, etc.: -# (Re)generate source files for the corresponding step target, if -# needed. -# ss0...ssN: -# Shortcuts for the previous targets. -# clean: -# Delete all built executables. Generated source files are *not* -# deleted. -# dump: -# Print some Make variables for debugging. -# -# TODO: -# * Compile each .swift file into an intermediate .o file and link the .o -# files, rather than performing a complete build of all files any time -# any one of them is out-of-date. Here are the commands generated when -# using `swiftc -v`: -# -# /Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/bin/swift \ -# -frontend \ -# -c \ -# -primary-file stepA_mal.swift \ -# ./core.swift \ -# ./env.swift \ -# ./main.swift \ -# ./printer.swift \ -# ./reader.swift \ -# ./readline.swift \ -# ./types.swift \ -# -target x86_64-apple-darwin14.1.0 \ -# -target-cpu core2 \ -# -sdk /Applications/Xcode.app/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX10.10.sdk \ -# -import-objc-header ./bridging-header.h \ -# -color-diagnostics \ -# -Onone \ -# -ledit \ -# -module-name stepA_mal \ -# -o /var/folders/dj/p3tx6v852sl88g79qvhhc2ch0000gp/T/stepA_mal-e0a836.o -# ... Similar for each source file... -# /usr/bin/ld \ -# /var/folders/dj/p3tx6v852sl88g79qvhhc2ch0000gp/T/stepA_mal-e0a836.o \ -# /var/folders/dj/p3tx6v852sl88g79qvhhc2ch0000gp/T/core-28b620.o \ -# /var/folders/dj/p3tx6v852sl88g79qvhhc2ch0000gp/T/env-5d8422.o \ -# /var/folders/dj/p3tx6v852sl88g79qvhhc2ch0000gp/T/main-e79633.o \ -# /var/folders/dj/p3tx6v852sl88g79qvhhc2ch0000gp/T/printer-cdd3e5.o \ -# /var/folders/dj/p3tx6v852sl88g79qvhhc2ch0000gp/T/reader-bb188a.o \ -# /var/folders/dj/p3tx6v852sl88g79qvhhc2ch0000gp/T/readline-53df55.o \ -# /var/folders/dj/p3tx6v852sl88g79qvhhc2ch0000gp/T/types-7cb250.o \ -# -L /usr/lib \ -# -ledit \ -# -syslibroot \ -# /Applications/Xcode.app/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX10.10.sdk \ -# -lSystem \ -# -arch x86_64 \ -# -L /Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/lib/swift/macosx \ -# -rpath /Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/lib/swift/macosx \ -# -macosx_version_min 10.10.0 \ -# -no_objc_category_merging \ -# -o stepA_mal -# -# * Consider adding a clean-dist (or similar) that deletes the generated -# "step" source files. -# -################################################################################ - -# -# Discover the set of "step" source files (those having the form -# "step<#>_foo.swift") -# -SRCS := $(wildcard ./step*.swift) - -# -# From the set of "step" source files, generate the set of executable files -# (those having the form "step<#>_foo") -# -EXES := $(patsubst %.swift,%,$(SRCS)) - -# -# Also generate references to any debug-symbol directories we may make when -g -# is specified. -# -DSYMS := $(patsubst %.swift,%.dSYM,$(SRCS)) - -# -# Given a name like "./step<#>_foo", return <#>. -# -# (Is there a better way to do this? $(patsubst) seems to be the most -# appropriate built-in command, but it doesn't seem powerful enough.) -# -# (I've included a `sed` version in case relying on bash is contraindicated.) -# -get_step_number = $(shell echo $(1) | sed -e "s/.*step\(.\).*/\1/") -#get_step_number = $(shell [[ $(1) =~ step(.)_.* ]] ; echo $${BASH_REMATCH[1]}) - -# -# Working from the list of discovered "step<#>_foo.swift" files, generate the -# list of step numbers. -# -get_all_step_numbers = $(foreach SRC,$(SRCS),$(call get_step_number,$(SRC))) - -# -# Generate the dependencies for the "all" target. This list has the form -# "s0 s1 ... sN" for all N returned by get_all_step_numbers. That is: -# -# all: s0 s1 ... sN -# -# Also create an "alls" target that just regenerates all the "step" files from -# the corresponding template file. -# -$(eval all: $(patsubst %,s%,$(call get_all_step_numbers))) -$(eval alls: $(patsubst %,ss%,$(call get_all_step_numbers))) - -# -# Generate the dependencies for the ".PHONY" target. That is: -# -# .PHONY: all clean dump s0 s1 ... sN -# -$(eval .PHONY: all clean dump $(patsubst %,s%,$(call get_all_step_numbers))) - -# -# Define the "EZ" targets, where "s0" builds "step0_repl", "s1" builds -# "step1_read_print", etc. That is: -# -# s0: step0_repl -# s1: step1_read_print -# ... -# sN: stepN_foo -# -# Also create corresponding targets that rebuild the sources files: -# -# ss0: step0_repl.swift -# ss1: step1_read_print.swift -# ... -# ssN: stepN_foo.swift -# -$(foreach EXE,$(EXES),$(eval s$(call get_step_number,$(EXE)): $(EXE))) -$(foreach SRC,$(SRCS),$(eval ss$(call get_step_number,$(SRC)): $(SRC))) - -# -# Various helpful variables. -# -DEV_DIR := $(firstword $(wildcard /Applications/Xcode-beta.app /Applications/Xcode.app)) -SWIFT := $(shell DEVELOPER_DIR="$(DEV_DIR)" xcrun --find swiftc 2>/dev/null) -SDKROOT := $(shell DEVELOPER_DIR="$(DEV_DIR)" xcrun --show-sdk-path 2>/dev/null) -STEP_TEMPLATE := ./templates/step.swift -FILTER := ./templates/filter_steps.sh -UTIL_SRC := $(filter-out $(STEP_TEMPLATE) $(SRCS),$(wildcard ./*.swift)) -ifndef TYPES -TYPES := CLASS -endif -ifeq ($(TYPES), ENUM) -UTIL_SRC := $(filter-out ./types_class.swift,$(UTIL_SRC)) -else -UTIL_SRC := $(filter-out ./types_enum.swift,$(UTIL_SRC)) -endif -OPT := -Ounchecked -whole-module-optimization -DEBUG := #-g -EXTRA := #-v -COMMON := $(UTIL_SRC) $(OPT) $(DEBUG) $(EXTRA) -import-objc-header ./bridging-header.h -L /usr/lib -ledit -sdk $(SDKROOT) - -# -# Build the executable from the input sources consisting of the appropriate -# "step" file and the supporting files in $(UTIL_SRC). -# -$(EXES) : % : %.swift $(UTIL_SRC) ./Makefile - @echo "Making : $@" - @$(SWIFT) $< $(COMMON) -o $@ - -# -# Build the "step" source file ("step<#>_foo.swift") from the step template -# file that combines all the steps in one file. -# -$(SRCS) : % : $(STEP_TEMPLATE) ./Makefile - @echo "Generating: $@" - @$(FILTER) $(call get_step_number,$@) $< $@ - -# -# Delete all of the build output (other than generated "step" source files) -# -clean: - @rm -rf $(EXES) $(DSYMS) - -# -# Display some variables for debugging. -# -dump: - @echo " SRCS = $(SRCS)" - @echo " EXES = $(EXES)" - @echo " DSYMS = $(DSYMS)" - @echo " UTIL = $(UTIL_SRC)" - @echo " SWIFT = $(SWIFT)" - @echo "SDKROOT = $(SDKROOT)" - @echo " STEPS = $(call get_all_step_numbers)" - -# -# Display source stats -# -.PHONY: stats tests $(TESTS) - -stats: bridging-header.h $(UTIL_SRC) ./stepA_mal.swift - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: ./env.swift ./core.swift ./stepA_mal.swift - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" - diff --git a/swift/bridging-header.h b/swift/bridging-header.h deleted file mode 100644 index 9679345cae..0000000000 --- a/swift/bridging-header.h +++ /dev/null @@ -1,15 +0,0 @@ -// This is the "bridging" file for the Swift version of MAL. A bridging file -// brings in C/ObjC types and makes them available to Swift source code, using -// the type conversion process described in: -// -// https://developer.apple.com/library/prerelease/ios/documentation/Swift/Conceptual/BuildingCocoaApps/InteractingWithCAPIs.html#//apple_ref/doc/uid/TP40014216-CH8-XID_11 -// -// The mechanism for creating and using a bridging file is only documented for -// Xcode users. However, the following article describes how to specify a -// bridging file on the command line: -// -// http://stackoverflow.com/questions/24131476/compiling-and-linking-swift-plus-objective-c-code-from-the-os-x-command-line -// - -#include -#include diff --git a/swift/core.swift b/swift/core.swift deleted file mode 100644 index 7e92b60017..0000000000 --- a/swift/core.swift +++ /dev/null @@ -1,750 +0,0 @@ -//****************************************************************************** -// MAL - core -//****************************************************************************** - -import Foundation - -// This is a simple type distinct from all MalVal types so that we can pass a -// sequence to a function and be able to distinguish between those functions -// that want a sequence as a parameter and those that want a sequence that holds -// the rest of the function parameters. -// -final class MalVarArgs { - init(_ value: MalSequence) { self.value = value } - init(_ value: MalVal) { self.value = as_sequence(value) } - let value: MalSequence -} - -private func fn_eq(obj1: MalVal, obj2: MalVal) throws -> Bool { - return obj1 == obj2 -} - -private func fn_throw(exception: MalVal) throws -> MalVal { - try throw_error(exception) -} - -private func fn_nilQ(obj: MalVal) throws -> Bool { - return is_nil(obj) -} - -private func fn_trueQ(obj: MalVal) throws -> Bool { - return is_true(obj) -} - -private func fn_falseQ(obj: MalVal) throws -> Bool { - return is_false(obj) -} - -private func fn_stringQ(obj: MalVal) throws -> Bool { - return is_string(obj) -} - -private func fn_symbol(s: String) throws -> MalVal { - return make_symbol(s) -} - -private func fn_symbolQ(obj: MalVal) throws -> Bool { - return is_symbol(obj) -} - -private func fn_keyword(s: MalVal) throws -> MalVal { - if is_keyword(s) { - return s - } - if is_string(s) { - return make_keyword(as_string(s)) - } - try throw_error("expected string or keyword") -} - -private func fn_keywordQ(obj: MalVal) throws -> Bool { - return is_keyword(obj) -} - -private func fn_prstr(args: MalVarArgs) throws -> String { - let args_str_array = args.value.map { pr_str($0, true) } - return args_str_array.joinWithSeparator(" ") -} - -private func fn_str(args: MalVarArgs) throws -> String { - let args_str_array = args.value.map { pr_str($0, false) } - return args_str_array.joinWithSeparator("") -} - -private func fn_prn(args: MalVarArgs) { - let args_str_array = args.value.map { pr_str($0, true) } - let args_str = args_str_array.joinWithSeparator(" ") - print(args_str) -} - -private func fn_println(args: MalVarArgs) { - let args_str_array = args.value.map { pr_str($0, false) } - let args_str = args_str_array.joinWithSeparator(" ") - print(args_str) -} - -private func fn_readstring(s: String) throws -> MalVal { - return try read_str(s) -} - -private func fn_readline(s: String) throws -> String? { - return _readline(s) -} - -private func fn_slurp(s: String) throws -> MalVal { - do { - let result = try String(contentsOfFile: s, encoding: NSUTF8StringEncoding) - return make_string(result) - } catch let error as NSError { - try throw_error("unknown error reading file \(error)") - } -} - -private func fn_lt(arg1: MalIntType, arg2: MalIntType) throws -> Bool { - return arg1 < arg2 -} - -private func fn_lte(arg1: MalIntType, arg2: MalIntType) throws -> Bool { - return arg1 <= arg2 -} - -private func fn_gt(arg1: MalIntType, arg2: MalIntType) throws -> Bool { - return arg1 > arg2 -} - -private func fn_gte(arg1: MalIntType, arg2: MalIntType) throws -> Bool { - return arg1 >= arg2 -} - -private func fn_add(arg1: MalIntType, arg2: MalIntType) throws -> MalIntType { - return arg1 + arg2 -} - -private func fn_subtract(arg1: MalIntType, arg2: MalIntType) throws -> MalIntType { - return arg1 - arg2 -} - -private func fn_multiply(arg1: MalIntType, arg2: MalIntType) throws -> MalIntType { - return arg1 * arg2 -} - -private func fn_divide(arg1: MalIntType, arg2: MalIntType) throws -> MalIntType { - return arg1 / arg2 -} - -private func fn_timems() throws -> MalIntType { - var time = timeval(tv_sec: 0, tv_usec: 0) - let res = gettimeofday(&time, nil) - if res == 0 { - return (MalIntType(time.tv_sec) * 1_000_000 + MalIntType(time.tv_usec)) / 1000 - } - return -1 -} - -private func fn_list(args: MalVarArgs) throws -> MalVal { - return make_list(args.value) -} - -private func fn_listQ(obj: MalVal) throws -> Bool { - return is_list(obj) -} - -private func fn_vector(args: MalVarArgs) throws -> MalVal { - return make_vector(args.value) -} - -private func fn_vectorQ(obj: MalVal) throws -> Bool { - return is_vector(obj) -} - -private func fn_hashmap(args: MalVarArgs) throws -> MalVal { - return make_hashmap(args.value) -} - -private func fn_hashmapQ(obj: MalVal) throws -> Bool { - return is_hashmap(obj) -} - -private func fn_assoc(hash: MalHashMap, args: MalVarArgs) throws -> MalVal { - guard args.value.count % 2 == 0 else { - try throw_error("expected even number of elements, got \(args.value.count)") - } - var new_dictionary = hash.hash - for var index: MalIntType = 0; index < args.value.count; index += 2 { - new_dictionary[try! args.value.nth(index)] = try! args.value.nth(index + 1) - } - return make_hashmap(new_dictionary) -} - -private func fn_dissoc(hash: MalHashMap, args: MalVarArgs) throws -> MalVal { - var new_dictionary = hash.hash - for value in args.value { - new_dictionary.removeValueForKey(value) - } - return make_hashmap(new_dictionary) -} - -private func fn_get(obj: MalVal, key: MalVal) throws -> MalVal { - if let as_vec = as_vectorQ(obj) { - guard let index = as_integerQ(key) else { - try throw_error("expected integer key for get(vector), got \(key)") - } - let n = as_inttype(index) - guard n >= as_vec.count else { try throw_error("index out of range: \(n) >= \(as_vec.count)") } - return try! as_vec.nth(n) - } - if let as_hash = as_hashmapQ(obj) { - if let value = as_hash.value_for(key) { return value } - return make_nil() - } - if is_nil(obj) { - return obj - } - try throw_error("get called on unsupported type: \(obj)") -} - -private func fn_containsQ(obj: MalVal, key: MalVal) throws -> MalVal { - if let as_vec = as_vectorQ(obj) { - guard let index = as_integerQ(key) else { - try throw_error("expected integer key for contains(vector), got \(key)") - } - let n = as_inttype(index) - return n < as_vec.count ? make_true() : make_false() - } - if let as_hash = as_hashmapQ(obj) { - return as_hash.value_for(key) != nil ? make_true() : make_false() - } - try throw_error("contains? called on unsupported type: \(obj)") -} - -private func fn_keys(hash: MalHashMap) throws -> MalVal { - return hash.keys -} - -private func fn_values(hash: MalHashMap) throws -> MalVal { - return hash.values -} - -private func fn_sequentialQ(obj: MalVal) throws -> Bool { - return is_sequence(obj) -} - -private func fn_cons(first: MalVal, rest: MalSequence) throws -> MalVal { - return rest.cons(first) -} - -private func fn_concat(args: MalVarArgs) throws -> MalVal { - var result = make_list() - for arg in args.value { - guard let arg_as_seq = as_sequenceQ(arg) else { - try throw_error("expected list, got \(arg)") - } - result = try! as_sequence(result).concat(arg_as_seq) - } - return result -} - -private func fn_nth(list: MalSequence, index: MalIntType) throws -> MalVal { - return try list.nth(index) -} - -private func fn_first(arg: MalVal) throws -> MalVal { - if is_nil(arg) { - return arg - } - if let list = as_sequenceQ(arg) { - return list.first() - } - try throw_error("expected list, got \(arg)") -} - -private func fn_rest(arg: MalVal) throws -> MalVal { - if is_nil(arg) { - return make_list() - } - if let seq = as_sequenceQ(arg) { - return seq.rest() - } - try throw_error("expected sequence, got \(arg)") -} - -private func fn_emptyQ(obj: MalVal) throws -> Bool { - if let list = as_sequenceQ(obj) { - return list.isEmpty - } - return true -} - -private func fn_count(obj: MalVal) throws -> MalIntType { - if is_nil(obj) { - return 0 - } - if let as_seq = as_sequenceQ(obj) { - return as_seq.count - } - if let as_hash = as_hashmapQ(obj) { - return as_hash.count - } - if let as_str = as_stringQ(obj) { - return MalIntType(as_stringtype(as_str).characters.count) - } - return 0 -} - -private func fn_apply(args: MalVarArgs) throws -> MalVal { - guard args.value.count >= 2 else { - try throw_error("expected at least 2 arguments to apply, got \(args.value.count)") - } - - let first = args.value.first() - let middle = args.value.range_from(1, to: args.value.count - 1) - let last = args.value.last() - - guard let fn = as_functionQ(first) else { - try throw_error("expected function for first argument to apply, got \(first)") - } - guard let seq = as_sequenceQ(last) else { - try throw_error("expected sequence for last argument to apply, got \(last)") - } - let exprs = try! as_sequence(middle).concat(seq) - return try fn.apply(as_sequence(exprs)) -} - -private func fn_map(fn: MalFunction, list: MalSequence) throws -> MalVal { - var result = [MalVal]() - result.reserveCapacity(Int(list.count)) - for var index: MalIntType = 0; index < list.count; ++index { - let apply_res = try fn.apply(as_sequence(make_list_from(try! list.nth(index)))) - result.append(apply_res) - } - return make_list(result) -} - -private func fn_conj(first: MalSequence, rest: MalVarArgs) throws -> MalVal { - return try first.conj(rest.value) -} - -private func fn_seq(seq: MalVal) throws -> MalVal { - if let list = as_listQ(seq) { - return list.count > 0 ? list : make_nil() - } else if let vector = as_vectorQ(seq) { - return vector.count > 0 ? make_list(vector) : make_nil() - } else if let str = as_stringQ(seq) { - if str.string.characters.count == 0 { return make_nil() } - return make_list(str.string.characters.map { make_string(String($0)) }) - } else if is_nil(seq) { - return make_nil() - } else { - try throw_error("seq: called with non-sequence") - } - return seq -} - -private func fn_meta(obj: MalVal) throws -> MalVal { - if let meta = get_meta(obj) { - return meta - } - - return make_nil() -} - -private func fn_withmeta(form: MalVal, meta: MalVal) throws -> MalVal { - return with_meta(form, meta) -} - -private func fn_atom(obj: MalVal) throws -> MalVal { - return make_atom(obj) -} - -private func fn_atomQ(obj: MalVal) throws -> Bool { - return is_atom(obj) -} - -private func fn_deref(atom: MalAtom) throws -> MalVal { - return atom.object -} - -private func fn_resetBang(atom: MalAtom, obj: MalVal) throws -> MalVal { - return atom.set_object(obj) -} - -private func fn_swapBang(let atom: MalAtom, fn: MalFunction, rest: MalVarArgs) throws -> MalVal { - var new_args = make_list_from(atom.object) - new_args = try as_sequence(new_args).concat(rest.value) - let result = try fn.apply(as_sequence(new_args)) - return atom.set_object(result) -} - -//****************************************************************************** -// -// The facility for invoking built-in functions makes use of a name -> -// function-pointer table (defined down below). The function-pointers accept a -// sequence of MalVals and return a MalVal as a result. Each built-in function -// that does actual work, on the other hand, may expect a different set of -// parameters of different types, and may naturally return a result of any type. -// In order to convert between these two types of interfaces, we have these -// unwrap_args functions. These functions implement the (MalSequence) -> MalVal -// interface expected by EVAL, and convert that information into Ints, Strings, -// etc. expected by the built-in functions. -// -//****************************************************************************** - -private func with_one_parameter(args: MalSequence, @noescape fn: (MalVal) throws -> MalVal) throws -> MalVal { - guard args.count >= 1 else { try throw_error("expected at least 1 parameter, got \(args.count)") } - let arg1 = try! args.nth(0) - return try fn(arg1) -} - -private func with_two_parameters(args: MalSequence, @noescape fn: (MalVal, MalVal) throws -> MalVal) throws -> MalVal { - guard args.count >= 2 else { try throw_error("expected at least 2 parameter, got \(args.count)") } - let arg1 = try! args.nth(0) - let arg2 = try! args.nth(1) - return try fn(arg1, arg2) -} - -// ========== 0-parameter functions ========== - -// () -> MalIntType - -private func unwrap_args(args: MalSequence, @noescape forFunction fn: () throws -> MalIntType) throws -> MalVal { - return make_integer(try fn()) -} - -// () -> MalVal - -private func unwrap_args(args: MalSequence, @noescape forFunction fn: () throws -> MalVal) throws -> MalVal { - return try fn() -} - -// ========== 1-parameter functions ========== - -// (MalAtom) -> MalVal - -private func unwrap_args(args: MalSequence, @noescape forFunction fn: (MalAtom) throws -> MalVal) throws -> MalVal { - return try with_one_parameter(args) { (arg1) -> MalVal in - guard let atom = as_atomQ(arg1) else { - try throw_error("expected atom, got \(arg1)") - } - return try fn(atom) - } -} - -// (MalHashMap) -> MalVal - -private func unwrap_args(args: MalSequence, @noescape forFunction fn: (MalHashMap) throws -> MalVal) throws -> MalVal { - return try with_one_parameter(args) { (arg1) -> MalVal in - guard let hash = as_hashmapQ(arg1) else { - try throw_error("expected hashmap, got \(arg1)") - } - return try fn(hash) - } -} - -// (MalSequence) -> MalVal - -private func unwrap_args(args: MalSequence, @noescape forFunction fn: (MalSequence) throws -> MalVal) throws -> MalVal { - return try with_one_parameter(args) { (arg1) -> MalVal in - guard let seq = as_sequenceQ(arg1) else { - try throw_error("expected list, got \(arg1)") - } - return try fn(seq) - } -} - -// (MalVal) -> Bool - -private func unwrap_args(args: MalSequence, @noescape forFunction fn: (MalVal) throws -> Bool) throws -> MalVal { - return try with_one_parameter(args) { (arg1) -> MalVal in - return try fn(arg1) ? make_true() : make_false() - } -} - -// (MalVal) -> MalIntType - -private func unwrap_args(args: MalSequence, @noescape forFunction fn: (MalVal) throws -> MalIntType) throws -> MalVal { - return try with_one_parameter(args) { (arg1) -> MalVal in - return make_integer(try fn(arg1)) - } -} - -// (MalVal) -> MalVal - -func unwrap_args(args: MalSequence, @noescape forFunction fn: (MalVal) throws -> MalVal) throws -> MalVal { - return try with_one_parameter(args) { (arg1) -> MalVal in - return try fn(arg1) - } -} - -// (String) -> MalVal - -private func unwrap_args(args: MalSequence, @noescape forFunction fn: (String) throws -> MalVal) throws -> MalVal { - return try with_one_parameter(args) { (arg1) -> MalVal in - guard let str = as_stringQ(arg1) else { - try throw_error("expected string, got \(arg1)") - } - return try fn(as_stringtype(str)) - } -} - -// (String) -> MalVal? - -private func unwrap_args(args: MalSequence, @noescape forFunction fn: (String) throws -> MalVal?) throws -> MalVal { - return try with_one_parameter(args) { (arg1) -> MalVal in - guard let str = as_stringQ(arg1) else { - try throw_error("expected string, got \(arg1)") - } - let res = try fn(as_stringtype(str)) - return res != nil ? res! : make_nil() - } -} - -// (String) -> String - -private func unwrap_args(args: MalSequence, @noescape forFunction fn: (String) throws -> String) throws -> MalVal { - return try with_one_parameter(args) { (arg1) -> MalVal in - guard let str = as_stringQ(arg1) else { - try throw_error("expected string, got \(arg1)") - } - return make_string(try fn(as_stringtype(str))) - } -} - -// (String) -> String? - -private func unwrap_args(args: MalSequence, @noescape forFunction fn: (String) throws -> String?) throws -> MalVal { - return try with_one_parameter(args) { (arg1) -> MalVal in - guard let str = as_stringQ(arg1) else { - try throw_error("expected string, got \(arg1)") - } - let res = try fn(as_stringtype(str)) - return res != nil ? make_string(res!) : make_nil() - } -} - -// ========== 2-parameter functions ========== - -// (MalIntType, MalIntType) -> Bool - -private func unwrap_args(args: MalSequence, @noescape forFunction fn: (MalIntType, MalIntType) throws -> Bool) throws -> MalVal { - return try with_two_parameters(args) { (arg1, arg2) -> MalVal in - guard let int1 = as_integerQ(arg1) else { - try throw_error("expected number, got \(arg1)") - } - guard let int2 = as_integerQ(arg2) else { - try throw_error("expected number, got \(arg2)") - } - return try fn(as_inttype(int1), as_inttype(int2)) ? make_true() : make_false() - } -} - -// (MalIntType, MalIntType) -> MalIntType - -private func unwrap_args(args: MalSequence, @noescape forFunction fn: (MalIntType, MalIntType) throws -> MalIntType) throws -> MalVal { - return try with_two_parameters(args) { (arg1, arg2) -> MalVal in - guard let int1 = as_integerQ(arg1) else { - try throw_error("expected number, got \(arg1)") - } - guard let int2 = as_integerQ(arg2) else { - try throw_error("expected number, got \(arg2)") - } - return make_integer(try fn(as_inttype(int1), as_inttype(int2))) - } -} - -// (MalAtom, MalVal) -> MalVal - -private func unwrap_args(args: MalSequence, @noescape forFunction fn: (MalAtom, MalVal) throws -> MalVal) throws -> MalVal { - return try with_two_parameters(args) { (arg1, arg2) -> MalVal in - guard let atom = as_atomQ(arg1) else { - try throw_error("expected atom, got \(arg1)") - } - return try fn(atom, arg2) - } -} - -// (MalFunction, MalSequence) -> MalVal - -private func unwrap_args(args: MalSequence, @noescape forFunction fn: (MalFunction, MalSequence) throws -> MalVal) throws -> MalVal { - return try with_two_parameters(args) { (arg1, arg2) -> MalVal in - guard let fn1 = as_functionQ(arg1) else { - try throw_error("expected function, got \(arg1)") - } - guard let seq2 = as_sequenceQ(arg2) else { - try throw_error("expected sequence, got \(arg2)") - } - return try fn(fn1, seq2) - } -} - -// (MalSequence, MalIntType) -> MalVal - -private func unwrap_args(args: MalSequence, @noescape forFunction fn: (MalSequence, MalIntType) throws -> MalVal) throws -> MalVal { - return try with_two_parameters(args) { (arg1, arg2) -> MalVal in - guard let seq = as_sequenceQ(arg1) else { - try throw_error("expected sequence, got \(arg1)") - } - guard let int = as_integerQ(arg2) else { - try throw_error("expected number, got \(arg2)") - } - return try fn(seq, as_inttype(int)) - } -} - -// (MalVal, MalSequence) -> MalVal - -private func unwrap_args(args: MalSequence, @noescape forFunction fn: (MalVal, MalSequence) throws -> MalVal) throws -> MalVal { - return try with_two_parameters(args) { (arg1, arg2) -> MalVal in - guard let seq = as_sequenceQ(arg2) else { - try throw_error("expected sequence, got \(arg2)") - } - return try fn(arg1, seq) - } -} - -// (MalVal, MalVal) -> Bool - -private func unwrap_args(args: MalSequence, @noescape forFunction fn: (MalVal, MalVal) throws -> Bool) throws -> MalVal { - return try with_two_parameters(args) { (arg1, arg2) -> MalVal in - return try fn(arg1, arg2) ? make_true() : make_false() - } -} - -// (MalVal, MalVal) -> MalVal - -private func unwrap_args(args: MalSequence, @noescape forFunction fn: (MalVal, MalVal) throws -> MalVal) throws -> MalVal { - return try with_two_parameters(args) { (arg1, arg2) -> MalVal in - return try fn(arg1, arg2) - } -} - -// ========== Variadic functions ========== - -// (MalVarArgs) -> () - -private func unwrap_args(args: MalSequence, @noescape forFunction fn: (MalVarArgs) throws -> ()) throws -> MalVal { - try fn(MalVarArgs(args)) - return make_nil() -} - -// (MalVarArgs) -> String - -private func unwrap_args(args: MalSequence, @noescape forFunction fn: (MalVarArgs) throws -> String) throws -> MalVal { - return make_string(try fn(MalVarArgs(args))) -} - -// (MalVarArgs) -> MalVal - -private func unwrap_args(args: MalSequence, @noescape forFunction fn: (MalVarArgs) throws -> MalVal) throws -> MalVal { - return try fn(MalVarArgs(args)) -} - -// (MalAtom, MalFunction, MalVarArgs) -> MalVal - -private func unwrap_args(args: MalSequence, @noescape forFunction fn: (MalAtom, MalFunction, MalVarArgs) throws -> MalVal) throws -> MalVal { - return try with_two_parameters(args) { (arg1, arg2) -> MalVal in - guard let atom = as_atomQ(arg1) else { - try throw_error("expected atom, got \(arg1)") - } - guard let fn2 = as_functionQ(arg2) else { - try throw_error("expected function, got \(arg2)") - } - return try fn(atom, fn2, MalVarArgs(as_sequence(args.rest()).rest())) - } -} - -// (MalHashMap, MalVarArgs) -> MalVal - -private func unwrap_args(args: MalSequence, @noescape forFunction fn: (MalHashMap, MalVarArgs) throws -> MalVal) throws -> MalVal { - return try with_one_parameter(args) { (arg1) -> MalVal in - guard let hash = as_hashmapQ(arg1) else { - try throw_error("expected hashmap, got \(arg1)") - } - return try fn(hash, MalVarArgs(args.rest())) - } -} - -// (MalSequence, MalVarArgs) -> MalVal - -private func unwrap_args(args: MalSequence, @noescape forFunction fn: (MalSequence, MalVarArgs) throws -> MalVal) throws -> MalVal { - return try with_one_parameter(args) { (arg1) -> MalVal in - guard let seq = as_sequenceQ(arg1) else { - try throw_error("expected sequence, got \(arg1)") - } - return try fn(seq, MalVarArgs(args.rest())) - } -} - -// *o*o*o*o*o*o*o*o*o*o*o*o*o*o*o*o*o*o*o*o*o*o*o*o*o*o*o*o*o*o*o*o*o*o*o*o*o*o*o*o*o*o*o*o* - -let ns: [String: MalBuiltin.Signature] = [ - "=": { try unwrap_args($0, forFunction: fn_eq) }, - "throw": { try unwrap_args($0, forFunction: fn_throw) }, - - "nil?": { try unwrap_args($0, forFunction: fn_nilQ) }, - "true?": { try unwrap_args($0, forFunction: fn_trueQ) }, - "false?": { try unwrap_args($0, forFunction: fn_falseQ) }, - "string?": { try unwrap_args($0, forFunction: fn_stringQ) }, - "symbol": { try unwrap_args($0, forFunction: fn_symbol) }, - "symbol?": { try unwrap_args($0, forFunction: fn_symbolQ) }, - "keyword": { try unwrap_args($0, forFunction: fn_keyword) }, - "keyword?": { try unwrap_args($0, forFunction: fn_keywordQ) }, - - "pr-str": { try unwrap_args($0, forFunction: fn_prstr) }, - "str": { try unwrap_args($0, forFunction: fn_str) }, - "prn": { try unwrap_args($0, forFunction: fn_prn) }, - "println": { try unwrap_args($0, forFunction: fn_println) }, - "read-string": { try unwrap_args($0, forFunction: fn_readstring) }, - "readline": { try unwrap_args($0, forFunction: fn_readline) }, - "slurp": { try unwrap_args($0, forFunction: fn_slurp) }, - - "<": { try unwrap_args($0, forFunction: fn_lt) }, - "<=": { try unwrap_args($0, forFunction: fn_lte) }, - ">": { try unwrap_args($0, forFunction: fn_gt) }, - ">=": { try unwrap_args($0, forFunction: fn_gte) }, - "+": { try unwrap_args($0, forFunction: fn_add) }, - "-": { try unwrap_args($0, forFunction: fn_subtract) }, - "*": { try unwrap_args($0, forFunction: fn_multiply) }, - "/": { try unwrap_args($0, forFunction: fn_divide) }, - "time-ms": { try unwrap_args($0, forFunction: fn_timems) }, - - "list": { try unwrap_args($0, forFunction: fn_list) }, - "list?": { try unwrap_args($0, forFunction: fn_listQ) }, - "vector": { try unwrap_args($0, forFunction: fn_vector) }, - "vector?": { try unwrap_args($0, forFunction: fn_vectorQ) }, - "hash-map": { try unwrap_args($0, forFunction: fn_hashmap) }, - "map?": { try unwrap_args($0, forFunction: fn_hashmapQ) }, - "assoc": { try unwrap_args($0, forFunction: fn_assoc) }, - "dissoc": { try unwrap_args($0, forFunction: fn_dissoc) }, - "get": { try unwrap_args($0, forFunction: fn_get) }, - "contains?": { try unwrap_args($0, forFunction: fn_containsQ) }, - "keys": { try unwrap_args($0, forFunction: fn_keys) }, - "vals": { try unwrap_args($0, forFunction: fn_values) }, - - "sequential?": { try unwrap_args($0, forFunction: fn_sequentialQ) }, - "cons": { try unwrap_args($0, forFunction: fn_cons) }, - "concat": { try unwrap_args($0, forFunction: fn_concat) }, - "nth": { try unwrap_args($0, forFunction: fn_nth) }, - "first": { try unwrap_args($0, forFunction: fn_first) }, - "rest": { try unwrap_args($0, forFunction: fn_rest) }, - "empty?": { try unwrap_args($0, forFunction: fn_emptyQ) }, - "count": { try unwrap_args($0, forFunction: fn_count) }, - "apply": { try unwrap_args($0, forFunction: fn_apply) }, - "map": { try unwrap_args($0, forFunction: fn_map) }, - - "conj": { try unwrap_args($0, forFunction: fn_conj) }, - "seq": { try unwrap_args($0, forFunction: fn_seq) }, - - "meta": { try unwrap_args($0, forFunction: fn_meta) }, - "with-meta": { try unwrap_args($0, forFunction: fn_withmeta) }, - "atom": { try unwrap_args($0, forFunction: fn_atom) }, - "atom?": { try unwrap_args($0, forFunction: fn_atomQ) }, - "deref": { try unwrap_args($0, forFunction: fn_deref) }, - "reset!": { try unwrap_args($0, forFunction: fn_resetBang) }, - "swap!": { try unwrap_args($0, forFunction: fn_swapBang) }, -] - -func load_builtins(env: Environment) { - for (name, fn) in ns { - env.set(as_symbol(make_symbol(name)), make_builtin(fn)) - } -} diff --git a/swift/env.swift b/swift/env.swift deleted file mode 100644 index ba6205d81f..0000000000 --- a/swift/env.swift +++ /dev/null @@ -1,114 +0,0 @@ -//****************************************************************************** -// MAL - env -//****************************************************************************** - -import Foundation - -typealias EnvironmentVars = [MalSymbol: MalVal] - -private let kSymbolAmpersand = as_symbol(make_symbol("&")) -private let kSymbolNil = as_symbol(make_symbol("")) -private let kNil = make_nil() - -final class Environment { - init(outer: Environment?) { - self.outer = outer - } - - func set_bindings(binds: MalSequence, with_exprs exprs: MalSequence) throws -> MalVal { - for var index: MalIntType = 0; index < binds.count; ++index { - guard let sym = as_symbolQ(try! binds.nth(index)) else { - try throw_error("an entry in binds was not a symbol: index=\(index), binds[index]=\(try! binds.nth(index))") - } - if sym != kSymbolAmpersand { - if index < exprs.count { - set(sym, try! exprs.nth(index)) - } else { - set(sym, kNil) - } - continue - } - - guard (index + 1) < binds.count else { - try throw_error("found & but no symbol") - } - guard let rest_sym = as_symbolQ(try! binds.nth(index + 1)) else { - try throw_error("& was not followed by a symbol: index=\(index), binds[index]=\(try! binds.nth(index))") - } - let rest = exprs.range_from(index, to: exprs.count) - set(rest_sym, rest) - break - } - return kNil - } - - // In this implementation, rather than storing everything in a dictionary, - // we optimize for small environments by having a hard-coded set of four - // slots. We use these slots when creating small environments, such as when - // a function is invoked. Testing shows that supporting up to four variables - // in this way is a good trade-off. Otherwise, if we have more than four - // variables, we switch over to using a dictionary. Testing also shows that - // trying to use both the slots and the dictionary for large environments is - // not as efficient as just completely switching over to the dictionary. - // - // Interestingly, even though the MalVal return value is hardly ever used at - // the call site, removing it and returning nothing is a performance loss. - // This is because returning 'value' allows the compiler to skip calling - // swift_release on it. The result is that set() calls swift_release twice - // (on self and sym), as opposed to three times (on self, sym, and value) if - // it were to return something other than one of the parameters. - - func set(sym: MalSymbol, _ value: MalVal) -> MalVal { - if num_bindings == 0 { - slot_name0 = sym; slot_value0 = value; ++num_bindings - } else if num_bindings == 1 { - if slot_name0 == sym { slot_value0 = value } - else { slot_name1 = sym; slot_value1 = value; ++num_bindings } - } else if num_bindings == 2 { - if slot_name0 == sym { slot_value0 = value } - else if slot_name1 == sym { slot_value1 = value } - else { slot_name2 = sym; slot_value2 = value; ++num_bindings } - } else if num_bindings == 3 { - if slot_name0 == sym { slot_value0 = value } - else if slot_name1 == sym { slot_value1 = value } - else if slot_name2 == sym { slot_value2 = value } - else { slot_name3 = sym; slot_value3 = value; ++num_bindings } - } else if num_bindings == 4 { - if slot_name0 == sym { slot_value0 = value } - else if slot_name1 == sym { slot_value1 = value } - else if slot_name2 == sym { slot_value2 = value } - else if slot_name3 == sym { slot_value3 = value } - else { - data[slot_name0] = slot_value0 - data[slot_name1] = slot_value1 - data[slot_name2] = slot_value2 - data[slot_name3] = slot_value3 - data[sym] = value; ++num_bindings - } - } else { - data[sym] = value - } - return value - } - - func get(sym: MalSymbol) -> MalVal? { - if num_bindings > 4 { if let val = data[sym] { return val }; return outer?.get(sym) } - if num_bindings > 3 { if slot_name3 == sym { return slot_value3 } } - if num_bindings > 2 { if slot_name2 == sym { return slot_value2 } } - if num_bindings > 1 { if slot_name1 == sym { return slot_value1 } } - if num_bindings > 0 { if slot_name0 == sym { return slot_value0 } } - return outer?.get(sym) - } - - private var outer: Environment? - private var data = EnvironmentVars() - private var num_bindings = 0 - private var slot_name0 = kSymbolNil - private var slot_name1 = kSymbolNil - private var slot_name2 = kSymbolNil - private var slot_name3 = kSymbolNil - private var slot_value0 = kNil - private var slot_value1 = kNil - private var slot_value2 = kNil - private var slot_value3 = kNil -} diff --git a/swift/main.swift b/swift/main.swift deleted file mode 100644 index 428e0578ff..0000000000 --- a/swift/main.swift +++ /dev/null @@ -1,18 +0,0 @@ -//****************************************************************************** -// MAL - main -//****************************************************************************** - -// Swift requires that main() be invoked from a file named "main.swift". See the -// paragraph "Application Entry Points and “main.swift” on -// https://developer.apple.com/swift/blog/?id=7: -// -// You’ll notice that earlier we said top-level code isn’t allowed in most -// of your app’s source files. The exception is a special file named -// “main.swift”, which behaves much like a playground file, but is built -// with your app’s source code. The “main.swift” file can contain top-level -// code, and the order-dependent rules apply as well. In effect, the first -// line of code to run in “main.swift” is implicitly defined as the main -// entrypoint for the program. This allows the minimal Swift program to be -// a single line — as long as that line is in “main.swift”. - -main() diff --git a/swift/printer.swift b/swift/printer.swift deleted file mode 100644 index c6ed030048..0000000000 --- a/swift/printer.swift +++ /dev/null @@ -1,27 +0,0 @@ -//****************************************************************************** -// MAL - printer -//****************************************************************************** - -import Foundation - -var MalValPrintReadably = true - -func with_print_readably(print_readably: Bool, fn: () -> T) -> T { - let old = MalValPrintReadably - MalValPrintReadably = print_readably - let result = fn() - MalValPrintReadably = old - return result -} - -func pr_str(m: MalVal, _ print_readably: Bool = MalValPrintReadably) -> String { - return with_print_readably(print_readably) { - if is_string(m) { - return print_readably ? escape(m.description) : m.description - } - if is_keyword(m) { - return ":\(m.description)" - } - return m.description - } -} diff --git a/swift/reader.swift b/swift/reader.swift deleted file mode 100644 index 195cfe36b4..0000000000 --- a/swift/reader.swift +++ /dev/null @@ -1,199 +0,0 @@ -//****************************************************************************** -// MAL - reader -//****************************************************************************** - -import Foundation - -private let kSymbolWithMeta = make_symbol("with-meta") -private let kSymbolDeref = make_symbol("deref") - -private let token_pattern = - "[[:space:],]*" + // Skip whitespace: a sequence of zero or more commas or [:space:]'s - "(" + - "~@" + // Literal "~@" - "|" + - "[\\[\\]{}()`'~^@]" + // Punctuation: Any one of []{}()`'~^@ - "|" + - "\"(?:\\\\.|[^\\\\\"])*\"" + // Quoted string: characters other than \ or ", or any escaped characters - "|" + - ";.*" + // Comment: semicolon followed by anything - "|" + - "[^[:space:]\\[\\]{}()`'\",;]*" + // Symbol, keyword, number, nil, true, false: any sequence of chars but [:space:] or []{}()`'",; - ")" - -private let atom_pattern = - "(^;.*$)" + // Comment - "|" + - "(^-?[0-9]+$)" + // Integer - "|" + - "(^-?[0-9][0-9.]*$)" + // Float - "|" + - "(^nil$)" + // nil - "|" + - "(^true$)" + // true - "|" + - "(^false$)" + // false - "|" + - "(^\".*\"$)" + // String - "|" + - "(:.*)" + // Keyword - "|" + - "(^[^\"]*$)" // Symbol - -private var token_regex: NSRegularExpression = try! NSRegularExpression(pattern: token_pattern, options: NSRegularExpressionOptions()) -private var atom_regex: NSRegularExpression = try! NSRegularExpression(pattern: atom_pattern, options: NSRegularExpressionOptions()) - -private final class Reader { - - init(_ tokens: [String]) { - self.tokens = tokens - self.index = 0 - } - - func next() -> String? { - let token = peek() - increment() - return token - } - - func peek() -> String? { - if index < tokens.count { - return tokens[index] - } - return nil - } - - private func increment() { - ++index - } - - private let tokens: [String] - private var index: Int -} - -private func tokenizer(s: String) -> [String] { - var tokens = [String]() - let range = NSMakeRange(0, s.characters.count) - let matches = token_regex.matchesInString(s, options: NSMatchingOptions(), range: range) - for match in matches { - if match.range.length > 0 { - let token = (s as NSString).substringWithRange(match.rangeAtIndex(1)) - tokens.append(token) - } - } - return tokens -} - -private func have_match(match: NSTextCheckingResult, at_index index: Int) -> Bool { - return Int64(match.rangeAtIndex(index).location) < LLONG_MAX -} - -private func read_atom(token: String) throws -> MalVal { - let range = NSMakeRange(0, token.characters.count) - let matches = atom_regex.matchesInString(token, options: NSMatchingOptions(), range: range) - for match in matches { - if have_match(match, at_index: 1) { // Comment - return make_comment() - } else if have_match(match, at_index: 2) { // Integer - guard let value = NSNumberFormatter().numberFromString(token)?.longLongValue else { - try throw_error("invalid integer: \(token)") - } - return make_integer(value) - } else if have_match(match, at_index: 3) { // Float - guard let value = NSNumberFormatter().numberFromString(token)?.doubleValue else { - try throw_error("invalid float: \(token)") - } - return make_float(value) - } else if have_match(match, at_index: 4) { // nil - return make_nil() - } else if have_match(match, at_index: 5) { // true - return make_true() - } else if have_match(match, at_index: 6) { // false - return make_false() - } else if have_match(match, at_index: 7) { // String - return make_string(unescape(token)) - } else if have_match(match, at_index: 8) { // Keyword - return make_keyword(token[token.startIndex.successor() ..< token.endIndex]) - } else if have_match(match, at_index: 9) { // Symbol - return make_symbol(token) - } - } - try throw_error("Unknown token=\(token)") -} - -private func read_elements(r: Reader, _ open: String, _ close: String) throws -> [MalVal] { - var list = [MalVal]() - while let token = r.peek() { - if token == close { - r.increment() // Consume the closing paren - return list - } else { - let item = try read_form(r) - if !is_comment(item) { - list.append(item) - } - } - } - try throw_error("ran out of tokens -- possibly unbalanced ()'s") -} - -private func read_list(r: Reader) throws -> MalVal { - return make_list(try read_elements(r, "(", ")")) -} - -private func read_vector(r: Reader) throws -> MalVal { - return make_vector(try read_elements(r, "[", "]")) -} - -private func read_hashmap(r: Reader) throws -> MalVal { - return make_hashmap(try read_elements(r, "{", "}")) -} - -private func common_quote(r: Reader, _ symbol: String) throws -> MalVal { - let next = try read_form(r) - return make_list_from(make_symbol(symbol), next) -} - -private func read_form(r: Reader) throws -> MalVal { - if let token = r.next() { - switch token { - case "(": - return try read_list(r) - case ")": - try throw_error("unexpected \")\"") - case "[": - return try read_vector(r) - case "]": - try throw_error("unexpected \"]\"") - case "{": - return try read_hashmap(r) - case "}": - try throw_error("unexpected \"}\"") - case "`": - return try common_quote(r, "quasiquote") - case "'": - return try common_quote(r, "quote") - case "~": - return try common_quote(r, "unquote") - case "~@": - return try common_quote(r, "splice-unquote") - case "^": - let meta = try read_form(r) - let form = try read_form(r) - return make_list_from(kSymbolWithMeta, form, meta) - case "@": - let form = try read_form(r) - return make_list_from(kSymbolDeref, form) - default: - return try read_atom(token) - } - } - try throw_error("ran out of tokens -- possibly unbalanced ()'s") -} - -func read_str(s: String) throws -> MalVal { - let tokens = tokenizer(s) - let reader = Reader(tokens) - let obj = try read_form(reader) - return obj -} diff --git a/swift/readline.swift b/swift/readline.swift deleted file mode 100644 index 3cb00845f2..0000000000 --- a/swift/readline.swift +++ /dev/null @@ -1,46 +0,0 @@ -//****************************************************************************** -// MAL - readline -//****************************************************************************** - -import Foundation - -private let HISTORY_FILE = "~/.mal-history" - -private func with_history_file(do_to_history_file: (UnsafePointer) -> ()) { - HISTORY_FILE.withCString { - (c_str) -> () in - let abs_path = tilde_expand(UnsafeMutablePointer(c_str)) - if abs_path != nil { - do_to_history_file(abs_path) - free(abs_path) - } - } -} - -func load_history_file() { - using_history() - with_history_file { - let _ = read_history($0) - } -} - -func save_history_file() { - // Do this? stifle_history(1000) - with_history_file { - let _ = write_history($0) - } -} - -func _readline(prompt: String) -> String? { - let line = prompt.withCString { - (c_str) -> UnsafeMutablePointer in - return readline(c_str) - } - if line != nil { - if let result = String(UTF8String: line) { - add_history(line) - return result - } - } - return nil -} diff --git a/swift/run b/swift/run deleted file mode 100755 index 8ba68a5484..0000000000 --- a/swift/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec $(dirname $0)/${STEP:-stepA_mal} "${@}" diff --git a/swift/step0_repl.swift b/swift/step0_repl.swift deleted file mode 100644 index 1de32e6639..0000000000 --- a/swift/step0_repl.swift +++ /dev/null @@ -1,64 +0,0 @@ -//****************************************************************************** -// MAL - step 0 - repl -//****************************************************************************** -// This file is automatically generated from templates/step.swift. Rather than -// editing it directly, it's probably better to edit templates/step.swift and -// regenerate this file. Otherwise, your change might be lost if/when someone -// else performs that process. -//****************************************************************************** - -import Foundation - -// Parse the string into an AST. -// -private func READ(str: String) -> String { - return str -} - -// Walk the AST and completely evaluate it, handling macro expansions, special -// forms and function calls. -// -private func EVAL(ast: String) -> String { - return ast -} - -// Convert the value into a human-readable string for printing. -// -private func PRINT(exp: String) -> String { - return exp -} - -// Perform the READ and EVAL steps. Useful for when you don't care about the -// printable result. -// -private func RE(text: String) -> String { - let ast = READ(text) - let exp = EVAL(ast) - return exp -} - -// Perform the full READ/EVAL/PRINT, returning a printable string. -// -private func REP(text: String) -> String { - let exp = RE(text) - return PRINT(exp) -} - -// Perform the full REPL. -// -private func REPL() { - while true { - if let text = _readline("user> ") { - print("\(REP(text))") - } else { - print("") - break - } - } -} - -func main() { - load_history_file() - REPL() - save_history_file() -} diff --git a/swift/step1_read_print.swift b/swift/step1_read_print.swift deleted file mode 100644 index ee10da70f5..0000000000 --- a/swift/step1_read_print.swift +++ /dev/null @@ -1,75 +0,0 @@ -//****************************************************************************** -// MAL - step 1 - read/print -//****************************************************************************** -// This file is automatically generated from templates/step.swift. Rather than -// editing it directly, it's probably better to edit templates/step.swift and -// regenerate this file. Otherwise, your change might be lost if/when someone -// else performs that process. -//****************************************************************************** - -import Foundation - -// Parse the string into an AST. -// -private func READ(str: String) throws -> MalVal { - return try read_str(str) -} - -// Walk the AST and completely evaluate it, handling macro expansions, special -// forms and function calls. -// -private func EVAL(ast: MalVal) -> MalVal { - return ast -} - -// Convert the value into a human-readable string for printing. -// -private func PRINT(exp: MalVal) -> String { - return pr_str(exp, true) -} - -// Perform the READ and EVAL steps. Useful for when you don't care about the -// printable result. -// -private func RE(text: String) -> MalVal? { - if !text.isEmpty { - do { - let ast = try READ(text) - return EVAL(ast) - } catch let error as MalException { - print("Error parsing input: \(error)") - } catch { - print("Error parsing input: \(error)") - } - } - return nil -} - -// Perform the full READ/EVAL/PRINT, returning a printable string. -// -private func REP(text: String) -> String? { - let exp = RE(text) - if exp == nil { return nil } - return PRINT(exp!) -} - -// Perform the full REPL. -// -private func REPL() { - while true { - if let text = _readline("user> ") { - if let output = REP(text) { - print("\(output)") - } - } else { - print("") - break - } - } -} - -func main() { - load_history_file() - REPL() - save_history_file() -} diff --git a/swift/step2_eval.swift b/swift/step2_eval.swift deleted file mode 100644 index 52aeab23bb..0000000000 --- a/swift/step2_eval.swift +++ /dev/null @@ -1,170 +0,0 @@ -//****************************************************************************** -// MAL - step 2 - eval -//****************************************************************************** -// This file is automatically generated from templates/step.swift. Rather than -// editing it directly, it's probably better to edit templates/step.swift and -// regenerate this file. Otherwise, your change might be lost if/when someone -// else performs that process. -//****************************************************************************** - -import Foundation - -// Parse the string into an AST. -// -private func READ(str: String) throws -> MalVal { - return try read_str(str) -} - -// Perform a simple evaluation of the `ast` object. If it's a symbol, -// dereference it and return its value. If it's a collection, call EVAL on all -// elements (or just the values, in the case of the hashmap). Otherwise, return -// the object unchanged. -// -private func eval_ast(ast: MalVal, _ env: Environment) throws -> MalVal { - if let symbol = as_symbolQ(ast) { - guard let val = env.get(symbol) else { - try throw_error("'\(symbol)' not found") // Specific text needed to match MAL unit tests - } - return val - } - if let list = as_listQ(ast) { - var result = [MalVal]() - result.reserveCapacity(Int(list.count)) - for item in list { - let eval = try EVAL(item, env) - result.append(eval) - } - return make_list(result) - } - if let vec = as_vectorQ(ast) { - var result = [MalVal]() - result.reserveCapacity(Int(vec.count)) - for item in vec { - let eval = try EVAL(item, env) - result.append(eval) - } - return make_vector(result) - } - if let hash = as_hashmapQ(ast) { - var result = [MalVal]() - result.reserveCapacity(Int(hash.count) * 2) - for (k, v) in hash { - let new_v = try EVAL(v, env) - result.append(k) - result.append(new_v) - } - return make_hashmap(result) - } - return ast -} - -// Walk the AST and completely evaluate it, handling macro expansions, special -// forms and function calls. -// -private func EVAL(ast: MalVal, _ env: Environment) throws -> MalVal { - - if !is_list(ast) { - - // Not a list -- just evaluate and return. - - let answer = try eval_ast(ast, env) - return answer - } - - // Special handling if it's a list. - - let list = as_list(ast) - - if list.isEmpty { - return ast - } - - // Standard list to be applied. Evaluate all the elements first. - - let eval = try eval_ast(ast, env) - - // The result had better be a list and better be non-empty. - - let eval_list = as_list(eval) - if eval_list.isEmpty { - return eval - } - - // Get the first element of the list and execute it. - - let first = eval_list.first() - let rest = as_sequence(eval_list.rest()) - - if let fn = as_builtinQ(first) { - let answer = try fn.apply(rest) - return answer - } - - // The first element wasn't a function to be executed. Return an - // error saying so. - - try throw_error("first list item does not evaluate to a function: \(first)") -} - -// Convert the value into a human-readable string for printing. -// -private func PRINT(exp: MalVal) -> String { - return pr_str(exp, true) -} - -// Perform the READ and EVAL steps. Useful for when you don't care about the -// printable result. -// -private func RE(text: String, _ env: Environment) -> MalVal? { - if !text.isEmpty { - do { - let ast = try READ(text) - do { - return try EVAL(ast, env) - } catch let error as MalException { - print("Error evaluating input: \(error)") - } catch { - print("Error evaluating input: \(error)") - } - } catch let error as MalException { - print("Error parsing input: \(error)") - } catch { - print("Error parsing input: \(error)") - } - } - return nil -} - -// Perform the full READ/EVAL/PRINT, returning a printable string. -// -private func REP(text: String, _ env: Environment) -> String? { - let exp = RE(text, env) - if exp == nil { return nil } - return PRINT(exp!) -} - -// Perform the full REPL. -// -private func REPL(env: Environment) { - while true { - if let text = _readline("user> ") { - if let output = REP(text, env) { - print("\(output)") - } - } else { - print("") - break - } - } -} - -func main() { - let env = Environment(outer: nil) - - load_history_file() - load_builtins(env) - - REPL(env) - - save_history_file() -} diff --git a/swift/step3_env.swift b/swift/step3_env.swift deleted file mode 100644 index 7e3cde9d77..0000000000 --- a/swift/step3_env.swift +++ /dev/null @@ -1,234 +0,0 @@ -//****************************************************************************** -// MAL - step 3 - env -//****************************************************************************** -// This file is automatically generated from templates/step.swift. Rather than -// editing it directly, it's probably better to edit templates/step.swift and -// regenerate this file. Otherwise, your change might be lost if/when someone -// else performs that process. -//****************************************************************************** - -import Foundation - -// Symbols used in this module. -// -private let kValDef = make_symbol("def!") -private let kValLet = make_symbol("let*") -private let kValTry = make_symbol("try*") - -private let kSymbolDef = as_symbol(kValDef) -private let kSymbolLet = as_symbol(kValLet) - -// Parse the string into an AST. -// -private func READ(str: String) throws -> MalVal { - return try read_str(str) -} - -// Perform a simple evaluation of the `ast` object. If it's a symbol, -// dereference it and return its value. If it's a collection, call EVAL on all -// elements (or just the values, in the case of the hashmap). Otherwise, return -// the object unchanged. -// -private func eval_ast(ast: MalVal, _ env: Environment) throws -> MalVal { - if let symbol = as_symbolQ(ast) { - guard let val = env.get(symbol) else { - try throw_error("'\(symbol)' not found") // Specific text needed to match MAL unit tests - } - return val - } - if let list = as_listQ(ast) { - var result = [MalVal]() - result.reserveCapacity(Int(list.count)) - for item in list { - let eval = try EVAL(item, env) - result.append(eval) - } - return make_list(result) - } - if let vec = as_vectorQ(ast) { - var result = [MalVal]() - result.reserveCapacity(Int(vec.count)) - for item in vec { - let eval = try EVAL(item, env) - result.append(eval) - } - return make_vector(result) - } - if let hash = as_hashmapQ(ast) { - var result = [MalVal]() - result.reserveCapacity(Int(hash.count) * 2) - for (k, v) in hash { - let new_v = try EVAL(v, env) - result.append(k) - result.append(new_v) - } - return make_hashmap(result) - } - return ast -} - -// EVALuate "def!". -// -private func eval_def(list: MalSequence, _ env: Environment) throws -> MalVal { - guard list.count == 3 else { - try throw_error("expected 2 arguments to def!, got \(list.count - 1)") - } - let arg1 = try! list.nth(1) - let arg2 = try! list.nth(2) - guard let sym = as_symbolQ(arg1) else { - try throw_error("expected symbol for first argument to def!") - } - let value = try EVAL(arg2, env) - return env.set(sym, value) -} - -// EVALuate "let*". -// -private func eval_let(list: MalSequence, _ env: Environment) throws -> MalVal { - guard list.count == 3 else { - try throw_error("expected 2 arguments to let*, got \(list.count - 1)") - } - let arg1 = try! list.nth(1) - let arg2 = try! list.nth(2) - guard let bindings = as_sequenceQ(arg1) else { - try throw_error("expected list for first argument to let*") - } - guard bindings.count % 2 == 0 else { - try throw_error("expected even number of elements in bindings to let*, got \(bindings.count)") - } - let new_env = Environment(outer: env) - for var index: MalIntType = 0; index < bindings.count; index += 2 { - let binding_name = try! bindings.nth(index) - let binding_value = try! bindings.nth(index + 1) - guard let binding_symbol = as_symbolQ(binding_name) else { - try throw_error("expected symbol for first element in binding pair") - } - let evaluated_value = try EVAL(binding_value, new_env) - new_env.set(binding_symbol, evaluated_value) - } - return try EVAL(arg2, new_env) -} - -// Walk the AST and completely evaluate it, handling macro expansions, special -// forms and function calls. -// -private func EVAL(ast: MalVal, _ env: Environment) throws -> MalVal { - - if !is_list(ast) { - - // Not a list -- just evaluate and return. - - let answer = try eval_ast(ast, env) - return answer - } - - // Special handling if it's a list. - - let list = as_list(ast) - - if list.isEmpty { - return ast - } - - // Check for special forms, where we want to check the operation - // before evaluating all of the parameters. - - let arg0 = list.first() - if let fn_symbol = as_symbolQ(arg0) { - - switch fn_symbol { - case kSymbolDef: return try eval_def(list, env) - case kSymbolLet: return try eval_let(list, env) - default: break - } - } - - // Standard list to be applied. Evaluate all the elements first. - - let eval = try eval_ast(ast, env) - - // The result had better be a list and better be non-empty. - - let eval_list = as_list(eval) - if eval_list.isEmpty { - return eval - } - - // Get the first element of the list and execute it. - - let first = eval_list.first() - let rest = as_sequence(eval_list.rest()) - - if let fn = as_builtinQ(first) { - let answer = try fn.apply(rest) - return answer - } - - // The first element wasn't a function to be executed. Return an - // error saying so. - - try throw_error("first list item does not evaluate to a function: \(first)") -} - -// Convert the value into a human-readable string for printing. -// -private func PRINT(exp: MalVal) -> String { - return pr_str(exp, true) -} - -// Perform the READ and EVAL steps. Useful for when you don't care about the -// printable result. -// -private func RE(text: String, _ env: Environment) -> MalVal? { - if !text.isEmpty { - do { - let ast = try READ(text) - do { - return try EVAL(ast, env) - } catch let error as MalException { - print("Error evaluating input: \(error)") - } catch { - print("Error evaluating input: \(error)") - } - } catch let error as MalException { - print("Error parsing input: \(error)") - } catch { - print("Error parsing input: \(error)") - } - } - return nil -} - -// Perform the full READ/EVAL/PRINT, returning a printable string. -// -private func REP(text: String, _ env: Environment) -> String? { - let exp = RE(text, env) - if exp == nil { return nil } - return PRINT(exp!) -} - -// Perform the full REPL. -// -private func REPL(env: Environment) { - while true { - if let text = _readline("user> ") { - if let output = REP(text, env) { - print("\(output)") - } - } else { - print("") - break - } - } -} - -func main() { - let env = Environment(outer: nil) - - load_history_file() - load_builtins(env) - - REPL(env) - - save_history_file() -} diff --git a/swift/step4_if_fn_do.swift b/swift/step4_if_fn_do.swift deleted file mode 100644 index c27ee29493..0000000000 --- a/swift/step4_if_fn_do.swift +++ /dev/null @@ -1,287 +0,0 @@ -//****************************************************************************** -// MAL - step 4 - if/fn/do -//****************************************************************************** -// This file is automatically generated from templates/step.swift. Rather than -// editing it directly, it's probably better to edit templates/step.swift and -// regenerate this file. Otherwise, your change might be lost if/when someone -// else performs that process. -//****************************************************************************** - -import Foundation - -// Symbols used in this module. -// -private let kValDef = make_symbol("def!") -private let kValDo = make_symbol("do") -private let kValFn = make_symbol("fn*") -private let kValIf = make_symbol("if") -private let kValLet = make_symbol("let*") -private let kValTry = make_symbol("try*") - -private let kSymbolDef = as_symbol(kValDef) -private let kSymbolDo = as_symbol(kValDo) -private let kSymbolFn = as_symbol(kValFn) -private let kSymbolIf = as_symbol(kValIf) -private let kSymbolLet = as_symbol(kValLet) - -// Parse the string into an AST. -// -private func READ(str: String) throws -> MalVal { - return try read_str(str) -} - -// Perform a simple evaluation of the `ast` object. If it's a symbol, -// dereference it and return its value. If it's a collection, call EVAL on all -// elements (or just the values, in the case of the hashmap). Otherwise, return -// the object unchanged. -// -private func eval_ast(ast: MalVal, _ env: Environment) throws -> MalVal { - if let symbol = as_symbolQ(ast) { - guard let val = env.get(symbol) else { - try throw_error("'\(symbol)' not found") // Specific text needed to match MAL unit tests - } - return val - } - if let list = as_listQ(ast) { - var result = [MalVal]() - result.reserveCapacity(Int(list.count)) - for item in list { - let eval = try EVAL(item, env) - result.append(eval) - } - return make_list(result) - } - if let vec = as_vectorQ(ast) { - var result = [MalVal]() - result.reserveCapacity(Int(vec.count)) - for item in vec { - let eval = try EVAL(item, env) - result.append(eval) - } - return make_vector(result) - } - if let hash = as_hashmapQ(ast) { - var result = [MalVal]() - result.reserveCapacity(Int(hash.count) * 2) - for (k, v) in hash { - let new_v = try EVAL(v, env) - result.append(k) - result.append(new_v) - } - return make_hashmap(result) - } - return ast -} - -// EVALuate "def!". -// -private func eval_def(list: MalSequence, _ env: Environment) throws -> MalVal { - guard list.count == 3 else { - try throw_error("expected 2 arguments to def!, got \(list.count - 1)") - } - let arg1 = try! list.nth(1) - let arg2 = try! list.nth(2) - guard let sym = as_symbolQ(arg1) else { - try throw_error("expected symbol for first argument to def!") - } - let value = try EVAL(arg2, env) - return env.set(sym, value) -} - -// EVALuate "let*". -// -private func eval_let(list: MalSequence, _ env: Environment) throws -> MalVal { - guard list.count == 3 else { - try throw_error("expected 2 arguments to let*, got \(list.count - 1)") - } - let arg1 = try! list.nth(1) - let arg2 = try! list.nth(2) - guard let bindings = as_sequenceQ(arg1) else { - try throw_error("expected list for first argument to let*") - } - guard bindings.count % 2 == 0 else { - try throw_error("expected even number of elements in bindings to let*, got \(bindings.count)") - } - let new_env = Environment(outer: env) - for var index: MalIntType = 0; index < bindings.count; index += 2 { - let binding_name = try! bindings.nth(index) - let binding_value = try! bindings.nth(index + 1) - guard let binding_symbol = as_symbolQ(binding_name) else { - try throw_error("expected symbol for first element in binding pair") - } - let evaluated_value = try EVAL(binding_value, new_env) - new_env.set(binding_symbol, evaluated_value) - } - return try EVAL(arg2, new_env) -} - -// EVALuate "do". -// -private func eval_do(list: MalSequence, _ env: Environment) throws -> MalVal { - let evaluated_ast = try eval_ast(list.rest(), env) - let evaluated_seq = as_sequence(evaluated_ast) - return evaluated_seq.last() -} - -// EVALuate "if". -// -private func eval_if(list: MalSequence, _ env: Environment) throws -> MalVal { - guard list.count >= 3 else { - try throw_error("expected at least 2 arguments to if, got \(list.count - 1)") - } - let cond_result = try EVAL(try! list.nth(1), env) - var new_ast: MalVal - if is_truthy(cond_result) { - new_ast = try! list.nth(2) - } else if list.count == 4 { - new_ast = try! list.nth(3) - } else { - return make_nil() - } - return try EVAL(new_ast, env) -} - -// EVALuate "fn*". -// -private func eval_fn(list: MalSequence, _ env: Environment) throws -> MalVal { - guard list.count == 3 else { - try throw_error("expected 2 arguments to fn*, got \(list.count - 1)") - } - guard let seq = as_sequenceQ(try! list.nth(1)) else { - try throw_error("expected list or vector for first argument to fn*") - } - return make_closure((eval: EVAL, args: seq, body: try! list.nth(2), env: env)) -} - -// Walk the AST and completely evaluate it, handling macro expansions, special -// forms and function calls. -// -private func EVAL(ast: MalVal, _ env: Environment) throws -> MalVal { - - if !is_list(ast) { - - // Not a list -- just evaluate and return. - - let answer = try eval_ast(ast, env) - return answer - } - - // Special handling if it's a list. - - let list = as_list(ast) - - if list.isEmpty { - return ast - } - - // Check for special forms, where we want to check the operation - // before evaluating all of the parameters. - - let arg0 = list.first() - if let fn_symbol = as_symbolQ(arg0) { - - switch fn_symbol { - case kSymbolDef: return try eval_def(list, env) - case kSymbolLet: return try eval_let(list, env) - case kSymbolDo: return try eval_do(list, env) - case kSymbolIf: return try eval_if(list, env) - case kSymbolFn: return try eval_fn(list, env) - default: break - } - } - - // Standard list to be applied. Evaluate all the elements first. - - let eval = try eval_ast(ast, env) - - // The result had better be a list and better be non-empty. - - let eval_list = as_list(eval) - if eval_list.isEmpty { - return eval - } - - // Get the first element of the list and execute it. - - let first = eval_list.first() - let rest = as_sequence(eval_list.rest()) - - if let fn = as_builtinQ(first) { - let answer = try fn.apply(rest) - return answer - } else if let fn = as_closureQ(first) { - let new_env = Environment(outer: fn.env) - let _ = try new_env.set_bindings(fn.args, with_exprs: rest) - let answer = try EVAL(fn.body, new_env) - return answer - } - - // The first element wasn't a function to be executed. Return an - // error saying so. - - try throw_error("first list item does not evaluate to a function: \(first)") -} - -// Convert the value into a human-readable string for printing. -// -private func PRINT(exp: MalVal) -> String { - return pr_str(exp, true) -} - -// Perform the READ and EVAL steps. Useful for when you don't care about the -// printable result. -// -private func RE(text: String, _ env: Environment) -> MalVal? { - if !text.isEmpty { - do { - let ast = try READ(text) - do { - return try EVAL(ast, env) - } catch let error as MalException { - print("Error evaluating input: \(error)") - } catch { - print("Error evaluating input: \(error)") - } - } catch let error as MalException { - print("Error parsing input: \(error)") - } catch { - print("Error parsing input: \(error)") - } - } - return nil -} - -// Perform the full READ/EVAL/PRINT, returning a printable string. -// -private func REP(text: String, _ env: Environment) -> String? { - let exp = RE(text, env) - if exp == nil { return nil } - return PRINT(exp!) -} - -// Perform the full REPL. -// -private func REPL(env: Environment) { - while true { - if let text = _readline("user> ") { - if let output = REP(text, env) { - print("\(output)") - } - } else { - print("") - break - } - } -} - -func main() { - let env = Environment(outer: nil) - - load_history_file() - load_builtins(env) - - RE("(def! not (fn* (a) (if a false true)))", env) - REPL(env) - - save_history_file() -} diff --git a/swift/step5_tco.swift b/swift/step5_tco.swift deleted file mode 100644 index 286414ee8b..0000000000 --- a/swift/step5_tco.swift +++ /dev/null @@ -1,382 +0,0 @@ -//****************************************************************************** -// MAL - step 5 - tco -//****************************************************************************** -// This file is automatically generated from templates/step.swift. Rather than -// editing it directly, it's probably better to edit templates/step.swift and -// regenerate this file. Otherwise, your change might be lost if/when someone -// else performs that process. -//****************************************************************************** - -import Foundation - -// The number of times EVAL has been entered recursively. We keep track of this -// so that we can protect against overrunning the stack. -// -private var EVAL_level = 0 - -// The maximum number of times we let EVAL recurse before throwing an exception. -// Testing puts this at some place between 1800 and 1900. Let's keep it at 500 -// for safety's sake. -// -private let EVAL_leval_max = 500 - -// Control whether or not tail-call optimization (TCO) is enabled. We want it -// `true` most of the time, but may disable it for debugging purposes (it's -// easier to get a meaningful backtrace that way). -// -private let TCO = true - -// Control whether or not we emit debugging statements in EVAL. -// -private let DEBUG_EVAL = false - -// String used to prefix information logged in EVAL. Increasing lengths of the -// string are used the more EVAL is recursed. -// -private let INDENT_TEMPLATE = "|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" - -// Holds the prefix of INDENT_TEMPLATE used for actual logging. -// -private var indent = String() - -// Symbols used in this module. -// -private let kValDef = make_symbol("def!") -private let kValDo = make_symbol("do") -private let kValFn = make_symbol("fn*") -private let kValIf = make_symbol("if") -private let kValLet = make_symbol("let*") -private let kValTry = make_symbol("try*") - -private let kSymbolDef = as_symbol(kValDef) -private let kSymbolDo = as_symbol(kValDo) -private let kSymbolFn = as_symbol(kValFn) -private let kSymbolIf = as_symbol(kValIf) -private let kSymbolLet = as_symbol(kValLet) - -func substring(s: String, _ begin: Int, _ end: Int) -> String { - return s[s.startIndex.advancedBy(begin) ..< s.startIndex.advancedBy(end)] -} - -// Parse the string into an AST. -// -private func READ(str: String) throws -> MalVal { - return try read_str(str) -} - -// Perform a simple evaluation of the `ast` object. If it's a symbol, -// dereference it and return its value. If it's a collection, call EVAL on all -// elements (or just the values, in the case of the hashmap). Otherwise, return -// the object unchanged. -// -private func eval_ast(ast: MalVal, _ env: Environment) throws -> MalVal { - if let symbol = as_symbolQ(ast) { - guard let val = env.get(symbol) else { - try throw_error("'\(symbol)' not found") // Specific text needed to match MAL unit tests - } - return val - } - if let list = as_listQ(ast) { - var result = [MalVal]() - result.reserveCapacity(Int(list.count)) - for item in list { - let eval = try EVAL(item, env) - result.append(eval) - } - return make_list(result) - } - if let vec = as_vectorQ(ast) { - var result = [MalVal]() - result.reserveCapacity(Int(vec.count)) - for item in vec { - let eval = try EVAL(item, env) - result.append(eval) - } - return make_vector(result) - } - if let hash = as_hashmapQ(ast) { - var result = [MalVal]() - result.reserveCapacity(Int(hash.count) * 2) - for (k, v) in hash { - let new_v = try EVAL(v, env) - result.append(k) - result.append(new_v) - } - return make_hashmap(result) - } - return ast -} - -private enum TCOVal { - case NoResult - case Return(MalVal) - case Continue(MalVal, Environment) - - init() { self = .NoResult } - init(_ result: MalVal) { self = .Return(result) } - init(_ ast: MalVal, _ env: Environment) { self = .Continue(ast, env) } -} - -// EVALuate "def!". -// -private func eval_def(list: MalSequence, _ env: Environment) throws -> TCOVal { - guard list.count == 3 else { - try throw_error("expected 2 arguments to def!, got \(list.count - 1)") - } - let arg1 = try! list.nth(1) - let arg2 = try! list.nth(2) - guard let sym = as_symbolQ(arg1) else { - try throw_error("expected symbol for first argument to def!") - } - let value = try EVAL(arg2, env) - return TCOVal(env.set(sym, value)) -} - -// EVALuate "let*". -// -private func eval_let(list: MalSequence, _ env: Environment) throws -> TCOVal { - guard list.count == 3 else { - try throw_error("expected 2 arguments to let*, got \(list.count - 1)") - } - let arg1 = try! list.nth(1) - let arg2 = try! list.nth(2) - guard let bindings = as_sequenceQ(arg1) else { - try throw_error("expected list for first argument to let*") - } - guard bindings.count % 2 == 0 else { - try throw_error("expected even number of elements in bindings to let*, got \(bindings.count)") - } - let new_env = Environment(outer: env) - for var index: MalIntType = 0; index < bindings.count; index += 2 { - let binding_name = try! bindings.nth(index) - let binding_value = try! bindings.nth(index + 1) - guard let binding_symbol = as_symbolQ(binding_name) else { - try throw_error("expected symbol for first element in binding pair") - } - let evaluated_value = try EVAL(binding_value, new_env) - new_env.set(binding_symbol, evaluated_value) - } - if TCO { - return TCOVal(arg2, new_env) - } - return TCOVal(try EVAL(arg2, new_env)) -} - -// EVALuate "do". -// -private func eval_do(list: MalSequence, _ env: Environment) throws -> TCOVal { - if TCO { - let _ = try eval_ast(list.range_from(1, to: list.count-1), env) - return TCOVal(list.last(), env) - } - - let evaluated_ast = try eval_ast(list.rest(), env) - let evaluated_seq = as_sequence(evaluated_ast) - return TCOVal(evaluated_seq.last()) -} - -// EVALuate "if". -// -private func eval_if(list: MalSequence, _ env: Environment) throws -> TCOVal { - guard list.count >= 3 else { - try throw_error("expected at least 2 arguments to if, got \(list.count - 1)") - } - let cond_result = try EVAL(try! list.nth(1), env) - var new_ast: MalVal - if is_truthy(cond_result) { - new_ast = try! list.nth(2) - } else if list.count == 4 { - new_ast = try! list.nth(3) - } else { - return TCOVal(make_nil()) - } - if TCO { - return TCOVal(new_ast, env) - } - return TCOVal(try EVAL(new_ast, env)) -} - -// EVALuate "fn*". -// -private func eval_fn(list: MalSequence, _ env: Environment) throws -> TCOVal { - guard list.count == 3 else { - try throw_error("expected 2 arguments to fn*, got \(list.count - 1)") - } - guard let seq = as_sequenceQ(try! list.nth(1)) else { - try throw_error("expected list or vector for first argument to fn*") - } - return TCOVal(make_closure((eval: EVAL, args: seq, body: try! list.nth(2), env: env))) -} - -// Walk the AST and completely evaluate it, handling macro expansions, special -// forms and function calls. -// -private func EVAL(var ast: MalVal, var _ env: Environment) throws -> MalVal { - EVAL_level++ - defer { EVAL_level-- } - guard EVAL_level <= EVAL_leval_max else { - try throw_error("Recursing too many levels (> \(EVAL_leval_max))") - } - - if DEBUG_EVAL { - indent = substring(INDENT_TEMPLATE, 0, EVAL_level) - } - - while true { - if DEBUG_EVAL { print("\(indent)> \(ast)") } - - if !is_list(ast) { - - // Not a list -- just evaluate and return. - - let answer = try eval_ast(ast, env) - if DEBUG_EVAL { print("\(indent)>>> \(answer)") } - return answer - } - - // Special handling if it's a list. - - let list = as_list(ast) - if DEBUG_EVAL { print("\(indent)>. \(list)") } - - if list.isEmpty { - return ast - } - - // Check for special forms, where we want to check the operation - // before evaluating all of the parameters. - - let arg0 = list.first() - if let fn_symbol = as_symbolQ(arg0) { - let res: TCOVal - - switch fn_symbol { - case kSymbolDef: res = try eval_def(list, env) - case kSymbolLet: res = try eval_let(list, env) - case kSymbolDo: res = try eval_do(list, env) - case kSymbolIf: res = try eval_if(list, env) - case kSymbolFn: res = try eval_fn(list, env) - default: res = TCOVal() - } - switch res { - case let .Return(result): return result - case let .Continue(new_ast, new_env): ast = new_ast; env = new_env; continue - case .NoResult: break - } - } - - // Standard list to be applied. Evaluate all the elements first. - - let eval = try eval_ast(ast, env) - - // The result had better be a list and better be non-empty. - - let eval_list = as_list(eval) - if eval_list.isEmpty { - return eval - } - - if DEBUG_EVAL { print("\(indent)>> \(eval)") } - - // Get the first element of the list and execute it. - - let first = eval_list.first() - let rest = as_sequence(eval_list.rest()) - - if let fn = as_builtinQ(first) { - let answer = try fn.apply(rest) - if DEBUG_EVAL { print("\(indent)>>> \(answer)") } - return answer - } else if let fn = as_closureQ(first) { - let new_env = Environment(outer: fn.env) - let _ = try new_env.set_bindings(fn.args, with_exprs: rest) - if TCO { - env = new_env - ast = fn.body - continue - } - let answer = try EVAL(fn.body, new_env) - if DEBUG_EVAL { print("\(indent)>>> \(answer)") } - return answer - } - - // The first element wasn't a function to be executed. Return an - // error saying so. - - try throw_error("first list item does not evaluate to a function: \(first)") - } -} - -// Convert the value into a human-readable string for printing. -// -private func PRINT(exp: MalVal) -> String { - return pr_str(exp, true) -} - -// Perform the READ and EVAL steps. Useful for when you don't care about the -// printable result. -// -private func RE(text: String, _ env: Environment) -> MalVal? { - if !text.isEmpty { - do { - let ast = try READ(text) - do { - return try EVAL(ast, env) - } catch let error as MalException { - print("Error evaluating input: \(error)") - } catch { - print("Error evaluating input: \(error)") - } - } catch let error as MalException { - print("Error parsing input: \(error)") - } catch { - print("Error parsing input: \(error)") - } - } - return nil -} - -// Perform the full READ/EVAL/PRINT, returning a printable string. -// -private func REP(text: String, _ env: Environment) -> String? { - let exp = RE(text, env) - if exp == nil { return nil } - return PRINT(exp!) -} - -// Perform the full REPL. -// -private func REPL(env: Environment) { - while true { - if let text = _readline("user> ") { - if let output = REP(text, env) { - print("\(output)") - } - } else { - print("") - break - } - } -} - -func main() { - let env = Environment(outer: nil) - - load_history_file() - load_builtins(env) - - RE("(def! not (fn* (a) (if a false true)))", env) - REPL(env) - - save_history_file() -} diff --git a/swift/step6_file.swift b/swift/step6_file.swift deleted file mode 100644 index 45927eae55..0000000000 --- a/swift/step6_file.swift +++ /dev/null @@ -1,420 +0,0 @@ -//****************************************************************************** -// MAL - step 6 - file -//****************************************************************************** -// This file is automatically generated from templates/step.swift. Rather than -// editing it directly, it's probably better to edit templates/step.swift and -// regenerate this file. Otherwise, your change might be lost if/when someone -// else performs that process. -//****************************************************************************** - -import Foundation - -// The number of times EVAL has been entered recursively. We keep track of this -// so that we can protect against overrunning the stack. -// -private var EVAL_level = 0 - -// The maximum number of times we let EVAL recurse before throwing an exception. -// Testing puts this at some place between 1800 and 1900. Let's keep it at 500 -// for safety's sake. -// -private let EVAL_leval_max = 500 - -// Control whether or not tail-call optimization (TCO) is enabled. We want it -// `true` most of the time, but may disable it for debugging purposes (it's -// easier to get a meaningful backtrace that way). -// -private let TCO = true - -// Control whether or not we emit debugging statements in EVAL. -// -private let DEBUG_EVAL = false - -// String used to prefix information logged in EVAL. Increasing lengths of the -// string are used the more EVAL is recursed. -// -private let INDENT_TEMPLATE = "|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" - -// Holds the prefix of INDENT_TEMPLATE used for actual logging. -// -private var indent = String() - -// Symbols used in this module. -// -private let kValArgv = make_symbol("*ARGV*") -private let kValDef = make_symbol("def!") -private let kValDo = make_symbol("do") -private let kValEval = make_symbol("eval") -private let kValFn = make_symbol("fn*") -private let kValIf = make_symbol("if") -private let kValLet = make_symbol("let*") -private let kValTry = make_symbol("try*") - -private let kSymbolArgv = as_symbol(kValArgv) -private let kSymbolDef = as_symbol(kValDef) -private let kSymbolDo = as_symbol(kValDo) -private let kSymbolEval = as_symbol(kValEval) -private let kSymbolFn = as_symbol(kValFn) -private let kSymbolIf = as_symbol(kValIf) -private let kSymbolLet = as_symbol(kValLet) - -func substring(s: String, _ begin: Int, _ end: Int) -> String { - return s[s.startIndex.advancedBy(begin) ..< s.startIndex.advancedBy(end)] -} - -// Parse the string into an AST. -// -private func READ(str: String) throws -> MalVal { - return try read_str(str) -} - -// Perform a simple evaluation of the `ast` object. If it's a symbol, -// dereference it and return its value. If it's a collection, call EVAL on all -// elements (or just the values, in the case of the hashmap). Otherwise, return -// the object unchanged. -// -private func eval_ast(ast: MalVal, _ env: Environment) throws -> MalVal { - if let symbol = as_symbolQ(ast) { - guard let val = env.get(symbol) else { - try throw_error("'\(symbol)' not found") // Specific text needed to match MAL unit tests - } - return val - } - if let list = as_listQ(ast) { - var result = [MalVal]() - result.reserveCapacity(Int(list.count)) - for item in list { - let eval = try EVAL(item, env) - result.append(eval) - } - return make_list(result) - } - if let vec = as_vectorQ(ast) { - var result = [MalVal]() - result.reserveCapacity(Int(vec.count)) - for item in vec { - let eval = try EVAL(item, env) - result.append(eval) - } - return make_vector(result) - } - if let hash = as_hashmapQ(ast) { - var result = [MalVal]() - result.reserveCapacity(Int(hash.count) * 2) - for (k, v) in hash { - let new_v = try EVAL(v, env) - result.append(k) - result.append(new_v) - } - return make_hashmap(result) - } - return ast -} - -private enum TCOVal { - case NoResult - case Return(MalVal) - case Continue(MalVal, Environment) - - init() { self = .NoResult } - init(_ result: MalVal) { self = .Return(result) } - init(_ ast: MalVal, _ env: Environment) { self = .Continue(ast, env) } -} - -// EVALuate "def!". -// -private func eval_def(list: MalSequence, _ env: Environment) throws -> TCOVal { - guard list.count == 3 else { - try throw_error("expected 2 arguments to def!, got \(list.count - 1)") - } - let arg1 = try! list.nth(1) - let arg2 = try! list.nth(2) - guard let sym = as_symbolQ(arg1) else { - try throw_error("expected symbol for first argument to def!") - } - let value = try EVAL(arg2, env) - return TCOVal(env.set(sym, value)) -} - -// EVALuate "let*". -// -private func eval_let(list: MalSequence, _ env: Environment) throws -> TCOVal { - guard list.count == 3 else { - try throw_error("expected 2 arguments to let*, got \(list.count - 1)") - } - let arg1 = try! list.nth(1) - let arg2 = try! list.nth(2) - guard let bindings = as_sequenceQ(arg1) else { - try throw_error("expected list for first argument to let*") - } - guard bindings.count % 2 == 0 else { - try throw_error("expected even number of elements in bindings to let*, got \(bindings.count)") - } - let new_env = Environment(outer: env) - for var index: MalIntType = 0; index < bindings.count; index += 2 { - let binding_name = try! bindings.nth(index) - let binding_value = try! bindings.nth(index + 1) - guard let binding_symbol = as_symbolQ(binding_name) else { - try throw_error("expected symbol for first element in binding pair") - } - let evaluated_value = try EVAL(binding_value, new_env) - new_env.set(binding_symbol, evaluated_value) - } - if TCO { - return TCOVal(arg2, new_env) - } - return TCOVal(try EVAL(arg2, new_env)) -} - -// EVALuate "do". -// -private func eval_do(list: MalSequence, _ env: Environment) throws -> TCOVal { - if TCO { - let _ = try eval_ast(list.range_from(1, to: list.count-1), env) - return TCOVal(list.last(), env) - } - - let evaluated_ast = try eval_ast(list.rest(), env) - let evaluated_seq = as_sequence(evaluated_ast) - return TCOVal(evaluated_seq.last()) -} - -// EVALuate "if". -// -private func eval_if(list: MalSequence, _ env: Environment) throws -> TCOVal { - guard list.count >= 3 else { - try throw_error("expected at least 2 arguments to if, got \(list.count - 1)") - } - let cond_result = try EVAL(try! list.nth(1), env) - var new_ast: MalVal - if is_truthy(cond_result) { - new_ast = try! list.nth(2) - } else if list.count == 4 { - new_ast = try! list.nth(3) - } else { - return TCOVal(make_nil()) - } - if TCO { - return TCOVal(new_ast, env) - } - return TCOVal(try EVAL(new_ast, env)) -} - -// EVALuate "fn*". -// -private func eval_fn(list: MalSequence, _ env: Environment) throws -> TCOVal { - guard list.count == 3 else { - try throw_error("expected 2 arguments to fn*, got \(list.count - 1)") - } - guard let seq = as_sequenceQ(try! list.nth(1)) else { - try throw_error("expected list or vector for first argument to fn*") - } - return TCOVal(make_closure((eval: EVAL, args: seq, body: try! list.nth(2), env: env))) -} - -// Walk the AST and completely evaluate it, handling macro expansions, special -// forms and function calls. -// -private func EVAL(var ast: MalVal, var _ env: Environment) throws -> MalVal { - EVAL_level++ - defer { EVAL_level-- } - guard EVAL_level <= EVAL_leval_max else { - try throw_error("Recursing too many levels (> \(EVAL_leval_max))") - } - - if DEBUG_EVAL { - indent = substring(INDENT_TEMPLATE, 0, EVAL_level) - } - - while true { - if DEBUG_EVAL { print("\(indent)> \(ast)") } - - if !is_list(ast) { - - // Not a list -- just evaluate and return. - - let answer = try eval_ast(ast, env) - if DEBUG_EVAL { print("\(indent)>>> \(answer)") } - return answer - } - - // Special handling if it's a list. - - let list = as_list(ast) - if DEBUG_EVAL { print("\(indent)>. \(list)") } - - if list.isEmpty { - return ast - } - - // Check for special forms, where we want to check the operation - // before evaluating all of the parameters. - - let arg0 = list.first() - if let fn_symbol = as_symbolQ(arg0) { - let res: TCOVal - - switch fn_symbol { - case kSymbolDef: res = try eval_def(list, env) - case kSymbolLet: res = try eval_let(list, env) - case kSymbolDo: res = try eval_do(list, env) - case kSymbolIf: res = try eval_if(list, env) - case kSymbolFn: res = try eval_fn(list, env) - default: res = TCOVal() - } - switch res { - case let .Return(result): return result - case let .Continue(new_ast, new_env): ast = new_ast; env = new_env; continue - case .NoResult: break - } - } - - // Standard list to be applied. Evaluate all the elements first. - - let eval = try eval_ast(ast, env) - - // The result had better be a list and better be non-empty. - - let eval_list = as_list(eval) - if eval_list.isEmpty { - return eval - } - - if DEBUG_EVAL { print("\(indent)>> \(eval)") } - - // Get the first element of the list and execute it. - - let first = eval_list.first() - let rest = as_sequence(eval_list.rest()) - - if let fn = as_builtinQ(first) { - let answer = try fn.apply(rest) - if DEBUG_EVAL { print("\(indent)>>> \(answer)") } - return answer - } else if let fn = as_closureQ(first) { - let new_env = Environment(outer: fn.env) - let _ = try new_env.set_bindings(fn.args, with_exprs: rest) - if TCO { - env = new_env - ast = fn.body - continue - } - let answer = try EVAL(fn.body, new_env) - if DEBUG_EVAL { print("\(indent)>>> \(answer)") } - return answer - } - - // The first element wasn't a function to be executed. Return an - // error saying so. - - try throw_error("first list item does not evaluate to a function: \(first)") - } -} - -// Convert the value into a human-readable string for printing. -// -private func PRINT(exp: MalVal) -> String { - return pr_str(exp, true) -} - -// Perform the READ and EVAL steps. Useful for when you don't care about the -// printable result. -// -private func RE(text: String, _ env: Environment) -> MalVal? { - if !text.isEmpty { - do { - let ast = try READ(text) - do { - return try EVAL(ast, env) - } catch let error as MalException { - print("Error evaluating input: \(error)") - } catch { - print("Error evaluating input: \(error)") - } - } catch let error as MalException { - print("Error parsing input: \(error)") - } catch { - print("Error parsing input: \(error)") - } - } - return nil -} - -// Perform the full READ/EVAL/PRINT, returning a printable string. -// -private func REP(text: String, _ env: Environment) -> String? { - let exp = RE(text, env) - if exp == nil { return nil } - return PRINT(exp!) -} - -// Perform the full REPL. -// -private func REPL(env: Environment) { - while true { - if let text = _readline("user> ") { - if let output = REP(text, env) { - print("\(output)") - } - } else { - print("") - break - } - } -} - -// Process any command line arguments. Any trailing arguments are incorporated -// into the environment. Any argument immediately after the process name is -// taken as a script to execute. If one exists, it is executed in lieu of -// running the REPL. -// -private func process_command_line(args: [String], _ env: Environment) -> Bool { - var argv = make_list() - if args.count > 2 { - let args1 = args[2.. 1 { - RE("(load-file \"\(args[1])\")", env) - return false - } - - return true -} - -func main() { - let env = Environment(outer: nil) - - load_history_file() - load_builtins(env) - - RE("(def! not (fn* (a) (if a false true)))", env) - RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))", env) - - env.set(kSymbolEval, make_builtin({ - try! unwrap_args($0) { - (ast: MalVal) -> MalVal in - try EVAL(ast, env) - } - })) - - if process_command_line(Process.arguments, env) { - REPL(env) - } - - save_history_file() -} diff --git a/swift/step7_quote.swift b/swift/step7_quote.swift deleted file mode 100644 index e5324d1d23..0000000000 --- a/swift/step7_quote.swift +++ /dev/null @@ -1,545 +0,0 @@ -//****************************************************************************** -// MAL - step 7 - quote -//****************************************************************************** -// This file is automatically generated from templates/step.swift. Rather than -// editing it directly, it's probably better to edit templates/step.swift and -// regenerate this file. Otherwise, your change might be lost if/when someone -// else performs that process. -//****************************************************************************** - -import Foundation - -// The number of times EVAL has been entered recursively. We keep track of this -// so that we can protect against overrunning the stack. -// -private var EVAL_level = 0 - -// The maximum number of times we let EVAL recurse before throwing an exception. -// Testing puts this at some place between 1800 and 1900. Let's keep it at 500 -// for safety's sake. -// -private let EVAL_leval_max = 500 - -// Control whether or not tail-call optimization (TCO) is enabled. We want it -// `true` most of the time, but may disable it for debugging purposes (it's -// easier to get a meaningful backtrace that way). -// -private let TCO = true - -// Control whether or not we emit debugging statements in EVAL. -// -private let DEBUG_EVAL = false - -// String used to prefix information logged in EVAL. Increasing lengths of the -// string are used the more EVAL is recursed. -// -private let INDENT_TEMPLATE = "|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" - -// Holds the prefix of INDENT_TEMPLATE used for actual logging. -// -private var indent = String() - -// Symbols used in this module. -// -private let kValArgv = make_symbol("*ARGV*") -private let kValConcat = make_symbol("concat") -private let kValCons = make_symbol("cons") -private let kValDef = make_symbol("def!") -private let kValDo = make_symbol("do") -private let kValEval = make_symbol("eval") -private let kValFn = make_symbol("fn*") -private let kValIf = make_symbol("if") -private let kValLet = make_symbol("let*") -private let kValQuasiQuote = make_symbol("quasiquote") -private let kValQuote = make_symbol("quote") -private let kValSpliceUnquote = make_symbol("splice-unquote") -private let kValUnquote = make_symbol("unquote") -private let kValTry = make_symbol("try*") - -private let kSymbolArgv = as_symbol(kValArgv) -private let kSymbolConcat = as_symbol(kValConcat) -private let kSymbolCons = as_symbol(kValCons) -private let kSymbolDef = as_symbol(kValDef) -private let kSymbolDo = as_symbol(kValDo) -private let kSymbolEval = as_symbol(kValEval) -private let kSymbolFn = as_symbol(kValFn) -private let kSymbolIf = as_symbol(kValIf) -private let kSymbolLet = as_symbol(kValLet) -private let kSymbolQuasiQuote = as_symbol(kValQuasiQuote) -private let kSymbolQuote = as_symbol(kValQuote) -private let kSymbolSpliceUnquote = as_symbol(kValSpliceUnquote) -private let kSymbolUnquote = as_symbol(kValUnquote) - -func substring(s: String, _ begin: Int, _ end: Int) -> String { - return s[s.startIndex.advancedBy(begin) ..< s.startIndex.advancedBy(end)] -} - -// Parse the string into an AST. -// -private func READ(str: String) throws -> MalVal { - return try read_str(str) -} - -// Return whether or not `val` is a non-empty list. -// -private func is_pair(val: MalVal) -> Bool { - if let seq = as_sequenceQ(val) { - return !seq.isEmpty - } - return false -} - -// Evaluate `quasiquote`, possibly recursing in the process. -// -// As with quote, unquote, and splice-unquote, quasiquote takes a single -// parameter, typically a list. In the general case, this list is processed -// recursively as: -// -// (quasiquote (first rest...)) -> (cons (quasiquote first) (quasiquote rest)) -// -// In the processing of the parameter passed to it, quasiquote handles three -// special cases: -// -// * If the parameter is an atom or an empty list, the following expression -// is formed and returned for evaluation: -// -// (quasiquote atom-or-empty-list) -> (quote atom-or-empty-list) -// -// * If the first element of the non-empty list is the symbol "unquote" -// followed by a second item, the second item is returned as-is: -// -// (quasiquote (unquote fred)) -> fred -// -// * If the first element of the non-empty list is another list containing -// the symbol "splice-unquote" followed by a list, that list is catenated -// with the quasiquoted result of the remaining items in the non-empty -// parent list: -// -// (quasiquote (splice-unquote list) rest...) -> (items-from-list items-from-quasiquote(rest...)) -// -// Note the inconsistent handling between "quote" and "splice-quote". The former -// is handled when this function is handed a list that starts with "quote", -// whereas the latter is handled when this function is handled a list whose -// first element is a list that starts with "splice-quote". The handling of the -// latter is forced by the need to incorporate the results of (splice-quote -// list) with the remaining items of the list containing that splice-quote -// expression. However, it's not clear to me why the handling of "unquote" is -// not handled similarly, for consistency's sake. -// -private func quasiquote(qq_arg: MalVal) throws -> MalVal { - - // If the argument is an atom or empty list: - // - // Return: (quote ) - - if !is_pair(qq_arg) { - return make_list_from(kValQuote, qq_arg) - } - - // The argument is a non-empty list -- that is (item rest...) - - // If the first item from the list is a symbol and it's "unquote" -- that - // is, (unquote item ignored...): - // - // Return: item - - let qq_list = as_sequence(qq_arg) - if let sym = as_symbolQ(qq_list.first()) where sym == kSymbolUnquote { - return qq_list.count >= 2 ? try! qq_list.nth(1) : make_nil() - } - - // If the first item from the list is itself a non-empty list starting with - // "splice-unquote"-- that is, ((splice-unquote item ignored...) rest...): - // - // Return: (concat item quasiquote(rest...)) - - if is_pair(qq_list.first()) { - let qq_list_item0 = as_sequence(qq_list.first()) - if let sym = as_symbolQ(qq_list_item0.first()) where sym == kSymbolSpliceUnquote { - let result = try quasiquote(qq_list.rest()) - return make_list_from(kValConcat, try! qq_list_item0.nth(1), result) - } - } - - // General case: (item rest...): - // - // Return: (cons (quasiquote item) (quasiquote (rest...)) - - let first = try quasiquote(qq_list.first()) - let rest = try quasiquote(qq_list.rest()) - return make_list_from(kValCons, first, rest) -} - -// Perform a simple evaluation of the `ast` object. If it's a symbol, -// dereference it and return its value. If it's a collection, call EVAL on all -// elements (or just the values, in the case of the hashmap). Otherwise, return -// the object unchanged. -// -private func eval_ast(ast: MalVal, _ env: Environment) throws -> MalVal { - if let symbol = as_symbolQ(ast) { - guard let val = env.get(symbol) else { - try throw_error("'\(symbol)' not found") // Specific text needed to match MAL unit tests - } - return val - } - if let list = as_listQ(ast) { - var result = [MalVal]() - result.reserveCapacity(Int(list.count)) - for item in list { - let eval = try EVAL(item, env) - result.append(eval) - } - return make_list(result) - } - if let vec = as_vectorQ(ast) { - var result = [MalVal]() - result.reserveCapacity(Int(vec.count)) - for item in vec { - let eval = try EVAL(item, env) - result.append(eval) - } - return make_vector(result) - } - if let hash = as_hashmapQ(ast) { - var result = [MalVal]() - result.reserveCapacity(Int(hash.count) * 2) - for (k, v) in hash { - let new_v = try EVAL(v, env) - result.append(k) - result.append(new_v) - } - return make_hashmap(result) - } - return ast -} - -private enum TCOVal { - case NoResult - case Return(MalVal) - case Continue(MalVal, Environment) - - init() { self = .NoResult } - init(_ result: MalVal) { self = .Return(result) } - init(_ ast: MalVal, _ env: Environment) { self = .Continue(ast, env) } -} - -// EVALuate "def!". -// -private func eval_def(list: MalSequence, _ env: Environment) throws -> TCOVal { - guard list.count == 3 else { - try throw_error("expected 2 arguments to def!, got \(list.count - 1)") - } - let arg1 = try! list.nth(1) - let arg2 = try! list.nth(2) - guard let sym = as_symbolQ(arg1) else { - try throw_error("expected symbol for first argument to def!") - } - let value = try EVAL(arg2, env) - return TCOVal(env.set(sym, value)) -} - -// EVALuate "let*". -// -private func eval_let(list: MalSequence, _ env: Environment) throws -> TCOVal { - guard list.count == 3 else { - try throw_error("expected 2 arguments to let*, got \(list.count - 1)") - } - let arg1 = try! list.nth(1) - let arg2 = try! list.nth(2) - guard let bindings = as_sequenceQ(arg1) else { - try throw_error("expected list for first argument to let*") - } - guard bindings.count % 2 == 0 else { - try throw_error("expected even number of elements in bindings to let*, got \(bindings.count)") - } - let new_env = Environment(outer: env) - for var index: MalIntType = 0; index < bindings.count; index += 2 { - let binding_name = try! bindings.nth(index) - let binding_value = try! bindings.nth(index + 1) - guard let binding_symbol = as_symbolQ(binding_name) else { - try throw_error("expected symbol for first element in binding pair") - } - let evaluated_value = try EVAL(binding_value, new_env) - new_env.set(binding_symbol, evaluated_value) - } - if TCO { - return TCOVal(arg2, new_env) - } - return TCOVal(try EVAL(arg2, new_env)) -} - -// EVALuate "do". -// -private func eval_do(list: MalSequence, _ env: Environment) throws -> TCOVal { - if TCO { - let _ = try eval_ast(list.range_from(1, to: list.count-1), env) - return TCOVal(list.last(), env) - } - - let evaluated_ast = try eval_ast(list.rest(), env) - let evaluated_seq = as_sequence(evaluated_ast) - return TCOVal(evaluated_seq.last()) -} - -// EVALuate "if". -// -private func eval_if(list: MalSequence, _ env: Environment) throws -> TCOVal { - guard list.count >= 3 else { - try throw_error("expected at least 2 arguments to if, got \(list.count - 1)") - } - let cond_result = try EVAL(try! list.nth(1), env) - var new_ast: MalVal - if is_truthy(cond_result) { - new_ast = try! list.nth(2) - } else if list.count == 4 { - new_ast = try! list.nth(3) - } else { - return TCOVal(make_nil()) - } - if TCO { - return TCOVal(new_ast, env) - } - return TCOVal(try EVAL(new_ast, env)) -} - -// EVALuate "fn*". -// -private func eval_fn(list: MalSequence, _ env: Environment) throws -> TCOVal { - guard list.count == 3 else { - try throw_error("expected 2 arguments to fn*, got \(list.count - 1)") - } - guard let seq = as_sequenceQ(try! list.nth(1)) else { - try throw_error("expected list or vector for first argument to fn*") - } - return TCOVal(make_closure((eval: EVAL, args: seq, body: try! list.nth(2), env: env))) -} - -// EVALuate "quote". -// -private func eval_quote(list: MalSequence, _ env: Environment) throws -> TCOVal { - if list.count >= 2 { - return TCOVal(try! list.nth(1)) - } - return TCOVal(make_nil()) -} - -// EVALuate "quasiquote". -// -private func eval_quasiquote(list: MalSequence, _ env: Environment) throws -> TCOVal { - guard list.count >= 2 else { - try throw_error("Expected non-nil parameter to 'quasiquote'") - } - if TCO { - return TCOVal(try quasiquote(try! list.nth(1)), env) - } - return TCOVal(try EVAL(try quasiquote(try! list.nth(1)), env)) -} - -// Walk the AST and completely evaluate it, handling macro expansions, special -// forms and function calls. -// -private func EVAL(var ast: MalVal, var _ env: Environment) throws -> MalVal { - EVAL_level++ - defer { EVAL_level-- } - guard EVAL_level <= EVAL_leval_max else { - try throw_error("Recursing too many levels (> \(EVAL_leval_max))") - } - - if DEBUG_EVAL { - indent = substring(INDENT_TEMPLATE, 0, EVAL_level) - } - - while true { - if DEBUG_EVAL { print("\(indent)> \(ast)") } - - if !is_list(ast) { - - // Not a list -- just evaluate and return. - - let answer = try eval_ast(ast, env) - if DEBUG_EVAL { print("\(indent)>>> \(answer)") } - return answer - } - - // Special handling if it's a list. - - let list = as_list(ast) - if DEBUG_EVAL { print("\(indent)>. \(list)") } - - if list.isEmpty { - return ast - } - - // Check for special forms, where we want to check the operation - // before evaluating all of the parameters. - - let arg0 = list.first() - if let fn_symbol = as_symbolQ(arg0) { - let res: TCOVal - - switch fn_symbol { - case kSymbolDef: res = try eval_def(list, env) - case kSymbolLet: res = try eval_let(list, env) - case kSymbolDo: res = try eval_do(list, env) - case kSymbolIf: res = try eval_if(list, env) - case kSymbolFn: res = try eval_fn(list, env) - case kSymbolQuote: res = try eval_quote(list, env) - case kSymbolQuasiQuote: res = try eval_quasiquote(list, env) - default: res = TCOVal() - } - switch res { - case let .Return(result): return result - case let .Continue(new_ast, new_env): ast = new_ast; env = new_env; continue - case .NoResult: break - } - } - - // Standard list to be applied. Evaluate all the elements first. - - let eval = try eval_ast(ast, env) - - // The result had better be a list and better be non-empty. - - let eval_list = as_list(eval) - if eval_list.isEmpty { - return eval - } - - if DEBUG_EVAL { print("\(indent)>> \(eval)") } - - // Get the first element of the list and execute it. - - let first = eval_list.first() - let rest = as_sequence(eval_list.rest()) - - if let fn = as_builtinQ(first) { - let answer = try fn.apply(rest) - if DEBUG_EVAL { print("\(indent)>>> \(answer)") } - return answer - } else if let fn = as_closureQ(first) { - let new_env = Environment(outer: fn.env) - let _ = try new_env.set_bindings(fn.args, with_exprs: rest) - if TCO { - env = new_env - ast = fn.body - continue - } - let answer = try EVAL(fn.body, new_env) - if DEBUG_EVAL { print("\(indent)>>> \(answer)") } - return answer - } - - // The first element wasn't a function to be executed. Return an - // error saying so. - - try throw_error("first list item does not evaluate to a function: \(first)") - } -} - -// Convert the value into a human-readable string for printing. -// -private func PRINT(exp: MalVal) -> String { - return pr_str(exp, true) -} - -// Perform the READ and EVAL steps. Useful for when you don't care about the -// printable result. -// -private func RE(text: String, _ env: Environment) -> MalVal? { - if !text.isEmpty { - do { - let ast = try READ(text) - do { - return try EVAL(ast, env) - } catch let error as MalException { - print("Error evaluating input: \(error)") - } catch { - print("Error evaluating input: \(error)") - } - } catch let error as MalException { - print("Error parsing input: \(error)") - } catch { - print("Error parsing input: \(error)") - } - } - return nil -} - -// Perform the full READ/EVAL/PRINT, returning a printable string. -// -private func REP(text: String, _ env: Environment) -> String? { - let exp = RE(text, env) - if exp == nil { return nil } - return PRINT(exp!) -} - -// Perform the full REPL. -// -private func REPL(env: Environment) { - while true { - if let text = _readline("user> ") { - if let output = REP(text, env) { - print("\(output)") - } - } else { - print("") - break - } - } -} - -// Process any command line arguments. Any trailing arguments are incorporated -// into the environment. Any argument immediately after the process name is -// taken as a script to execute. If one exists, it is executed in lieu of -// running the REPL. -// -private func process_command_line(args: [String], _ env: Environment) -> Bool { - var argv = make_list() - if args.count > 2 { - let args1 = args[2.. 1 { - RE("(load-file \"\(args[1])\")", env) - return false - } - - return true -} - -func main() { - let env = Environment(outer: nil) - - load_history_file() - load_builtins(env) - - RE("(def! not (fn* (a) (if a false true)))", env) - RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))", env) - - env.set(kSymbolEval, make_builtin({ - try! unwrap_args($0) { - (ast: MalVal) -> MalVal in - try EVAL(ast, env) - } - })) - - if process_command_line(Process.arguments, env) { - REPL(env) - } - - save_history_file() -} diff --git a/swift/step8_macros.swift b/swift/step8_macros.swift deleted file mode 100644 index e0391ceda1..0000000000 --- a/swift/step8_macros.swift +++ /dev/null @@ -1,601 +0,0 @@ -//****************************************************************************** -// MAL - step 8 - macros -//****************************************************************************** -// This file is automatically generated from templates/step.swift. Rather than -// editing it directly, it's probably better to edit templates/step.swift and -// regenerate this file. Otherwise, your change might be lost if/when someone -// else performs that process. -//****************************************************************************** - -import Foundation - -// The number of times EVAL has been entered recursively. We keep track of this -// so that we can protect against overrunning the stack. -// -private var EVAL_level = 0 - -// The maximum number of times we let EVAL recurse before throwing an exception. -// Testing puts this at some place between 1800 and 1900. Let's keep it at 500 -// for safety's sake. -// -private let EVAL_leval_max = 500 - -// Control whether or not tail-call optimization (TCO) is enabled. We want it -// `true` most of the time, but may disable it for debugging purposes (it's -// easier to get a meaningful backtrace that way). -// -private let TCO = true - -// Control whether or not we emit debugging statements in EVAL. -// -private let DEBUG_EVAL = false - -// String used to prefix information logged in EVAL. Increasing lengths of the -// string are used the more EVAL is recursed. -// -private let INDENT_TEMPLATE = "|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" - -// Holds the prefix of INDENT_TEMPLATE used for actual logging. -// -private var indent = String() - -// Symbols used in this module. -// -private let kValArgv = make_symbol("*ARGV*") -private let kValConcat = make_symbol("concat") -private let kValCons = make_symbol("cons") -private let kValDef = make_symbol("def!") -private let kValDefMacro = make_symbol("defmacro!") -private let kValDo = make_symbol("do") -private let kValEval = make_symbol("eval") -private let kValFn = make_symbol("fn*") -private let kValIf = make_symbol("if") -private let kValLet = make_symbol("let*") -private let kValMacroExpand = make_symbol("macroexpand") -private let kValQuasiQuote = make_symbol("quasiquote") -private let kValQuote = make_symbol("quote") -private let kValSpliceUnquote = make_symbol("splice-unquote") -private let kValUnquote = make_symbol("unquote") -private let kValTry = make_symbol("try*") - -private let kSymbolArgv = as_symbol(kValArgv) -private let kSymbolConcat = as_symbol(kValConcat) -private let kSymbolCons = as_symbol(kValCons) -private let kSymbolDef = as_symbol(kValDef) -private let kSymbolDefMacro = as_symbol(kValDefMacro) -private let kSymbolDo = as_symbol(kValDo) -private let kSymbolEval = as_symbol(kValEval) -private let kSymbolFn = as_symbol(kValFn) -private let kSymbolIf = as_symbol(kValIf) -private let kSymbolLet = as_symbol(kValLet) -private let kSymbolMacroExpand = as_symbol(kValMacroExpand) -private let kSymbolQuasiQuote = as_symbol(kValQuasiQuote) -private let kSymbolQuote = as_symbol(kValQuote) -private let kSymbolSpliceUnquote = as_symbol(kValSpliceUnquote) -private let kSymbolUnquote = as_symbol(kValUnquote) - -func substring(s: String, _ begin: Int, _ end: Int) -> String { - return s[s.startIndex.advancedBy(begin) ..< s.startIndex.advancedBy(end)] -} - -// Parse the string into an AST. -// -private func READ(str: String) throws -> MalVal { - return try read_str(str) -} - -// Return whether or not `val` is a non-empty list. -// -private func is_pair(val: MalVal) -> Bool { - if let seq = as_sequenceQ(val) { - return !seq.isEmpty - } - return false -} - -// Expand macros for as long as the expression looks like a macro invocation. -// -private func macroexpand(var ast: MalVal, _ env: Environment) throws -> MalVal { - while true { - if let ast_as_list = as_listQ(ast) where !ast_as_list.isEmpty, - let macro_name = as_symbolQ(ast_as_list.first()), - let obj = env.get(macro_name), - let macro = as_macroQ(obj) - { - let new_env = Environment(outer: macro.env) - let rest = as_sequence(ast_as_list.rest()) - let _ = try new_env.set_bindings(macro.args, with_exprs: rest) - ast = try EVAL(macro.body, new_env) - continue - } - return ast - } -} - -// Evaluate `quasiquote`, possibly recursing in the process. -// -// As with quote, unquote, and splice-unquote, quasiquote takes a single -// parameter, typically a list. In the general case, this list is processed -// recursively as: -// -// (quasiquote (first rest...)) -> (cons (quasiquote first) (quasiquote rest)) -// -// In the processing of the parameter passed to it, quasiquote handles three -// special cases: -// -// * If the parameter is an atom or an empty list, the following expression -// is formed and returned for evaluation: -// -// (quasiquote atom-or-empty-list) -> (quote atom-or-empty-list) -// -// * If the first element of the non-empty list is the symbol "unquote" -// followed by a second item, the second item is returned as-is: -// -// (quasiquote (unquote fred)) -> fred -// -// * If the first element of the non-empty list is another list containing -// the symbol "splice-unquote" followed by a list, that list is catenated -// with the quasiquoted result of the remaining items in the non-empty -// parent list: -// -// (quasiquote (splice-unquote list) rest...) -> (items-from-list items-from-quasiquote(rest...)) -// -// Note the inconsistent handling between "quote" and "splice-quote". The former -// is handled when this function is handed a list that starts with "quote", -// whereas the latter is handled when this function is handled a list whose -// first element is a list that starts with "splice-quote". The handling of the -// latter is forced by the need to incorporate the results of (splice-quote -// list) with the remaining items of the list containing that splice-quote -// expression. However, it's not clear to me why the handling of "unquote" is -// not handled similarly, for consistency's sake. -// -private func quasiquote(qq_arg: MalVal) throws -> MalVal { - - // If the argument is an atom or empty list: - // - // Return: (quote ) - - if !is_pair(qq_arg) { - return make_list_from(kValQuote, qq_arg) - } - - // The argument is a non-empty list -- that is (item rest...) - - // If the first item from the list is a symbol and it's "unquote" -- that - // is, (unquote item ignored...): - // - // Return: item - - let qq_list = as_sequence(qq_arg) - if let sym = as_symbolQ(qq_list.first()) where sym == kSymbolUnquote { - return qq_list.count >= 2 ? try! qq_list.nth(1) : make_nil() - } - - // If the first item from the list is itself a non-empty list starting with - // "splice-unquote"-- that is, ((splice-unquote item ignored...) rest...): - // - // Return: (concat item quasiquote(rest...)) - - if is_pair(qq_list.first()) { - let qq_list_item0 = as_sequence(qq_list.first()) - if let sym = as_symbolQ(qq_list_item0.first()) where sym == kSymbolSpliceUnquote { - let result = try quasiquote(qq_list.rest()) - return make_list_from(kValConcat, try! qq_list_item0.nth(1), result) - } - } - - // General case: (item rest...): - // - // Return: (cons (quasiquote item) (quasiquote (rest...)) - - let first = try quasiquote(qq_list.first()) - let rest = try quasiquote(qq_list.rest()) - return make_list_from(kValCons, first, rest) -} - -// Perform a simple evaluation of the `ast` object. If it's a symbol, -// dereference it and return its value. If it's a collection, call EVAL on all -// elements (or just the values, in the case of the hashmap). Otherwise, return -// the object unchanged. -// -private func eval_ast(ast: MalVal, _ env: Environment) throws -> MalVal { - if let symbol = as_symbolQ(ast) { - guard let val = env.get(symbol) else { - try throw_error("'\(symbol)' not found") // Specific text needed to match MAL unit tests - } - return val - } - if let list = as_listQ(ast) { - var result = [MalVal]() - result.reserveCapacity(Int(list.count)) - for item in list { - let eval = try EVAL(item, env) - result.append(eval) - } - return make_list(result) - } - if let vec = as_vectorQ(ast) { - var result = [MalVal]() - result.reserveCapacity(Int(vec.count)) - for item in vec { - let eval = try EVAL(item, env) - result.append(eval) - } - return make_vector(result) - } - if let hash = as_hashmapQ(ast) { - var result = [MalVal]() - result.reserveCapacity(Int(hash.count) * 2) - for (k, v) in hash { - let new_v = try EVAL(v, env) - result.append(k) - result.append(new_v) - } - return make_hashmap(result) - } - return ast -} - -private enum TCOVal { - case NoResult - case Return(MalVal) - case Continue(MalVal, Environment) - - init() { self = .NoResult } - init(_ result: MalVal) { self = .Return(result) } - init(_ ast: MalVal, _ env: Environment) { self = .Continue(ast, env) } -} - -// EVALuate "def!" and "defmacro!". -// -private func eval_def(list: MalSequence, _ env: Environment) throws -> TCOVal { - guard list.count == 3 else { - try throw_error("expected 2 arguments to def!, got \(list.count - 1)") - } - let arg0 = try! list.nth(0) - let arg1 = try! list.nth(1) - let arg2 = try! list.nth(2) - guard let sym = as_symbolQ(arg1) else { - try throw_error("expected symbol for first argument to def!") - } - var value = try EVAL(arg2, env) - if as_symbol(arg0) == kSymbolDefMacro { - guard let closure = as_closureQ(value) else { - try throw_error("expected closure, got \(value)") - } - value = make_macro(closure) - } - return TCOVal(env.set(sym, value)) -} - -// EVALuate "let*". -// -private func eval_let(list: MalSequence, _ env: Environment) throws -> TCOVal { - guard list.count == 3 else { - try throw_error("expected 2 arguments to let*, got \(list.count - 1)") - } - let arg1 = try! list.nth(1) - let arg2 = try! list.nth(2) - guard let bindings = as_sequenceQ(arg1) else { - try throw_error("expected list for first argument to let*") - } - guard bindings.count % 2 == 0 else { - try throw_error("expected even number of elements in bindings to let*, got \(bindings.count)") - } - let new_env = Environment(outer: env) - for var index: MalIntType = 0; index < bindings.count; index += 2 { - let binding_name = try! bindings.nth(index) - let binding_value = try! bindings.nth(index + 1) - guard let binding_symbol = as_symbolQ(binding_name) else { - try throw_error("expected symbol for first element in binding pair") - } - let evaluated_value = try EVAL(binding_value, new_env) - new_env.set(binding_symbol, evaluated_value) - } - if TCO { - return TCOVal(arg2, new_env) - } - return TCOVal(try EVAL(arg2, new_env)) -} - -// EVALuate "do". -// -private func eval_do(list: MalSequence, _ env: Environment) throws -> TCOVal { - if TCO { - let _ = try eval_ast(list.range_from(1, to: list.count-1), env) - return TCOVal(list.last(), env) - } - - let evaluated_ast = try eval_ast(list.rest(), env) - let evaluated_seq = as_sequence(evaluated_ast) - return TCOVal(evaluated_seq.last()) -} - -// EVALuate "if". -// -private func eval_if(list: MalSequence, _ env: Environment) throws -> TCOVal { - guard list.count >= 3 else { - try throw_error("expected at least 2 arguments to if, got \(list.count - 1)") - } - let cond_result = try EVAL(try! list.nth(1), env) - var new_ast: MalVal - if is_truthy(cond_result) { - new_ast = try! list.nth(2) - } else if list.count == 4 { - new_ast = try! list.nth(3) - } else { - return TCOVal(make_nil()) - } - if TCO { - return TCOVal(new_ast, env) - } - return TCOVal(try EVAL(new_ast, env)) -} - -// EVALuate "fn*". -// -private func eval_fn(list: MalSequence, _ env: Environment) throws -> TCOVal { - guard list.count == 3 else { - try throw_error("expected 2 arguments to fn*, got \(list.count - 1)") - } - guard let seq = as_sequenceQ(try! list.nth(1)) else { - try throw_error("expected list or vector for first argument to fn*") - } - return TCOVal(make_closure((eval: EVAL, args: seq, body: try! list.nth(2), env: env))) -} - -// EVALuate "quote". -// -private func eval_quote(list: MalSequence, _ env: Environment) throws -> TCOVal { - if list.count >= 2 { - return TCOVal(try! list.nth(1)) - } - return TCOVal(make_nil()) -} - -// EVALuate "quasiquote". -// -private func eval_quasiquote(list: MalSequence, _ env: Environment) throws -> TCOVal { - guard list.count >= 2 else { - try throw_error("Expected non-nil parameter to 'quasiquote'") - } - if TCO { - return TCOVal(try quasiquote(try! list.nth(1)), env) - } - return TCOVal(try EVAL(try quasiquote(try! list.nth(1)), env)) -} - -// EVALuate "macroexpand". -// -private func eval_macroexpand(list: MalSequence, _ env: Environment) throws -> TCOVal { - guard list.count >= 2 else { - try throw_error("Expected parameter to 'macroexpand'") - } - return TCOVal(try macroexpand(try! list.nth(1), env)) -} - -// Walk the AST and completely evaluate it, handling macro expansions, special -// forms and function calls. -// -private func EVAL(var ast: MalVal, var _ env: Environment) throws -> MalVal { - EVAL_level++ - defer { EVAL_level-- } - guard EVAL_level <= EVAL_leval_max else { - try throw_error("Recursing too many levels (> \(EVAL_leval_max))") - } - - if DEBUG_EVAL { - indent = substring(INDENT_TEMPLATE, 0, EVAL_level) - } - - while true { - if DEBUG_EVAL { print("\(indent)> \(ast)") } - - if !is_list(ast) { - - // Not a list -- just evaluate and return. - - let answer = try eval_ast(ast, env) - if DEBUG_EVAL { print("\(indent)>>> \(answer)") } - return answer - } - - // Special handling if it's a list. - - var list = as_list(ast) - ast = try macroexpand(ast, env) - if !is_list(ast) { - - // Not a list -- just evaluate and return. - - let answer = try eval_ast(ast, env) - if DEBUG_EVAL { print("\(indent)>>> \(answer)") } - return answer - } - list = as_list(ast) - - if DEBUG_EVAL { print("\(indent)>. \(list)") } - - if list.isEmpty { - return ast - } - - // Check for special forms, where we want to check the operation - // before evaluating all of the parameters. - - let arg0 = list.first() - if let fn_symbol = as_symbolQ(arg0) { - let res: TCOVal - - switch fn_symbol { - case kSymbolDef: res = try eval_def(list, env) - case kSymbolDefMacro: res = try eval_def(list, env) - case kSymbolLet: res = try eval_let(list, env) - case kSymbolDo: res = try eval_do(list, env) - case kSymbolIf: res = try eval_if(list, env) - case kSymbolFn: res = try eval_fn(list, env) - case kSymbolQuote: res = try eval_quote(list, env) - case kSymbolQuasiQuote: res = try eval_quasiquote(list, env) - case kSymbolMacroExpand: res = try eval_macroexpand(list, env) - default: res = TCOVal() - } - switch res { - case let .Return(result): return result - case let .Continue(new_ast, new_env): ast = new_ast; env = new_env; continue - case .NoResult: break - } - } - - // Standard list to be applied. Evaluate all the elements first. - - let eval = try eval_ast(ast, env) - - // The result had better be a list and better be non-empty. - - let eval_list = as_list(eval) - if eval_list.isEmpty { - return eval - } - - if DEBUG_EVAL { print("\(indent)>> \(eval)") } - - // Get the first element of the list and execute it. - - let first = eval_list.first() - let rest = as_sequence(eval_list.rest()) - - if let fn = as_builtinQ(first) { - let answer = try fn.apply(rest) - if DEBUG_EVAL { print("\(indent)>>> \(answer)") } - return answer - } else if let fn = as_closureQ(first) { - let new_env = Environment(outer: fn.env) - let _ = try new_env.set_bindings(fn.args, with_exprs: rest) - if TCO { - env = new_env - ast = fn.body - continue - } - let answer = try EVAL(fn.body, new_env) - if DEBUG_EVAL { print("\(indent)>>> \(answer)") } - return answer - } - - // The first element wasn't a function to be executed. Return an - // error saying so. - - try throw_error("first list item does not evaluate to a function: \(first)") - } -} - -// Convert the value into a human-readable string for printing. -// -private func PRINT(exp: MalVal) -> String { - return pr_str(exp, true) -} - -// Perform the READ and EVAL steps. Useful for when you don't care about the -// printable result. -// -private func RE(text: String, _ env: Environment) -> MalVal? { - if !text.isEmpty { - do { - let ast = try READ(text) - do { - return try EVAL(ast, env) - } catch let error as MalException { - print("Error evaluating input: \(error)") - } catch { - print("Error evaluating input: \(error)") - } - } catch let error as MalException { - print("Error parsing input: \(error)") - } catch { - print("Error parsing input: \(error)") - } - } - return nil -} - -// Perform the full READ/EVAL/PRINT, returning a printable string. -// -private func REP(text: String, _ env: Environment) -> String? { - let exp = RE(text, env) - if exp == nil { return nil } - return PRINT(exp!) -} - -// Perform the full REPL. -// -private func REPL(env: Environment) { - while true { - if let text = _readline("user> ") { - if let output = REP(text, env) { - print("\(output)") - } - } else { - print("") - break - } - } -} - -// Process any command line arguments. Any trailing arguments are incorporated -// into the environment. Any argument immediately after the process name is -// taken as a script to execute. If one exists, it is executed in lieu of -// running the REPL. -// -private func process_command_line(args: [String], _ env: Environment) -> Bool { - var argv = make_list() - if args.count > 2 { - let args1 = args[2.. 1 { - RE("(load-file \"\(args[1])\")", env) - return false - } - - return true -} - -func main() { - let env = Environment(outer: nil) - - load_history_file() - load_builtins(env) - - RE("(def! not (fn* (a) (if a false true)))", env) - RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))", 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)))))))", env) - 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))))))))", env) - - env.set(kSymbolEval, make_builtin({ - try! unwrap_args($0) { - (ast: MalVal) -> MalVal in - try EVAL(ast, env) - } - })) - - if process_command_line(Process.arguments, env) { - REPL(env) - } - - save_history_file() -} diff --git a/swift/step9_try.swift b/swift/step9_try.swift deleted file mode 100644 index b0b8b31449..0000000000 --- a/swift/step9_try.swift +++ /dev/null @@ -1,634 +0,0 @@ -//****************************************************************************** -// MAL - step 9 - try -//****************************************************************************** -// This file is automatically generated from templates/step.swift. Rather than -// editing it directly, it's probably better to edit templates/step.swift and -// regenerate this file. Otherwise, your change might be lost if/when someone -// else performs that process. -//****************************************************************************** - -import Foundation - -// The number of times EVAL has been entered recursively. We keep track of this -// so that we can protect against overrunning the stack. -// -private var EVAL_level = 0 - -// The maximum number of times we let EVAL recurse before throwing an exception. -// Testing puts this at some place between 1800 and 1900. Let's keep it at 500 -// for safety's sake. -// -private let EVAL_leval_max = 500 - -// Control whether or not tail-call optimization (TCO) is enabled. We want it -// `true` most of the time, but may disable it for debugging purposes (it's -// easier to get a meaningful backtrace that way). -// -private let TCO = true - -// Control whether or not we emit debugging statements in EVAL. -// -private let DEBUG_EVAL = false - -// String used to prefix information logged in EVAL. Increasing lengths of the -// string are used the more EVAL is recursed. -// -private let INDENT_TEMPLATE = "|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" - -// Holds the prefix of INDENT_TEMPLATE used for actual logging. -// -private var indent = String() - -// Symbols used in this module. -// -private let kValArgv = make_symbol("*ARGV*") -private let kValCatch = make_symbol("catch*") -private let kValConcat = make_symbol("concat") -private let kValCons = make_symbol("cons") -private let kValDef = make_symbol("def!") -private let kValDefMacro = make_symbol("defmacro!") -private let kValDo = make_symbol("do") -private let kValEval = make_symbol("eval") -private let kValFn = make_symbol("fn*") -private let kValIf = make_symbol("if") -private let kValLet = make_symbol("let*") -private let kValMacroExpand = make_symbol("macroexpand") -private let kValQuasiQuote = make_symbol("quasiquote") -private let kValQuote = make_symbol("quote") -private let kValSpliceUnquote = make_symbol("splice-unquote") -private let kValUnquote = make_symbol("unquote") -private let kValTry = make_symbol("try*") - -private let kSymbolArgv = as_symbol(kValArgv) -private let kSymbolCatch = as_symbol(kValCatch) -private let kSymbolConcat = as_symbol(kValConcat) -private let kSymbolCons = as_symbol(kValCons) -private let kSymbolDef = as_symbol(kValDef) -private let kSymbolDefMacro = as_symbol(kValDefMacro) -private let kSymbolDo = as_symbol(kValDo) -private let kSymbolEval = as_symbol(kValEval) -private let kSymbolFn = as_symbol(kValFn) -private let kSymbolIf = as_symbol(kValIf) -private let kSymbolLet = as_symbol(kValLet) -private let kSymbolMacroExpand = as_symbol(kValMacroExpand) -private let kSymbolQuasiQuote = as_symbol(kValQuasiQuote) -private let kSymbolQuote = as_symbol(kValQuote) -private let kSymbolSpliceUnquote = as_symbol(kValSpliceUnquote) -private let kSymbolUnquote = as_symbol(kValUnquote) -private let kSymbolTry = as_symbol(kValTry) - -func substring(s: String, _ begin: Int, _ end: Int) -> String { - return s[s.startIndex.advancedBy(begin) ..< s.startIndex.advancedBy(end)] -} - -// Parse the string into an AST. -// -private func READ(str: String) throws -> MalVal { - return try read_str(str) -} - -// Return whether or not `val` is a non-empty list. -// -private func is_pair(val: MalVal) -> Bool { - if let seq = as_sequenceQ(val) { - return !seq.isEmpty - } - return false -} - -// Expand macros for as long as the expression looks like a macro invocation. -// -private func macroexpand(var ast: MalVal, _ env: Environment) throws -> MalVal { - while true { - if let ast_as_list = as_listQ(ast) where !ast_as_list.isEmpty, - let macro_name = as_symbolQ(ast_as_list.first()), - let obj = env.get(macro_name), - let macro = as_macroQ(obj) - { - let new_env = Environment(outer: macro.env) - let rest = as_sequence(ast_as_list.rest()) - let _ = try new_env.set_bindings(macro.args, with_exprs: rest) - ast = try EVAL(macro.body, new_env) - continue - } - return ast - } -} - -// Evaluate `quasiquote`, possibly recursing in the process. -// -// As with quote, unquote, and splice-unquote, quasiquote takes a single -// parameter, typically a list. In the general case, this list is processed -// recursively as: -// -// (quasiquote (first rest...)) -> (cons (quasiquote first) (quasiquote rest)) -// -// In the processing of the parameter passed to it, quasiquote handles three -// special cases: -// -// * If the parameter is an atom or an empty list, the following expression -// is formed and returned for evaluation: -// -// (quasiquote atom-or-empty-list) -> (quote atom-or-empty-list) -// -// * If the first element of the non-empty list is the symbol "unquote" -// followed by a second item, the second item is returned as-is: -// -// (quasiquote (unquote fred)) -> fred -// -// * If the first element of the non-empty list is another list containing -// the symbol "splice-unquote" followed by a list, that list is catenated -// with the quasiquoted result of the remaining items in the non-empty -// parent list: -// -// (quasiquote (splice-unquote list) rest...) -> (items-from-list items-from-quasiquote(rest...)) -// -// Note the inconsistent handling between "quote" and "splice-quote". The former -// is handled when this function is handed a list that starts with "quote", -// whereas the latter is handled when this function is handled a list whose -// first element is a list that starts with "splice-quote". The handling of the -// latter is forced by the need to incorporate the results of (splice-quote -// list) with the remaining items of the list containing that splice-quote -// expression. However, it's not clear to me why the handling of "unquote" is -// not handled similarly, for consistency's sake. -// -private func quasiquote(qq_arg: MalVal) throws -> MalVal { - - // If the argument is an atom or empty list: - // - // Return: (quote ) - - if !is_pair(qq_arg) { - return make_list_from(kValQuote, qq_arg) - } - - // The argument is a non-empty list -- that is (item rest...) - - // If the first item from the list is a symbol and it's "unquote" -- that - // is, (unquote item ignored...): - // - // Return: item - - let qq_list = as_sequence(qq_arg) - if let sym = as_symbolQ(qq_list.first()) where sym == kSymbolUnquote { - return qq_list.count >= 2 ? try! qq_list.nth(1) : make_nil() - } - - // If the first item from the list is itself a non-empty list starting with - // "splice-unquote"-- that is, ((splice-unquote item ignored...) rest...): - // - // Return: (concat item quasiquote(rest...)) - - if is_pair(qq_list.first()) { - let qq_list_item0 = as_sequence(qq_list.first()) - if let sym = as_symbolQ(qq_list_item0.first()) where sym == kSymbolSpliceUnquote { - let result = try quasiquote(qq_list.rest()) - return make_list_from(kValConcat, try! qq_list_item0.nth(1), result) - } - } - - // General case: (item rest...): - // - // Return: (cons (quasiquote item) (quasiquote (rest...)) - - let first = try quasiquote(qq_list.first()) - let rest = try quasiquote(qq_list.rest()) - return make_list_from(kValCons, first, rest) -} - -// Perform a simple evaluation of the `ast` object. If it's a symbol, -// dereference it and return its value. If it's a collection, call EVAL on all -// elements (or just the values, in the case of the hashmap). Otherwise, return -// the object unchanged. -// -private func eval_ast(ast: MalVal, _ env: Environment) throws -> MalVal { - if let symbol = as_symbolQ(ast) { - guard let val = env.get(symbol) else { - try throw_error("'\(symbol)' not found") // Specific text needed to match MAL unit tests - } - return val - } - if let list = as_listQ(ast) { - var result = [MalVal]() - result.reserveCapacity(Int(list.count)) - for item in list { - let eval = try EVAL(item, env) - result.append(eval) - } - return make_list(result) - } - if let vec = as_vectorQ(ast) { - var result = [MalVal]() - result.reserveCapacity(Int(vec.count)) - for item in vec { - let eval = try EVAL(item, env) - result.append(eval) - } - return make_vector(result) - } - if let hash = as_hashmapQ(ast) { - var result = [MalVal]() - result.reserveCapacity(Int(hash.count) * 2) - for (k, v) in hash { - let new_v = try EVAL(v, env) - result.append(k) - result.append(new_v) - } - return make_hashmap(result) - } - return ast -} - -private enum TCOVal { - case NoResult - case Return(MalVal) - case Continue(MalVal, Environment) - - init() { self = .NoResult } - init(_ result: MalVal) { self = .Return(result) } - init(_ ast: MalVal, _ env: Environment) { self = .Continue(ast, env) } -} - -// EVALuate "def!" and "defmacro!". -// -private func eval_def(list: MalSequence, _ env: Environment) throws -> TCOVal { - guard list.count == 3 else { - try throw_error("expected 2 arguments to def!, got \(list.count - 1)") - } - let arg0 = try! list.nth(0) - let arg1 = try! list.nth(1) - let arg2 = try! list.nth(2) - guard let sym = as_symbolQ(arg1) else { - try throw_error("expected symbol for first argument to def!") - } - var value = try EVAL(arg2, env) - if as_symbol(arg0) == kSymbolDefMacro { - guard let closure = as_closureQ(value) else { - try throw_error("expected closure, got \(value)") - } - value = make_macro(closure) - } - return TCOVal(env.set(sym, value)) -} - -// EVALuate "let*". -// -private func eval_let(list: MalSequence, _ env: Environment) throws -> TCOVal { - guard list.count == 3 else { - try throw_error("expected 2 arguments to let*, got \(list.count - 1)") - } - let arg1 = try! list.nth(1) - let arg2 = try! list.nth(2) - guard let bindings = as_sequenceQ(arg1) else { - try throw_error("expected list for first argument to let*") - } - guard bindings.count % 2 == 0 else { - try throw_error("expected even number of elements in bindings to let*, got \(bindings.count)") - } - let new_env = Environment(outer: env) - for var index: MalIntType = 0; index < bindings.count; index += 2 { - let binding_name = try! bindings.nth(index) - let binding_value = try! bindings.nth(index + 1) - guard let binding_symbol = as_symbolQ(binding_name) else { - try throw_error("expected symbol for first element in binding pair") - } - let evaluated_value = try EVAL(binding_value, new_env) - new_env.set(binding_symbol, evaluated_value) - } - if TCO { - return TCOVal(arg2, new_env) - } - return TCOVal(try EVAL(arg2, new_env)) -} - -// EVALuate "do". -// -private func eval_do(list: MalSequence, _ env: Environment) throws -> TCOVal { - if TCO { - let _ = try eval_ast(list.range_from(1, to: list.count-1), env) - return TCOVal(list.last(), env) - } - - let evaluated_ast = try eval_ast(list.rest(), env) - let evaluated_seq = as_sequence(evaluated_ast) - return TCOVal(evaluated_seq.last()) -} - -// EVALuate "if". -// -private func eval_if(list: MalSequence, _ env: Environment) throws -> TCOVal { - guard list.count >= 3 else { - try throw_error("expected at least 2 arguments to if, got \(list.count - 1)") - } - let cond_result = try EVAL(try! list.nth(1), env) - var new_ast: MalVal - if is_truthy(cond_result) { - new_ast = try! list.nth(2) - } else if list.count == 4 { - new_ast = try! list.nth(3) - } else { - return TCOVal(make_nil()) - } - if TCO { - return TCOVal(new_ast, env) - } - return TCOVal(try EVAL(new_ast, env)) -} - -// EVALuate "fn*". -// -private func eval_fn(list: MalSequence, _ env: Environment) throws -> TCOVal { - guard list.count == 3 else { - try throw_error("expected 2 arguments to fn*, got \(list.count - 1)") - } - guard let seq = as_sequenceQ(try! list.nth(1)) else { - try throw_error("expected list or vector for first argument to fn*") - } - return TCOVal(make_closure((eval: EVAL, args: seq, body: try! list.nth(2), env: env))) -} - -// EVALuate "quote". -// -private func eval_quote(list: MalSequence, _ env: Environment) throws -> TCOVal { - if list.count >= 2 { - return TCOVal(try! list.nth(1)) - } - return TCOVal(make_nil()) -} - -// EVALuate "quasiquote". -// -private func eval_quasiquote(list: MalSequence, _ env: Environment) throws -> TCOVal { - guard list.count >= 2 else { - try throw_error("Expected non-nil parameter to 'quasiquote'") - } - if TCO { - return TCOVal(try quasiquote(try! list.nth(1)), env) - } - return TCOVal(try EVAL(try quasiquote(try! list.nth(1)), env)) -} - -// EVALuate "macroexpand". -// -private func eval_macroexpand(list: MalSequence, _ env: Environment) throws -> TCOVal { - guard list.count >= 2 else { - try throw_error("Expected parameter to 'macroexpand'") - } - return TCOVal(try macroexpand(try! list.nth(1), env)) -} - -// EVALuate "try*" (and "catch*"). -// -private func eval_try(list: MalSequence, _ env: Environment) throws -> TCOVal { - // This is a subset of the Clojure try/catch: - // - // (try* expr (catch exception-name expr)) - - guard list.count >= 2 else { - try throw_error("try*: no body parameter") - } - - do { - return TCOVal(try EVAL(try! list.nth(1), env)) - } catch let error as MalException { - guard list.count >= 3, - let catch_list = as_sequenceQ(try! list.nth(2)) where catch_list.count >= 3, - let _ = as_symbolQ(try! catch_list.nth(0)) else - { - throw error // No catch parameter - } - let catch_name = try! catch_list.nth(1) - let catch_expr = try! catch_list.nth(2) - let catch_env = Environment(outer: env) - try catch_env.set_bindings(as_sequence(make_list_from(catch_name)), - with_exprs: as_sequence(make_list_from(error.exception))) - return TCOVal(try EVAL(catch_expr, catch_env)) - } -} - -// Walk the AST and completely evaluate it, handling macro expansions, special -// forms and function calls. -// -private func EVAL(var ast: MalVal, var _ env: Environment) throws -> MalVal { - EVAL_level++ - defer { EVAL_level-- } - guard EVAL_level <= EVAL_leval_max else { - try throw_error("Recursing too many levels (> \(EVAL_leval_max))") - } - - if DEBUG_EVAL { - indent = substring(INDENT_TEMPLATE, 0, EVAL_level) - } - - while true { - if DEBUG_EVAL { print("\(indent)> \(ast)") } - - if !is_list(ast) { - - // Not a list -- just evaluate and return. - - let answer = try eval_ast(ast, env) - if DEBUG_EVAL { print("\(indent)>>> \(answer)") } - return answer - } - - // Special handling if it's a list. - - var list = as_list(ast) - ast = try macroexpand(ast, env) - if !is_list(ast) { - - // Not a list -- just evaluate and return. - - let answer = try eval_ast(ast, env) - if DEBUG_EVAL { print("\(indent)>>> \(answer)") } - return answer - } - list = as_list(ast) - - if DEBUG_EVAL { print("\(indent)>. \(list)") } - - if list.isEmpty { - return ast - } - - // Check for special forms, where we want to check the operation - // before evaluating all of the parameters. - - let arg0 = list.first() - if let fn_symbol = as_symbolQ(arg0) { - let res: TCOVal - - switch fn_symbol { - case kSymbolDef: res = try eval_def(list, env) - case kSymbolDefMacro: res = try eval_def(list, env) - case kSymbolLet: res = try eval_let(list, env) - case kSymbolDo: res = try eval_do(list, env) - case kSymbolIf: res = try eval_if(list, env) - case kSymbolFn: res = try eval_fn(list, env) - case kSymbolQuote: res = try eval_quote(list, env) - case kSymbolQuasiQuote: res = try eval_quasiquote(list, env) - case kSymbolMacroExpand: res = try eval_macroexpand(list, env) - case kSymbolTry: res = try eval_try(list, env) - default: res = TCOVal() - } - switch res { - case let .Return(result): return result - case let .Continue(new_ast, new_env): ast = new_ast; env = new_env; continue - case .NoResult: break - } - } - - // Standard list to be applied. Evaluate all the elements first. - - let eval = try eval_ast(ast, env) - - // The result had better be a list and better be non-empty. - - let eval_list = as_list(eval) - if eval_list.isEmpty { - return eval - } - - if DEBUG_EVAL { print("\(indent)>> \(eval)") } - - // Get the first element of the list and execute it. - - let first = eval_list.first() - let rest = as_sequence(eval_list.rest()) - - if let fn = as_builtinQ(first) { - let answer = try fn.apply(rest) - if DEBUG_EVAL { print("\(indent)>>> \(answer)") } - return answer - } else if let fn = as_closureQ(first) { - let new_env = Environment(outer: fn.env) - let _ = try new_env.set_bindings(fn.args, with_exprs: rest) - if TCO { - env = new_env - ast = fn.body - continue - } - let answer = try EVAL(fn.body, new_env) - if DEBUG_EVAL { print("\(indent)>>> \(answer)") } - return answer - } - - // The first element wasn't a function to be executed. Return an - // error saying so. - - try throw_error("first list item does not evaluate to a function: \(first)") - } -} - -// Convert the value into a human-readable string for printing. -// -private func PRINT(exp: MalVal) -> String { - return pr_str(exp, true) -} - -// Perform the READ and EVAL steps. Useful for when you don't care about the -// printable result. -// -private func RE(text: String, _ env: Environment) -> MalVal? { - if !text.isEmpty { - do { - let ast = try READ(text) - do { - return try EVAL(ast, env) - } catch let error as MalException { - print("Error evaluating input: \(error)") - } catch { - print("Error evaluating input: \(error)") - } - } catch let error as MalException { - print("Error parsing input: \(error)") - } catch { - print("Error parsing input: \(error)") - } - } - return nil -} - -// Perform the full READ/EVAL/PRINT, returning a printable string. -// -private func REP(text: String, _ env: Environment) -> String? { - let exp = RE(text, env) - if exp == nil { return nil } - return PRINT(exp!) -} - -// Perform the full REPL. -// -private func REPL(env: Environment) { - while true { - if let text = _readline("user> ") { - if let output = REP(text, env) { - print("\(output)") - } - } else { - print("") - break - } - } -} - -// Process any command line arguments. Any trailing arguments are incorporated -// into the environment. Any argument immediately after the process name is -// taken as a script to execute. If one exists, it is executed in lieu of -// running the REPL. -// -private func process_command_line(args: [String], _ env: Environment) -> Bool { - var argv = make_list() - if args.count > 2 { - let args1 = args[2.. 1 { - RE("(load-file \"\(args[1])\")", env) - return false - } - - return true -} - -func main() { - let env = Environment(outer: nil) - - load_history_file() - load_builtins(env) - - RE("(def! not (fn* (a) (if a false true)))", env) - RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))", 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)))))))", env) - 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))))))))", env) - - env.set(kSymbolEval, make_builtin({ - try! unwrap_args($0) { - (ast: MalVal) -> MalVal in - try EVAL(ast, env) - } - })) - - if process_command_line(Process.arguments, env) { - REPL(env) - } - - save_history_file() -} diff --git a/swift/stepA_mal.swift b/swift/stepA_mal.swift deleted file mode 100644 index c88a78c55b..0000000000 --- a/swift/stepA_mal.swift +++ /dev/null @@ -1,638 +0,0 @@ -//****************************************************************************** -// MAL - step A - mal -//****************************************************************************** -// This file is automatically generated from templates/step.swift. Rather than -// editing it directly, it's probably better to edit templates/step.swift and -// regenerate this file. Otherwise, your change might be lost if/when someone -// else performs that process. -//****************************************************************************** - -import Foundation - -// The number of times EVAL has been entered recursively. We keep track of this -// so that we can protect against overrunning the stack. -// -private var EVAL_level = 0 - -// The maximum number of times we let EVAL recurse before throwing an exception. -// Testing puts this at some place between 1800 and 1900. Let's keep it at 500 -// for safety's sake. -// -private let EVAL_leval_max = 500 - -// Control whether or not tail-call optimization (TCO) is enabled. We want it -// `true` most of the time, but may disable it for debugging purposes (it's -// easier to get a meaningful backtrace that way). -// -private let TCO = true - -// Control whether or not we emit debugging statements in EVAL. -// -private let DEBUG_EVAL = false - -// String used to prefix information logged in EVAL. Increasing lengths of the -// string are used the more EVAL is recursed. -// -private let INDENT_TEMPLATE = "|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" + - "----|----|----|----|----|----|----|----|----|----|----|" - -// Holds the prefix of INDENT_TEMPLATE used for actual logging. -// -private var indent = String() - -// Symbols used in this module. -// -private let kValArgv = make_symbol("*ARGV*") -private let kValCatch = make_symbol("catch*") -private let kValConcat = make_symbol("concat") -private let kValCons = make_symbol("cons") -private let kValDef = make_symbol("def!") -private let kValDefMacro = make_symbol("defmacro!") -private let kValDo = make_symbol("do") -private let kValEval = make_symbol("eval") -private let kValFn = make_symbol("fn*") -private let kValIf = make_symbol("if") -private let kValLet = make_symbol("let*") -private let kValMacroExpand = make_symbol("macroexpand") -private let kValQuasiQuote = make_symbol("quasiquote") -private let kValQuote = make_symbol("quote") -private let kValSpliceUnquote = make_symbol("splice-unquote") -private let kValUnquote = make_symbol("unquote") -private let kValTry = make_symbol("try*") - -private let kSymbolArgv = as_symbol(kValArgv) -private let kSymbolCatch = as_symbol(kValCatch) -private let kSymbolConcat = as_symbol(kValConcat) -private let kSymbolCons = as_symbol(kValCons) -private let kSymbolDef = as_symbol(kValDef) -private let kSymbolDefMacro = as_symbol(kValDefMacro) -private let kSymbolDo = as_symbol(kValDo) -private let kSymbolEval = as_symbol(kValEval) -private let kSymbolFn = as_symbol(kValFn) -private let kSymbolIf = as_symbol(kValIf) -private let kSymbolLet = as_symbol(kValLet) -private let kSymbolMacroExpand = as_symbol(kValMacroExpand) -private let kSymbolQuasiQuote = as_symbol(kValQuasiQuote) -private let kSymbolQuote = as_symbol(kValQuote) -private let kSymbolSpliceUnquote = as_symbol(kValSpliceUnquote) -private let kSymbolUnquote = as_symbol(kValUnquote) -private let kSymbolTry = as_symbol(kValTry) - -func substring(s: String, _ begin: Int, _ end: Int) -> String { - return s[s.startIndex.advancedBy(begin) ..< s.startIndex.advancedBy(end)] -} - -// Parse the string into an AST. -// -private func READ(str: String) throws -> MalVal { - return try read_str(str) -} - -// Return whether or not `val` is a non-empty list. -// -private func is_pair(val: MalVal) -> Bool { - if let seq = as_sequenceQ(val) { - return !seq.isEmpty - } - return false -} - -// Expand macros for as long as the expression looks like a macro invocation. -// -private func macroexpand(var ast: MalVal, _ env: Environment) throws -> MalVal { - while true { - if let ast_as_list = as_listQ(ast) where !ast_as_list.isEmpty, - let macro_name = as_symbolQ(ast_as_list.first()), - let obj = env.get(macro_name), - let macro = as_macroQ(obj) - { - let new_env = Environment(outer: macro.env) - let rest = as_sequence(ast_as_list.rest()) - let _ = try new_env.set_bindings(macro.args, with_exprs: rest) - ast = try EVAL(macro.body, new_env) - continue - } - return ast - } -} - -// Evaluate `quasiquote`, possibly recursing in the process. -// -// As with quote, unquote, and splice-unquote, quasiquote takes a single -// parameter, typically a list. In the general case, this list is processed -// recursively as: -// -// (quasiquote (first rest...)) -> (cons (quasiquote first) (quasiquote rest)) -// -// In the processing of the parameter passed to it, quasiquote handles three -// special cases: -// -// * If the parameter is an atom or an empty list, the following expression -// is formed and returned for evaluation: -// -// (quasiquote atom-or-empty-list) -> (quote atom-or-empty-list) -// -// * If the first element of the non-empty list is the symbol "unquote" -// followed by a second item, the second item is returned as-is: -// -// (quasiquote (unquote fred)) -> fred -// -// * If the first element of the non-empty list is another list containing -// the symbol "splice-unquote" followed by a list, that list is catenated -// with the quasiquoted result of the remaining items in the non-empty -// parent list: -// -// (quasiquote (splice-unquote list) rest...) -> (items-from-list items-from-quasiquote(rest...)) -// -// Note the inconsistent handling between "quote" and "splice-quote". The former -// is handled when this function is handed a list that starts with "quote", -// whereas the latter is handled when this function is handled a list whose -// first element is a list that starts with "splice-quote". The handling of the -// latter is forced by the need to incorporate the results of (splice-quote -// list) with the remaining items of the list containing that splice-quote -// expression. However, it's not clear to me why the handling of "unquote" is -// not handled similarly, for consistency's sake. -// -private func quasiquote(qq_arg: MalVal) throws -> MalVal { - - // If the argument is an atom or empty list: - // - // Return: (quote ) - - if !is_pair(qq_arg) { - return make_list_from(kValQuote, qq_arg) - } - - // The argument is a non-empty list -- that is (item rest...) - - // If the first item from the list is a symbol and it's "unquote" -- that - // is, (unquote item ignored...): - // - // Return: item - - let qq_list = as_sequence(qq_arg) - if let sym = as_symbolQ(qq_list.first()) where sym == kSymbolUnquote { - return qq_list.count >= 2 ? try! qq_list.nth(1) : make_nil() - } - - // If the first item from the list is itself a non-empty list starting with - // "splice-unquote"-- that is, ((splice-unquote item ignored...) rest...): - // - // Return: (concat item quasiquote(rest...)) - - if is_pair(qq_list.first()) { - let qq_list_item0 = as_sequence(qq_list.first()) - if let sym = as_symbolQ(qq_list_item0.first()) where sym == kSymbolSpliceUnquote { - let result = try quasiquote(qq_list.rest()) - return make_list_from(kValConcat, try! qq_list_item0.nth(1), result) - } - } - - // General case: (item rest...): - // - // Return: (cons (quasiquote item) (quasiquote (rest...)) - - let first = try quasiquote(qq_list.first()) - let rest = try quasiquote(qq_list.rest()) - return make_list_from(kValCons, first, rest) -} - -// Perform a simple evaluation of the `ast` object. If it's a symbol, -// dereference it and return its value. If it's a collection, call EVAL on all -// elements (or just the values, in the case of the hashmap). Otherwise, return -// the object unchanged. -// -private func eval_ast(ast: MalVal, _ env: Environment) throws -> MalVal { - if let symbol = as_symbolQ(ast) { - guard let val = env.get(symbol) else { - try throw_error("'\(symbol)' not found") // Specific text needed to match MAL unit tests - } - return val - } - if let list = as_listQ(ast) { - var result = [MalVal]() - result.reserveCapacity(Int(list.count)) - for item in list { - let eval = try EVAL(item, env) - result.append(eval) - } - return make_list(result) - } - if let vec = as_vectorQ(ast) { - var result = [MalVal]() - result.reserveCapacity(Int(vec.count)) - for item in vec { - let eval = try EVAL(item, env) - result.append(eval) - } - return make_vector(result) - } - if let hash = as_hashmapQ(ast) { - var result = [MalVal]() - result.reserveCapacity(Int(hash.count) * 2) - for (k, v) in hash { - let new_v = try EVAL(v, env) - result.append(k) - result.append(new_v) - } - return make_hashmap(result) - } - return ast -} - -private enum TCOVal { - case NoResult - case Return(MalVal) - case Continue(MalVal, Environment) - - init() { self = .NoResult } - init(_ result: MalVal) { self = .Return(result) } - init(_ ast: MalVal, _ env: Environment) { self = .Continue(ast, env) } -} - -// EVALuate "def!" and "defmacro!". -// -private func eval_def(list: MalSequence, _ env: Environment) throws -> TCOVal { - guard list.count == 3 else { - try throw_error("expected 2 arguments to def!, got \(list.count - 1)") - } - let arg0 = try! list.nth(0) - let arg1 = try! list.nth(1) - let arg2 = try! list.nth(2) - guard let sym = as_symbolQ(arg1) else { - try throw_error("expected symbol for first argument to def!") - } - var value = try EVAL(arg2, env) - if as_symbol(arg0) == kSymbolDefMacro { - guard let closure = as_closureQ(value) else { - try throw_error("expected closure, got \(value)") - } - value = make_macro(closure) - } - return TCOVal(env.set(sym, value)) -} - -// EVALuate "let*". -// -private func eval_let(list: MalSequence, _ env: Environment) throws -> TCOVal { - guard list.count == 3 else { - try throw_error("expected 2 arguments to let*, got \(list.count - 1)") - } - let arg1 = try! list.nth(1) - let arg2 = try! list.nth(2) - guard let bindings = as_sequenceQ(arg1) else { - try throw_error("expected list for first argument to let*") - } - guard bindings.count % 2 == 0 else { - try throw_error("expected even number of elements in bindings to let*, got \(bindings.count)") - } - let new_env = Environment(outer: env) - for var index: MalIntType = 0; index < bindings.count; index += 2 { - let binding_name = try! bindings.nth(index) - let binding_value = try! bindings.nth(index + 1) - guard let binding_symbol = as_symbolQ(binding_name) else { - try throw_error("expected symbol for first element in binding pair") - } - let evaluated_value = try EVAL(binding_value, new_env) - new_env.set(binding_symbol, evaluated_value) - } - if TCO { - return TCOVal(arg2, new_env) - } - return TCOVal(try EVAL(arg2, new_env)) -} - -// EVALuate "do". -// -private func eval_do(list: MalSequence, _ env: Environment) throws -> TCOVal { - if TCO { - let _ = try eval_ast(list.range_from(1, to: list.count-1), env) - return TCOVal(list.last(), env) - } - - let evaluated_ast = try eval_ast(list.rest(), env) - let evaluated_seq = as_sequence(evaluated_ast) - return TCOVal(evaluated_seq.last()) -} - -// EVALuate "if". -// -private func eval_if(list: MalSequence, _ env: Environment) throws -> TCOVal { - guard list.count >= 3 else { - try throw_error("expected at least 2 arguments to if, got \(list.count - 1)") - } - let cond_result = try EVAL(try! list.nth(1), env) - var new_ast: MalVal - if is_truthy(cond_result) { - new_ast = try! list.nth(2) - } else if list.count == 4 { - new_ast = try! list.nth(3) - } else { - return TCOVal(make_nil()) - } - if TCO { - return TCOVal(new_ast, env) - } - return TCOVal(try EVAL(new_ast, env)) -} - -// EVALuate "fn*". -// -private func eval_fn(list: MalSequence, _ env: Environment) throws -> TCOVal { - guard list.count == 3 else { - try throw_error("expected 2 arguments to fn*, got \(list.count - 1)") - } - guard let seq = as_sequenceQ(try! list.nth(1)) else { - try throw_error("expected list or vector for first argument to fn*") - } - return TCOVal(make_closure((eval: EVAL, args: seq, body: try! list.nth(2), env: env))) -} - -// EVALuate "quote". -// -private func eval_quote(list: MalSequence, _ env: Environment) throws -> TCOVal { - if list.count >= 2 { - return TCOVal(try! list.nth(1)) - } - return TCOVal(make_nil()) -} - -// EVALuate "quasiquote". -// -private func eval_quasiquote(list: MalSequence, _ env: Environment) throws -> TCOVal { - guard list.count >= 2 else { - try throw_error("Expected non-nil parameter to 'quasiquote'") - } - if TCO { - return TCOVal(try quasiquote(try! list.nth(1)), env) - } - return TCOVal(try EVAL(try quasiquote(try! list.nth(1)), env)) -} - -// EVALuate "macroexpand". -// -private func eval_macroexpand(list: MalSequence, _ env: Environment) throws -> TCOVal { - guard list.count >= 2 else { - try throw_error("Expected parameter to 'macroexpand'") - } - return TCOVal(try macroexpand(try! list.nth(1), env)) -} - -// EVALuate "try*" (and "catch*"). -// -private func eval_try(list: MalSequence, _ env: Environment) throws -> TCOVal { - // This is a subset of the Clojure try/catch: - // - // (try* expr (catch exception-name expr)) - - guard list.count >= 2 else { - try throw_error("try*: no body parameter") - } - - do { - return TCOVal(try EVAL(try! list.nth(1), env)) - } catch let error as MalException { - guard list.count >= 3, - let catch_list = as_sequenceQ(try! list.nth(2)) where catch_list.count >= 3, - let _ = as_symbolQ(try! catch_list.nth(0)) else - { - throw error // No catch parameter - } - let catch_name = try! catch_list.nth(1) - let catch_expr = try! catch_list.nth(2) - let catch_env = Environment(outer: env) - try catch_env.set_bindings(as_sequence(make_list_from(catch_name)), - with_exprs: as_sequence(make_list_from(error.exception))) - return TCOVal(try EVAL(catch_expr, catch_env)) - } -} - -// Walk the AST and completely evaluate it, handling macro expansions, special -// forms and function calls. -// -private func EVAL(var ast: MalVal, var _ env: Environment) throws -> MalVal { - EVAL_level++ - defer { EVAL_level-- } - guard EVAL_level <= EVAL_leval_max else { - try throw_error("Recursing too many levels (> \(EVAL_leval_max))") - } - - if DEBUG_EVAL { - indent = substring(INDENT_TEMPLATE, 0, EVAL_level) - } - - while true { - if DEBUG_EVAL { print("\(indent)> \(ast)") } - - if !is_list(ast) { - - // Not a list -- just evaluate and return. - - let answer = try eval_ast(ast, env) - if DEBUG_EVAL { print("\(indent)>>> \(answer)") } - return answer - } - - // Special handling if it's a list. - - var list = as_list(ast) - ast = try macroexpand(ast, env) - if !is_list(ast) { - - // Not a list -- just evaluate and return. - - let answer = try eval_ast(ast, env) - if DEBUG_EVAL { print("\(indent)>>> \(answer)") } - return answer - } - list = as_list(ast) - - if DEBUG_EVAL { print("\(indent)>. \(list)") } - - if list.isEmpty { - return ast - } - - // Check for special forms, where we want to check the operation - // before evaluating all of the parameters. - - let arg0 = list.first() - if let fn_symbol = as_symbolQ(arg0) { - let res: TCOVal - - switch fn_symbol { - case kSymbolDef: res = try eval_def(list, env) - case kSymbolDefMacro: res = try eval_def(list, env) - case kSymbolLet: res = try eval_let(list, env) - case kSymbolDo: res = try eval_do(list, env) - case kSymbolIf: res = try eval_if(list, env) - case kSymbolFn: res = try eval_fn(list, env) - case kSymbolQuote: res = try eval_quote(list, env) - case kSymbolQuasiQuote: res = try eval_quasiquote(list, env) - case kSymbolMacroExpand: res = try eval_macroexpand(list, env) - case kSymbolTry: res = try eval_try(list, env) - default: res = TCOVal() - } - switch res { - case let .Return(result): return result - case let .Continue(new_ast, new_env): ast = new_ast; env = new_env; continue - case .NoResult: break - } - } - - // Standard list to be applied. Evaluate all the elements first. - - let eval = try eval_ast(ast, env) - - // The result had better be a list and better be non-empty. - - let eval_list = as_list(eval) - if eval_list.isEmpty { - return eval - } - - if DEBUG_EVAL { print("\(indent)>> \(eval)") } - - // Get the first element of the list and execute it. - - let first = eval_list.first() - let rest = as_sequence(eval_list.rest()) - - if let fn = as_builtinQ(first) { - let answer = try fn.apply(rest) - if DEBUG_EVAL { print("\(indent)>>> \(answer)") } - return answer - } else if let fn = as_closureQ(first) { - let new_env = Environment(outer: fn.env) - let _ = try new_env.set_bindings(fn.args, with_exprs: rest) - if TCO { - env = new_env - ast = fn.body - continue - } - let answer = try EVAL(fn.body, new_env) - if DEBUG_EVAL { print("\(indent)>>> \(answer)") } - return answer - } - - // The first element wasn't a function to be executed. Return an - // error saying so. - - try throw_error("first list item does not evaluate to a function: \(first)") - } -} - -// Convert the value into a human-readable string for printing. -// -private func PRINT(exp: MalVal) -> String { - return pr_str(exp, true) -} - -// Perform the READ and EVAL steps. Useful for when you don't care about the -// printable result. -// -private func RE(text: String, _ env: Environment) -> MalVal? { - if !text.isEmpty { - do { - let ast = try READ(text) - do { - return try EVAL(ast, env) - } catch let error as MalException { - print("Error evaluating input: \(error)") - } catch { - print("Error evaluating input: \(error)") - } - } catch let error as MalException { - print("Error parsing input: \(error)") - } catch { - print("Error parsing input: \(error)") - } - } - return nil -} - -// Perform the full READ/EVAL/PRINT, returning a printable string. -// -private func REP(text: String, _ env: Environment) -> String? { - let exp = RE(text, env) - if exp == nil { return nil } - return PRINT(exp!) -} - -// Perform the full REPL. -// -private func REPL(env: Environment) { - while true { - if let text = _readline("user> ") { - if let output = REP(text, env) { - print("\(output)") - } - } else { - print("") - break - } - } -} - -// Process any command line arguments. Any trailing arguments are incorporated -// into the environment. Any argument immediately after the process name is -// taken as a script to execute. If one exists, it is executed in lieu of -// running the REPL. -// -private func process_command_line(args: [String], _ env: Environment) -> Bool { - var argv = make_list() - if args.count > 2 { - let args1 = args[2.. 1 { - RE("(load-file \"\(args[1])\")", env) - return false - } - - return true -} - -func main() { - let env = Environment(outer: nil) - - load_history_file() - load_builtins(env) - - RE("(def! *host-language* \"swift\")", env) - RE("(def! not (fn* (a) (if a false true)))", env) - RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))", 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)))))))", env) - RE("(def! *gensym-counter* (atom 0))", env) - RE("(def! gensym (fn* [] (symbol (str \"G__\" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))", env) - RE("(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)))))))))", env) - - env.set(kSymbolEval, make_builtin({ - try! unwrap_args($0) { - (ast: MalVal) -> MalVal in - try EVAL(ast, env) - } - })) - - if process_command_line(Process.arguments, env) { - RE("(println (str \"Mal [\" *host-language*\"]\"))", env) - REPL(env) - } - - save_history_file() -} diff --git a/swift/templates/add_steps.sh b/swift/templates/add_steps.sh deleted file mode 100755 index 488b54b82d..0000000000 --- a/swift/templates/add_steps.sh +++ /dev/null @@ -1,23 +0,0 @@ -#!/bin/bash - -# add_steps.sh input-file output-file -# -# Adds placeholder annotations to each line of a file. These annotations -# indicate which version(s) of the main (step*.swift) file the line should be -# included in. The annotations are just placeholders, and need to be edited to -# identify the right file versions. -# -# e.g.: -# -# $ ./add_steps.sh stepA_mal.swift main_template.swift - -SPC10=" " -SPC20="${SPC10}${SPC10}" -SPC40="${SPC20}${SPC20}" -SPC80="${SPC40}${SPC40}" -SPC160="${SPC80}${SPC80}" -sed < $1 > $2 -e "s/\(.*\)/\1${SPC160}/" -e "/^\(.\)\{156\} .*$/s/\(.\{160\}\).*/\1\/\/ malstep(A)/" - -# TBD: try the following, subsequently found on stackoverflow: -# -# sed -i ':a;/.\{63\}/!{s/$/ /;ba}' file diff --git a/swift/templates/filter_steps.sh b/swift/templates/filter_steps.sh deleted file mode 100755 index 44fe604b78..0000000000 --- a/swift/templates/filter_steps.sh +++ /dev/null @@ -1,9 +0,0 @@ -#!/bin/bash - -# filter_steps.sh step input-file output-file -# -# Filter the template file to produce a specific version of the file. E.g.: -# -# $ ./filter_steps 4 main_template.swift step4_if_fn_do.swift - -grep "malstep.*\<$1\>" $2 | sed -e 's/\(.*\)\/\/ malstep(.*)$/\1/' -e 's/ *$//' > $3 diff --git a/swift/templates/step.swift b/swift/templates/step.swift deleted file mode 100644 index 7a02fb8722..0000000000 --- a/swift/templates/step.swift +++ /dev/null @@ -1,805 +0,0 @@ -//****************************************************************************** -// -// This file is used to generate the various "step" files, which in turn are -// used to create the various step executables. -// -// For the most part, this file is the final step file, with each line annotated -// with information that says in which step the line is introduced into the -// project. A simple filter program scans this template file, pulling out the -// lines required for a specified step. -// -// Ideally, after each line is included in a project, it stays in the project. -// This would make each step file a proper superset of the previous steps files. -// However, such idealism cannot be realized. There are cases where lines -// introduced in early step files need to be removed or replaced with new -// version. -// -// When this happens, multiple versions of a particular line can appear in the -// file. For example, consider the READ function. Early in the project, it is -// introduced as: -// -// func READ(str: String) -> String { -// return str -// } -// -// However, it is replaced in a subsequent step with: -// -// func READ(str: String) -> MalVal { -// return read_str(str) -// } -// -// To support both forms, both are included in this template file. The first is -// annotated to say that it appears in step 0 and *only* in step 0. The second -// is annotated to say that it appears in step 1 and in all subsequent versions. -// -// Where possible, in the interests for clarity, where lines are introduced and -// replaced, the entire function that is affected is introduced and replaced. -// This is as opposed to trying to surgically identify the line-by-line changes -// within a function that need to be replaced. -// -// However, in other cases, the surgical line-by-line replacement of text is -// employed. This is done in cases where the number of lines to change is small -// compared to the overall size of the function. -// -// Places where previously-introduced lines are changed or removed are marked -// with a ">>> NOTE:" comment. -// -// Lines with no annotations (like those comprising this comment block) are -// never included in any output. -// -//****************************************************************************** - -//****************************************************************************** // malstep(0,1,2,3,4,5,6,7,8,9,A) -// MAL - step 0 - repl // malstep(0) -// MAL - step 1 - read/print // malstep(1) -// MAL - step 2 - eval // malstep(2) -// MAL - step 3 - env // malstep(3) -// MAL - step 4 - if/fn/do // malstep(4) -// MAL - step 5 - tco // malstep(5) -// MAL - step 6 - file // malstep(6) -// MAL - step 7 - quote // malstep(7) -// MAL - step 8 - macros // malstep(8) -// MAL - step 9 - try // malstep(9) -// MAL - step A - mal // malstep(A) -//****************************************************************************** // malstep(0,1,2,3,4,5,6,7,8,9,A) -// This file is automatically generated from templates/step.swift. Rather than // malstep(0,1,2,3,4,5,6,7,8,9,A) -// editing it directly, it's probably better to edit templates/step.swift and // malstep(0,1,2,3,4,5,6,7,8,9,A) -// regenerate this file. Otherwise, your change might be lost if/when someone // malstep(0,1,2,3,4,5,6,7,8,9,A) -// else performs that process. // malstep(0,1,2,3,4,5,6,7,8,9,A) -//****************************************************************************** // malstep(0,1,2,3,4,5,6,7,8,9,A) - // malstep(0,1,2,3,4,5,6,7,8,9,A) -import Foundation // malstep(0,1,2,3,4,5,6,7,8,9,A) - // malstep(0,1,2,3,4,5,6,7,8,9,A) -// The number of times EVAL has been entered recursively. We keep track of this // malstep(5,6,7,8,9,A) -// so that we can protect against overrunning the stack. // malstep(5,6,7,8,9,A) -// // malstep(5,6,7,8,9,A) -private var EVAL_level = 0 // malstep(5,6,7,8,9,A) - // malstep(5,6,7,8,9,A) -// The maximum number of times we let EVAL recurse before throwing an exception. // malstep(5,6,7,8,9,A) -// Testing puts this at some place between 1800 and 1900. Let's keep it at 500 // malstep(5,6,7,8,9,A) -// for safety's sake. // malstep(5,6,7,8,9,A) -// // malstep(5,6,7,8,9,A) -private let EVAL_leval_max = 500 // malstep(5,6,7,8,9,A) - // malstep(5,6,7,8,9,A) -// Control whether or not tail-call optimization (TCO) is enabled. We want it // malstep(5,6,7,8,9,A) -// `true` most of the time, but may disable it for debugging purposes (it's // malstep(5,6,7,8,9,A) -// easier to get a meaningful backtrace that way). // malstep(5,6,7,8,9,A) -// // malstep(5,6,7,8,9,A) -private let TCO = true // malstep(5,6,7,8,9,A) - // malstep(5,6,7,8,9,A) -// Control whether or not we emit debugging statements in EVAL. // malstep(5,6,7,8,9,A) -// // malstep(5,6,7,8,9,A) -private let DEBUG_EVAL = false // malstep(5,6,7,8,9,A) - // malstep(5,6,7,8,9,A) -// String used to prefix information logged in EVAL. Increasing lengths of the // malstep(5,6,7,8,9,A) -// string are used the more EVAL is recursed. // malstep(5,6,7,8,9,A) -// // malstep(5,6,7,8,9,A) -private let INDENT_TEMPLATE = "|----|----|----|----|----|----|----|----|" + // malstep(5,6,7,8,9,A) - "----|----|----|----|----|----|----|----|----|----|----|" + // malstep(5,6,7,8,9,A) - "----|----|----|----|----|----|----|----|----|----|----|" + // malstep(5,6,7,8,9,A) - "----|----|----|----|----|----|----|----|----|----|----|" + // malstep(5,6,7,8,9,A) - "----|----|----|----|----|----|----|----|----|----|----|" + // malstep(5,6,7,8,9,A) - "----|----|----|----|----|----|----|----|----|----|----|" + // malstep(5,6,7,8,9,A) - "----|----|----|----|----|----|----|----|----|----|----|" + // malstep(5,6,7,8,9,A) - "----|----|----|----|----|----|----|----|----|----|----|" + // malstep(5,6,7,8,9,A) - "----|----|----|----|----|----|----|----|----|----|----|" + // malstep(5,6,7,8,9,A) - "----|----|----|----|----|----|----|----|----|----|----|" + // malstep(5,6,7,8,9,A) - "----|----|----|----|----|----|----|----|----|----|----|" // malstep(5,6,7,8,9,A) - // malstep(5,6,7,8,9,A) -// Holds the prefix of INDENT_TEMPLATE used for actual logging. // malstep(5,6,7,8,9,A) -// // malstep(5,6,7,8,9,A) -private var indent = String() // malstep(5,6,7,8,9,A) - // malstep(5,6,7,8,9,A) -// Symbols used in this module. // malstep(3,4,5,6,7,8,9,A) -// // malstep(3,4,5,6,7,8,9,A) -private let kValArgv = make_symbol("*ARGV*") // malstep(6,7,8,9,A) -private let kValCatch = make_symbol("catch*") // malstep(9,A) -private let kValConcat = make_symbol("concat") // malstep(7,8,9,A) -private let kValCons = make_symbol("cons") // malstep(7,8,9,A) -private let kValDef = make_symbol("def!") // malstep(3,4,5,6,7,8,9,A) -private let kValDefMacro = make_symbol("defmacro!") // malstep(8,9,A) -private let kValDo = make_symbol("do") // malstep(4,5,6,7,8,9,A) -private let kValEval = make_symbol("eval") // malstep(6,7,8,9,A) -private let kValFn = make_symbol("fn*") // malstep(4,5,6,7,8,9,A) -private let kValIf = make_symbol("if") // malstep(4,5,6,7,8,9,A) -private let kValLet = make_symbol("let*") // malstep(3,4,5,6,7,8,9,A) -private let kValMacroExpand = make_symbol("macroexpand") // malstep(8,9,A) -private let kValQuasiQuote = make_symbol("quasiquote") // malstep(7,8,9,A) -private let kValQuote = make_symbol("quote") // malstep(7,8,9,A) -private let kValSpliceUnquote = make_symbol("splice-unquote") // malstep(7,8,9,A) -private let kValUnquote = make_symbol("unquote") // malstep(7,8,9,A) -private let kValTry = make_symbol("try*") // malstep(3,4,5,6,7,8,9,A) - // malstep(3,4,5,6,7,8,9,A) -private let kSymbolArgv = as_symbol(kValArgv) // malstep(6,7,8,9,A) -private let kSymbolCatch = as_symbol(kValCatch) // malstep(9,A) -private let kSymbolConcat = as_symbol(kValConcat) // malstep(7,8,9,A) -private let kSymbolCons = as_symbol(kValCons) // malstep(7,8,9,A) -private let kSymbolDef = as_symbol(kValDef) // malstep(3,4,5,6,7,8,9,A) -private let kSymbolDefMacro = as_symbol(kValDefMacro) // malstep(8,9,A) -private let kSymbolDo = as_symbol(kValDo) // malstep(4,5,6,7,8,9,A) -private let kSymbolEval = as_symbol(kValEval) // malstep(6,7,8,9,A) -private let kSymbolFn = as_symbol(kValFn) // malstep(4,5,6,7,8,9,A) -private let kSymbolIf = as_symbol(kValIf) // malstep(4,5,6,7,8,9,A) -private let kSymbolLet = as_symbol(kValLet) // malstep(3,4,5,6,7,8,9,A) -private let kSymbolMacroExpand = as_symbol(kValMacroExpand) // malstep(8,9,A) -private let kSymbolQuasiQuote = as_symbol(kValQuasiQuote) // malstep(7,8,9,A) -private let kSymbolQuote = as_symbol(kValQuote) // malstep(7,8,9,A) -private let kSymbolSpliceUnquote = as_symbol(kValSpliceUnquote) // malstep(7,8,9,A) -private let kSymbolUnquote = as_symbol(kValUnquote) // malstep(7,8,9,A) -private let kSymbolTry = as_symbol(kValTry) // malstep(9,A) - // malstep(3,4,5,6,7,8,9,A) -func substring(s: String, _ begin: Int, _ end: Int) -> String { // malstep(5,6,7,8,9,A) - return s[s.startIndex.advancedBy(begin) ..< s.startIndex.advancedBy(end)] // malstep(5,6,7,8,9,A) -} // malstep(5,6,7,8,9,A) - // malstep(5,6,7,8,9,A) -// -// >>> NOTE: There are two versions of the following function: one used in step -// >>> 0 and one used in all subsequent versions. -// - -// Parse the string into an AST. // malstep(0,1,2,3,4,5,6,7,8,9,A) -// // malstep(0,1,2,3,4,5,6,7,8,9,A) -private func READ(str: String) -> String { // malstep(0) - return str // malstep(0) -} // malstep(0) -private func READ(str: String) throws -> MalVal { // malstep(1,2,3,4,5,6,7,8,9,A) - return try read_str(str) // malstep(1,2,3,4,5,6,7,8,9,A) -} // malstep(1,2,3,4,5,6,7,8,9,A) - // malstep(0,1,2,3,4,5,6,7,8,9,A) -// Return whether or not `val` is a non-empty list. // malstep(7,8,9,A) -// // malstep(7,8,9,A) -private func is_pair(val: MalVal) -> Bool { // malstep(7,8,9,A) - if let seq = as_sequenceQ(val) { // malstep(7,8,9,A) - return !seq.isEmpty // malstep(7,8,9,A) - } // malstep(7,8,9,A) - return false // malstep(7,8,9,A) -} // malstep(7,8,9,A) - // malstep(7,8,9,A) -// Expand macros for as long as the expression looks like a macro invocation. // malstep(8,9,A) -// // malstep(8,9,A) -private func macroexpand(var ast: MalVal, _ env: Environment) throws -> MalVal { // malstep(8,9,A) - while true { // malstep(8,9,A) - if let ast_as_list = as_listQ(ast) where !ast_as_list.isEmpty, // malstep(8,9,A) - let macro_name = as_symbolQ(ast_as_list.first()), // malstep(8,9,A) - let obj = env.get(macro_name), // malstep(8,9,A) - let macro = as_macroQ(obj) // malstep(8,9,A) - { // malstep(8,9,A) - let new_env = Environment(outer: macro.env) // malstep(8,9,A) - let rest = as_sequence(ast_as_list.rest()) // malstep(8,9,A) - let _ = try new_env.set_bindings(macro.args, with_exprs: rest) // malstep(8,9,A) - ast = try EVAL(macro.body, new_env) // malstep(8,9,A) - continue // malstep(8,9,A) - } // malstep(8,9,A) - return ast // malstep(8,9,A) - } // malstep(8,9,A) -} // malstep(8,9,A) - // malstep(8,9,A) -// Evaluate `quasiquote`, possibly recursing in the process. // malstep(7,8,9,A) -// // malstep(7,8,9,A) -// As with quote, unquote, and splice-unquote, quasiquote takes a single // malstep(7,8,9,A) -// parameter, typically a list. In the general case, this list is processed // malstep(7,8,9,A) -// recursively as: // malstep(7,8,9,A) -// // malstep(7,8,9,A) -// (quasiquote (first rest...)) -> (cons (quasiquote first) (quasiquote rest)) // malstep(7,8,9,A) -// // malstep(7,8,9,A) -// In the processing of the parameter passed to it, quasiquote handles three // malstep(7,8,9,A) -// special cases: // malstep(7,8,9,A) -// // malstep(7,8,9,A) -// * If the parameter is an atom or an empty list, the following expression // malstep(7,8,9,A) -// is formed and returned for evaluation: // malstep(7,8,9,A) -// // malstep(7,8,9,A) -// (quasiquote atom-or-empty-list) -> (quote atom-or-empty-list) // malstep(7,8,9,A) -// // malstep(7,8,9,A) -// * If the first element of the non-empty list is the symbol "unquote" // malstep(7,8,9,A) -// followed by a second item, the second item is returned as-is: // malstep(7,8,9,A) -// // malstep(7,8,9,A) -// (quasiquote (unquote fred)) -> fred // malstep(7,8,9,A) -// // malstep(7,8,9,A) -// * If the first element of the non-empty list is another list containing // malstep(7,8,9,A) -// the symbol "splice-unquote" followed by a list, that list is catenated // malstep(7,8,9,A) -// with the quasiquoted result of the remaining items in the non-empty // malstep(7,8,9,A) -// parent list: // malstep(7,8,9,A) -// // malstep(7,8,9,A) -// (quasiquote (splice-unquote list) rest...) -> (items-from-list items-from-quasiquote(rest...)) // malstep(7,8,9,A) -// // malstep(7,8,9,A) -// Note the inconsistent handling between "quote" and "splice-quote". The former // malstep(7,8,9,A) -// is handled when this function is handed a list that starts with "quote", // malstep(7,8,9,A) -// whereas the latter is handled when this function is handled a list whose // malstep(7,8,9,A) -// first element is a list that starts with "splice-quote". The handling of the // malstep(7,8,9,A) -// latter is forced by the need to incorporate the results of (splice-quote // malstep(7,8,9,A) -// list) with the remaining items of the list containing that splice-quote // malstep(7,8,9,A) -// expression. However, it's not clear to me why the handling of "unquote" is // malstep(7,8,9,A) -// not handled similarly, for consistency's sake. // malstep(7,8,9,A) -// // malstep(7,8,9,A) -private func quasiquote(qq_arg: MalVal) throws -> MalVal { // malstep(7,8,9,A) - // malstep(7,8,9,A) - // If the argument is an atom or empty list: // malstep(7,8,9,A) - // // malstep(7,8,9,A) - // Return: (quote ) // malstep(7,8,9,A) - // malstep(7,8,9,A) - if !is_pair(qq_arg) { // malstep(7,8,9,A) - return make_list_from(kValQuote, qq_arg) // malstep(7,8,9,A) - } // malstep(7,8,9,A) - // malstep(7,8,9,A) - // The argument is a non-empty list -- that is (item rest...) // malstep(7,8,9,A) - // malstep(7,8,9,A) - // If the first item from the list is a symbol and it's "unquote" -- that // malstep(7,8,9,A) - // is, (unquote item ignored...): // malstep(7,8,9,A) - // // malstep(7,8,9,A) - // Return: item // malstep(7,8,9,A) - // malstep(7,8,9,A) - let qq_list = as_sequence(qq_arg) // malstep(7,8,9,A) - if let sym = as_symbolQ(qq_list.first()) where sym == kSymbolUnquote { // malstep(7,8,9,A) - return qq_list.count >= 2 ? try! qq_list.nth(1) : make_nil() // malstep(7,8,9,A) - } // malstep(7,8,9,A) - // malstep(7,8,9,A) - // If the first item from the list is itself a non-empty list starting with // malstep(7,8,9,A) - // "splice-unquote"-- that is, ((splice-unquote item ignored...) rest...): // malstep(7,8,9,A) - // // malstep(7,8,9,A) - // Return: (concat item quasiquote(rest...)) // malstep(7,8,9,A) - // malstep(7,8,9,A) - if is_pair(qq_list.first()) { // malstep(7,8,9,A) - let qq_list_item0 = as_sequence(qq_list.first()) // malstep(7,8,9,A) - if let sym = as_symbolQ(qq_list_item0.first()) where sym == kSymbolSpliceUnquote { // malstep(7,8,9,A) - let result = try quasiquote(qq_list.rest()) // malstep(7,8,9,A) - return make_list_from(kValConcat, try! qq_list_item0.nth(1), result) // malstep(7,8,9,A) - } // malstep(7,8,9,A) - } // malstep(7,8,9,A) - // malstep(7,8,9,A) - // General case: (item rest...): // malstep(7,8,9,A) - // // malstep(7,8,9,A) - // Return: (cons (quasiquote item) (quasiquote (rest...)) // malstep(7,8,9,A) - // malstep(7,8,9,A) - let first = try quasiquote(qq_list.first()) // malstep(7,8,9,A) - let rest = try quasiquote(qq_list.rest()) // malstep(7,8,9,A) - return make_list_from(kValCons, first, rest) // malstep(7,8,9,A) -} // malstep(7,8,9,A) - // malstep(7,8,9,A) -// Perform a simple evaluation of the `ast` object. If it's a symbol, // malstep(2,3,4,5,6,7,8,9,A) -// dereference it and return its value. If it's a collection, call EVAL on all // malstep(2,3,4,5,6,7,8,9,A) -// elements (or just the values, in the case of the hashmap). Otherwise, return // malstep(2,3,4,5,6,7,8,9,A) -// the object unchanged. // malstep(2,3,4,5,6,7,8,9,A) -// // malstep(2,3,4,5,6,7,8,9,A) -private func eval_ast(ast: MalVal, _ env: Environment) throws -> MalVal { // malstep(2,3,4,5,6,7,8,9,A) - if let symbol = as_symbolQ(ast) { // malstep(2,3,4,5,6,7,8,9,A) - guard let val = env.get(symbol) else { // malstep(2,3,4,5,6,7,8,9,A) - try throw_error("'\(symbol)' not found") // Specific text needed to match MAL unit tests // malstep(2,3,4,5,6,7,8,9,A) - } // malstep(2,3,4,5,6,7,8,9,A) - return val // malstep(2,3,4,5,6,7,8,9,A) - } // malstep(2,3,4,5,6,7,8,9,A) - if let list = as_listQ(ast) { // malstep(2,3,4,5,6,7,8,9,A) - var result = [MalVal]() // malstep(2,3,4,5,6,7,8,9,A) - result.reserveCapacity(Int(list.count)) // malstep(2,3,4,5,6,7,8,9,A) - for item in list { // malstep(2,3,4,5,6,7,8,9,A) - let eval = try EVAL(item, env) // malstep(2,3,4,5,6,7,8,9,A) - result.append(eval) // malstep(2,3,4,5,6,7,8,9,A) - } // malstep(2,3,4,5,6,7,8,9,A) - return make_list(result) // malstep(2,3,4,5,6,7,8,9,A) - } // malstep(2,3,4,5,6,7,8,9,A) - if let vec = as_vectorQ(ast) { // malstep(2,3,4,5,6,7,8,9,A) - var result = [MalVal]() // malstep(2,3,4,5,6,7,8,9,A) - result.reserveCapacity(Int(vec.count)) // malstep(2,3,4,5,6,7,8,9,A) - for item in vec { // malstep(2,3,4,5,6,7,8,9,A) - let eval = try EVAL(item, env) // malstep(2,3,4,5,6,7,8,9,A) - result.append(eval) // malstep(2,3,4,5,6,7,8,9,A) - } // malstep(2,3,4,5,6,7,8,9,A) - return make_vector(result) // malstep(2,3,4,5,6,7,8,9,A) - } // malstep(2,3,4,5,6,7,8,9,A) - if let hash = as_hashmapQ(ast) { // malstep(2,3,4,5,6,7,8,9,A) - var result = [MalVal]() // malstep(2,3,4,5,6,7,8,9,A) - result.reserveCapacity(Int(hash.count) * 2) // malstep(2,3,4,5,6,7,8,9,A) - for (k, v) in hash { // malstep(2,3,4,5,6,7,8,9,A) - let new_v = try EVAL(v, env) // malstep(2,3,4,5,6,7,8,9,A) - result.append(k) // malstep(2,3,4,5,6,7,8,9,A) - result.append(new_v) // malstep(2,3,4,5,6,7,8,9,A) - } // malstep(2,3,4,5,6,7,8,9,A) - return make_hashmap(result) // malstep(2,3,4,5,6,7,8,9,A) - } // malstep(2,3,4,5,6,7,8,9,A) - return ast // malstep(2,3,4,5,6,7,8,9,A) -} // malstep(2,3,4,5,6,7,8,9,A) - // malstep(2,3,4,5,6,7,8,9,A) -private enum TCOVal { // malstep(5,6,7,8,9,A) - case NoResult // malstep(5,6,7,8,9,A) - case Return(MalVal) // malstep(5,6,7,8,9,A) - case Continue(MalVal, Environment) // malstep(5,6,7,8,9,A) - // malstep(5,6,7,8,9,A) - init() { self = .NoResult } // malstep(5,6,7,8,9,A) - init(_ result: MalVal) { self = .Return(result) } // malstep(5,6,7,8,9,A) - init(_ ast: MalVal, _ env: Environment) { self = .Continue(ast, env) } // malstep(5,6,7,8,9,A) -} // malstep(5,6,7,8,9,A) - // malstep(5,6,7,8,9,A) -// EVALuate "def!". // malstep(3,4,5,6,7) -// EVALuate "def!" and "defmacro!". // malstep(8,9,A) -// // malstep(3,4,5,6,7,8,9,A) -private func eval_def(list: MalSequence, _ env: Environment) throws -> MalVal { // malstep(3,4) -private func eval_def(list: MalSequence, _ env: Environment) throws -> TCOVal { // malstep(5,6,7,8,9,A) - guard list.count == 3 else { // malstep(3,4,5,6,7,8,9,A) - try throw_error("expected 2 arguments to def!, got \(list.count - 1)") // malstep(3,4,5,6,7,8,9,A) - } // malstep(3,4,5,6,7,8,9,A) - let arg0 = try! list.nth(0) // malstep(8,9,A) - let arg1 = try! list.nth(1) // malstep(3,4,5,6,7,8,9,A) - let arg2 = try! list.nth(2) // malstep(3,4,5,6,7,8,9,A) - guard let sym = as_symbolQ(arg1) else { // malstep(3,4,5,6,7,8,9,A) - try throw_error("expected symbol for first argument to def!") // malstep(3,4,5,6,7,8,9,A) - } // malstep(3,4,5,6,7,8,9,A) - let value = try EVAL(arg2, env) // malstep(3,4,5,6,7) - var value = try EVAL(arg2, env) // malstep(8,9,A) - if as_symbol(arg0) == kSymbolDefMacro { // malstep(8,9,A) - guard let closure = as_closureQ(value) else { // malstep(8,9,A) - try throw_error("expected closure, got \(value)") // malstep(8,9,A) - } // malstep(8,9,A) - value = make_macro(closure) // malstep(8,9,A) - } // malstep(8,9,A) - return env.set(sym, value) // malstep(3,4) - return TCOVal(env.set(sym, value)) // malstep(5,6,7,8,9,A) -} // malstep(3,4,5,6,7,8,9,A) - // malstep(3,4,5,6,7,8,9,A) -// EVALuate "let*". // malstep(3,4,5,6,7,8,9,A) -// // malstep(3,4,5,6,7,8,9,A) -private func eval_let(list: MalSequence, _ env: Environment) throws -> MalVal { // malstep(3,4) -private func eval_let(list: MalSequence, _ env: Environment) throws -> TCOVal { // malstep(5,6,7,8,9,A) - guard list.count == 3 else { // malstep(3,4,5,6,7,8,9,A) - try throw_error("expected 2 arguments to let*, got \(list.count - 1)") // malstep(3,4,5,6,7,8,9,A) - } // malstep(3,4,5,6,7,8,9,A) - let arg1 = try! list.nth(1) // malstep(3,4,5,6,7,8,9,A) - let arg2 = try! list.nth(2) // malstep(3,4,5,6,7,8,9,A) - guard let bindings = as_sequenceQ(arg1) else { // malstep(3,4,5,6,7,8,9,A) - try throw_error("expected list for first argument to let*") // malstep(3,4,5,6,7,8,9,A) - } // malstep(3,4,5,6,7,8,9,A) - guard bindings.count % 2 == 0 else { // malstep(3,4,5,6,7,8,9,A) - try throw_error("expected even number of elements in bindings to let*, got \(bindings.count)") // malstep(3,4,5,6,7,8,9,A) - } // malstep(3,4,5,6,7,8,9,A) - let new_env = Environment(outer: env) // malstep(3,4,5,6,7,8,9,A) - for var index: MalIntType = 0; index < bindings.count; index += 2 { // malstep(3,4,5,6,7,8,9,A) - let binding_name = try! bindings.nth(index) // malstep(3,4,5,6,7,8,9,A) - let binding_value = try! bindings.nth(index + 1) // malstep(3,4,5,6,7,8,9,A) - guard let binding_symbol = as_symbolQ(binding_name) else { // malstep(3,4,5,6,7,8,9,A) - try throw_error("expected symbol for first element in binding pair") // malstep(3,4,5,6,7,8,9,A) - } // malstep(3,4,5,6,7,8,9,A) - let evaluated_value = try EVAL(binding_value, new_env) // malstep(3,4,5,6,7,8,9,A) - new_env.set(binding_symbol, evaluated_value) // malstep(3,4,5,6,7,8,9,A) - } // malstep(3,4,5,6,7,8,9,A) - if TCO { // malstep(5,6,7,8,9,A) - return TCOVal(arg2, new_env) // malstep(5,6,7,8,9,A) - } // malstep(5,6,7,8,9,A) - return try EVAL(arg2, new_env) // malstep(3,4) - return TCOVal(try EVAL(arg2, new_env)) // malstep(5,6,7,8,9,A) -} // malstep(3,4,5,6,7,8,9,A) - // malstep(3,4,5,6,7,8,9,A) -// EVALuate "do". // malstep(4,5,6,7,8,9,A) -// // malstep(4,5,6,7,8,9,A) -private func eval_do(list: MalSequence, _ env: Environment) throws -> MalVal { // malstep(4) -private func eval_do(list: MalSequence, _ env: Environment) throws -> TCOVal { // malstep(5,6,7,8,9,A) - if TCO { // malstep(5,6,7,8,9,A) - let _ = try eval_ast(list.range_from(1, to: list.count-1), env) // malstep(5,6,7,8,9,A) - return TCOVal(list.last(), env) // malstep(5,6,7,8,9,A) - } // malstep(5,6,7,8,9,A) - // malstep(5,6,7,8,9,A) - let evaluated_ast = try eval_ast(list.rest(), env) // malstep(4,5,6,7,8,9,A) - let evaluated_seq = as_sequence(evaluated_ast) // malstep(4,5,6,7,8,9,A) - return evaluated_seq.last() // malstep(4) - return TCOVal(evaluated_seq.last()) // malstep(5,6,7,8,9,A) -} // malstep(4,5,6,7,8,9,A) - // malstep(4,5,6,7,8,9,A) -// EVALuate "if". // malstep(4,5,6,7,8,9,A) -// // malstep(4,5,6,7,8,9,A) -private func eval_if(list: MalSequence, _ env: Environment) throws -> MalVal { // malstep(4) -private func eval_if(list: MalSequence, _ env: Environment) throws -> TCOVal { // malstep(5,6,7,8,9,A) - guard list.count >= 3 else { // malstep(4,5,6,7,8,9,A) - try throw_error("expected at least 2 arguments to if, got \(list.count - 1)") // malstep(4,5,6,7,8,9,A) - } // malstep(4,5,6,7,8,9,A) - let cond_result = try EVAL(try! list.nth(1), env) // malstep(4,5,6,7,8,9,A) - var new_ast: MalVal // malstep(4,5,6,7,8,9,A) - if is_truthy(cond_result) { // malstep(4,5,6,7,8,9,A) - new_ast = try! list.nth(2) // malstep(4,5,6,7,8,9,A) - } else if list.count == 4 { // malstep(4,5,6,7,8,9,A) - new_ast = try! list.nth(3) // malstep(4,5,6,7,8,9,A) - } else { // malstep(4,5,6,7,8,9,A) - return make_nil() // malstep(4) - return TCOVal(make_nil()) // malstep(5,6,7,8,9,A) - } // malstep(4,5,6,7,8,9,A) - if TCO { // malstep(5,6,7,8,9,A) - return TCOVal(new_ast, env) // malstep(5,6,7,8,9,A) - } // malstep(5,6,7,8,9,A) - return try EVAL(new_ast, env) // malstep(4) - return TCOVal(try EVAL(new_ast, env)) // malstep(5,6,7,8,9,A) -} // malstep(4,5,6,7,8,9,A) - // malstep(4,5,6,7,8,9,A) -// EVALuate "fn*". // malstep(4,5,6,7,8,9,A) -// // malstep(4,5,6,7,8,9,A) -private func eval_fn(list: MalSequence, _ env: Environment) throws -> MalVal { // malstep(4) -private func eval_fn(list: MalSequence, _ env: Environment) throws -> TCOVal { // malstep(5,6,7,8,9,A) - guard list.count == 3 else { // malstep(4,5,6,7,8,9,A) - try throw_error("expected 2 arguments to fn*, got \(list.count - 1)") // malstep(4,5,6,7,8,9,A) - } // malstep(4,5,6,7,8,9,A) - guard let seq = as_sequenceQ(try! list.nth(1)) else { // malstep(4,5,6,7,8,9,A) - try throw_error("expected list or vector for first argument to fn*") // malstep(4,5,6,7,8,9,A) - } // malstep(4,5,6,7,8,9,A) - return make_closure((eval: EVAL, args: seq, body: try! list.nth(2), env: env)) // malstep(4) - return TCOVal(make_closure((eval: EVAL, args: seq, body: try! list.nth(2), env: env))) // malstep(5,6,7,8,9,A) -} // malstep(4,5,6,7,8,9,A) - // malstep(4,5,6,7,8,9,A) -// EVALuate "quote". // malstep(7,8,9,A) -// // malstep(7,8,9,A) -private func eval_quote(list: MalSequence, _ env: Environment) throws -> TCOVal { // malstep(7,8,9,A) - if list.count >= 2 { // malstep(7,8,9,A) - return TCOVal(try! list.nth(1)) // malstep(7,8,9,A) - } // malstep(7,8,9,A) - return TCOVal(make_nil()) // malstep(7,8,9,A) -} // malstep(7,8,9,A) - // malstep(7,8,9,A) -// EVALuate "quasiquote". // malstep(7,8,9,A) -// // malstep(7,8,9,A) -private func eval_quasiquote(list: MalSequence, _ env: Environment) throws -> TCOVal { // malstep(7,8,9,A) - guard list.count >= 2 else { // malstep(7,8,9,A) - try throw_error("Expected non-nil parameter to 'quasiquote'") // malstep(7,8,9,A) - } // malstep(7,8,9,A) - if TCO { // malstep(7,8,9,A) - return TCOVal(try quasiquote(try! list.nth(1)), env) // malstep(7,8,9,A) - } // malstep(7,8,9,A) - return TCOVal(try EVAL(try quasiquote(try! list.nth(1)), env)) // malstep(7,8,9,A) -} // malstep(7,8,9,A) - // malstep(7,8,9,A) -// EVALuate "macroexpand". // malstep(8,9,A) -// // malstep(8,9,A) -private func eval_macroexpand(list: MalSequence, _ env: Environment) throws -> TCOVal { // malstep(8,9,A) - guard list.count >= 2 else { // malstep(8,9,A) - try throw_error("Expected parameter to 'macroexpand'") // malstep(8,9,A) - } // malstep(8,9,A) - return TCOVal(try macroexpand(try! list.nth(1), env)) // malstep(8,9,A) -} // malstep(8,9,A) - // malstep(8,9,A) -// EVALuate "try*" (and "catch*"). // malstep(9,A) -// // malstep(9,A) -private func eval_try(list: MalSequence, _ env: Environment) throws -> TCOVal { // malstep(9,A) - // This is a subset of the Clojure try/catch: // malstep(9,A) - // // malstep(9,A) - // (try* expr (catch exception-name expr)) // malstep(9,A) - // malstep(9,A) - guard list.count >= 2 else { // malstep(9,A) - try throw_error("try*: no body parameter") // malstep(9,A) - } // malstep(9,A) - // malstep(9,A) - do { // malstep(9,A) - return TCOVal(try EVAL(try! list.nth(1), env)) // malstep(9,A) - } catch let error as MalException { // malstep(9,A) - guard list.count >= 3, // malstep(9,A) - let catch_list = as_sequenceQ(try! list.nth(2)) where catch_list.count >= 3, // malstep(9,A) - let _ = as_symbolQ(try! catch_list.nth(0)) else // malstep(9,A) - { // malstep(9,A) - throw error // No catch parameter // malstep(9,A) - } // malstep(9,A) - let catch_name = try! catch_list.nth(1) // malstep(9,A) - let catch_expr = try! catch_list.nth(2) // malstep(9,A) - let catch_env = Environment(outer: env) // malstep(9,A) - try catch_env.set_bindings(as_sequence(make_list_from(catch_name)), // malstep(9,A) - with_exprs: as_sequence(make_list_from(error.exception))) // malstep(9,A) - return TCOVal(try EVAL(catch_expr, catch_env)) // malstep(9,A) - } // malstep(9,A) -} // malstep(9,A) - // malstep(9,A) -// -// >>> NOTE: There are several versions of the EVAL function. One is used in -// >>> step 0, one is used in step 1, and a final one is used in step 2 and all -// >>> subsequent versions. This final version is extended throughout the -// >>> project through the addition of functionality. -// - -// Walk the AST and completely evaluate it, handling macro expansions, special // malstep(0,1,2,3,4,5,6,7,8,9,A) -// forms and function calls. // malstep(0,1,2,3,4,5,6,7,8,9,A) -// // malstep(0,1,2,3,4,5,6,7,8,9,A) -private func EVAL(ast: String) -> String { // malstep(0) - return ast // malstep(0) -} // malstep(0) -private func EVAL(ast: MalVal) -> MalVal { // malstep(1) - return ast // malstep(1) -} // malstep(1) -private func EVAL(ast: MalVal, _ env: Environment) throws -> MalVal { // malstep(2,3,4) -private func EVAL(var ast: MalVal, var _ env: Environment) throws -> MalVal { // malstep(5,6,7,8,9,A) - EVAL_level++ // malstep(5,6,7,8,9,A) - defer { EVAL_level-- } // malstep(5,6,7,8,9,A) - guard EVAL_level <= EVAL_leval_max else { // malstep(5,6,7,8,9,A) - try throw_error("Recursing too many levels (> \(EVAL_leval_max))") // malstep(5,6,7,8,9,A) - } // malstep(5,6,7,8,9,A) - // malstep(5,6,7,8,9,A) - if DEBUG_EVAL { // malstep(5,6,7,8,9,A) - indent = substring(INDENT_TEMPLATE, 0, EVAL_level) // malstep(5,6,7,8,9,A) - } // malstep(5,6,7,8,9,A) - // malstep(5,6,7,8,9,A) - while true { // malstep(5,6,7,8,9,A) - if DEBUG_EVAL { print("\(indent)> \(ast)") } // malstep(5,6,7,8,9,A) - // malstep(2,3,4,5,6,7,8,9,A) - if !is_list(ast) { // malstep(2,3,4,5,6,7,8,9,A) - // malstep(2,3,4,5,6,7,8,9,A) - // Not a list -- just evaluate and return. // malstep(2,3,4,5,6,7,8,9,A) - // malstep(2,3,4,5,6,7,8,9,A) - let answer = try eval_ast(ast, env) // malstep(2,3,4,5,6,7,8,9,A) - if DEBUG_EVAL { print("\(indent)>>> \(answer)") } // malstep(5,6,7,8,9,A) - return answer // malstep(2,3,4,5,6,7,8,9,A) - } // malstep(2,3,4,5,6,7,8,9,A) - // malstep(2,3,4,5,6,7,8,9,A) - // Special handling if it's a list. // malstep(2,3,4,5,6,7,8,9,A) - // malstep(2,3,4,5,6,7,8,9,A) - let list = as_list(ast) // malstep(2,3,4,5,6,7) - var list = as_list(ast) // malstep(8,9,A) - ast = try macroexpand(ast, env) // malstep(8,9,A) - if !is_list(ast) { // malstep(8,9,A) - // malstep(8,9,A) - // Not a list -- just evaluate and return. // malstep(8,9,A) - // malstep(8,9,A) - let answer = try eval_ast(ast, env) // malstep(8,9,A) - if DEBUG_EVAL { print("\(indent)>>> \(answer)") } // malstep(8,9,A) - return answer // malstep(8,9,A) - } // malstep(8,9,A) - list = as_list(ast) // malstep(8,9,A) - // malstep(8,9,A) - if DEBUG_EVAL { print("\(indent)>. \(list)") } // malstep(5,6,7,8,9,A) - // malstep(2,3,4,5,6,7,8,9,A) - if list.isEmpty { // malstep(2,3,4,5,6,7,8,9,A) - return ast // malstep(2,3,4,5,6,7,8,9,A) - } // malstep(2,3,4,5,6,7,8,9,A) - // malstep(2,3,4,5,6,7,8,9,A) - // Check for special forms, where we want to check the operation // malstep(3,4,5,6,7,8,9,A) - // before evaluating all of the parameters. // malstep(3,4,5,6,7,8,9,A) - // malstep(3,4,5,6,7,8,9,A) - let arg0 = list.first() // malstep(3,4,5,6,7,8,9,A) - if let fn_symbol = as_symbolQ(arg0) { // malstep(3,4,5,6,7,8,9,A) - let res: TCOVal // malstep(5,6,7,8,9,A) - // malstep(3,4,5,6,7,8,9,A) - switch fn_symbol { // malstep(3,4,5,6,7,8,9,A) - case kSymbolDef: return try eval_def(list, env) // malstep(3,4) - case kSymbolDef: res = try eval_def(list, env) // malstep(5,6,7,8,9,A) - case kSymbolDefMacro: res = try eval_def(list, env) // malstep(8,9,A) - case kSymbolLet: return try eval_let(list, env) // malstep(3,4) - case kSymbolLet: res = try eval_let(list, env) // malstep(5,6,7,8,9,A) - case kSymbolDo: return try eval_do(list, env) // malstep(4) - case kSymbolDo: res = try eval_do(list, env) // malstep(5,6,7,8,9,A) - case kSymbolIf: return try eval_if(list, env) // malstep(4) - case kSymbolIf: res = try eval_if(list, env) // malstep(5,6,7,8,9,A) - case kSymbolFn: return try eval_fn(list, env) // malstep(4) - case kSymbolFn: res = try eval_fn(list, env) // malstep(5,6,7,8,9,A) - case kSymbolQuote: res = try eval_quote(list, env) // malstep(7,8,9,A) - case kSymbolQuasiQuote: res = try eval_quasiquote(list, env) // malstep(7,8,9,A) - case kSymbolMacroExpand: res = try eval_macroexpand(list, env) // malstep(8,9,A) - case kSymbolTry: res = try eval_try(list, env) // malstep(9,A) - default: break // malstep(3,4) - default: res = TCOVal() // malstep(5,6,7,8,9,A) - } // malstep(3,4,5,6,7,8,9,A) - switch res { // malstep(5,6,7,8,9,A) - case let .Return(result): return result // malstep(5,6,7,8,9,A) - case let .Continue(new_ast, new_env): ast = new_ast; env = new_env; continue // malstep(5,6,7,8,9,A) - case .NoResult: break // malstep(5,6,7,8,9,A) - } // malstep(5,6,7,8,9,A) - } // malstep(3,4,5,6,7,8,9,A) - // malstep(3,4,5,6,7,8,9,A) - // Standard list to be applied. Evaluate all the elements first. // malstep(2,3,4,5,6,7,8,9,A) - // malstep(2,3,4,5,6,7,8,9,A) - let eval = try eval_ast(ast, env) // malstep(2,3,4,5,6,7,8,9,A) - // malstep(2,3,4,5,6,7,8,9,A) - // The result had better be a list and better be non-empty. // malstep(2,3,4,5,6,7,8,9,A) - // malstep(2,3,4,5,6,7,8,9,A) - let eval_list = as_list(eval) // malstep(2,3,4,5,6,7,8,9,A) - if eval_list.isEmpty { // malstep(2,3,4,5,6,7,8,9,A) - return eval // malstep(2,3,4,5,6,7,8,9,A) - } // malstep(2,3,4,5,6,7,8,9,A) - // malstep(2,3,4,5,6,7,8,9,A) - if DEBUG_EVAL { print("\(indent)>> \(eval)") } // malstep(5,6,7,8,9,A) - // malstep(5,6,7,8,9,A) - // Get the first element of the list and execute it. // malstep(2,3,4,5,6,7,8,9,A) - // malstep(2,3,4,5,6,7,8,9,A) - let first = eval_list.first() // malstep(2,3,4,5,6,7,8,9,A) - let rest = as_sequence(eval_list.rest()) // malstep(2,3,4,5,6,7,8,9,A) - // malstep(2,3,4,5,6,7,8,9,A) - if let fn = as_builtinQ(first) { // malstep(2,3,4,5,6,7,8,9,A) - let answer = try fn.apply(rest) // malstep(2,3,4,5,6,7,8,9,A) - if DEBUG_EVAL { print("\(indent)>>> \(answer)") } // malstep(5,6,7,8,9,A) - return answer // malstep(2,3,4,5,6,7,8,9,A) - } else if let fn = as_closureQ(first) { // malstep(4,5,6,7,8,9,A) - let new_env = Environment(outer: fn.env) // malstep(4,5,6,7,8,9,A) - let _ = try new_env.set_bindings(fn.args, with_exprs: rest) // malstep(4,5,6,7,8,9,A) - if TCO { // malstep(5,6,7,8,9,A) - env = new_env // malstep(5,6,7,8,9,A) - ast = fn.body // malstep(5,6,7,8,9,A) - continue // malstep(5,6,7,8,9,A) - } // malstep(5,6,7,8,9,A) - let answer = try EVAL(fn.body, new_env) // malstep(4,5,6,7,8,9,A) - if DEBUG_EVAL { print("\(indent)>>> \(answer)") } // malstep(5,6,7,8,9,A) - return answer // malstep(4,5,6,7,8,9,A) - } // malstep(2,3,4,5,6,7,8,9,A) - // malstep(2,3,4,5,6,7,8,9,A) - // The first element wasn't a function to be executed. Return an // malstep(2,3,4,5,6,7,8,9,A) - // error saying so. // malstep(2,3,4,5,6,7,8,9,A) - // malstep(2,3,4,5,6,7,8,9,A) - try throw_error("first list item does not evaluate to a function: \(first)") // malstep(2,3,4,5,6,7,8,9,A) - } // malstep(5,6,7,8,9,A) -} // malstep(2,3,4,5,6,7,8,9,A) - // malstep(0,1,2,3,4,5,6,7,8,9,A) -// Convert the value into a human-readable string for printing. // malstep(0,1,2,3,4,5,6,7,8,9,A) -// // malstep(0,1,2,3,4,5,6,7,8,9,A) -private func PRINT(exp: String) -> String { // malstep(0) - return exp // malstep(0) -} // malstep(0) -private func PRINT(exp: MalVal) -> String { // malstep(1,2,3,4,5,6,7,8,9,A) - return pr_str(exp, true) // malstep(1,2,3,4,5,6,7,8,9,A) -} // malstep(1,2,3,4,5,6,7,8,9,A) - // malstep(0,1,2,3,4,5,6,7,8,9,A) -// -// >>> NOTE: The following function has several versions. Also note that the -// >>> call to EVAL comes in two flavors. -// - -// Perform the READ and EVAL steps. Useful for when you don't care about the // malstep(0,1,2,3,4,5,6,7,8,9,A) -// printable result. // malstep(0,1,2,3,4,5,6,7,8,9,A) -// // malstep(0,1,2,3,4,5,6,7,8,9,A) -private func RE(text: String) -> String { // malstep(0) - let ast = READ(text) // malstep(0) - let exp = EVAL(ast) // malstep(0) - return exp // malstep(0) -} // malstep(0) -private func RE(text: String) -> MalVal? { // malstep(1) -private func RE(text: String, _ env: Environment) -> MalVal? { // malstep(2,3,4,5,6,7,8,9,A) - if !text.isEmpty { // malstep(1,2,3,4,5,6,7,8,9,A) - do { // malstep(1,2,3,4,5,6,7,8,9,A) - let ast = try READ(text) // malstep(1,2,3,4,5,6,7,8,9,A) - do { // malstep(2,3,4,5,6,7,8,9,A) - return EVAL(ast) // malstep(1) - return try EVAL(ast, env) // malstep(2,3,4,5,6,7,8,9,A) - } catch let error as MalException { // malstep(2,3,4,5,6,7,8,9,A) - print("Error evaluating input: \(error)") // malstep(2,3,4,5,6,7,8,9,A) - } catch { // malstep(2,3,4,5,6,7,8,9,A) - print("Error evaluating input: \(error)") // malstep(2,3,4,5,6,7,8,9,A) - } // malstep(2,3,4,5,6,7,8,9,A) - } catch let error as MalException { // malstep(1,2,3,4,5,6,7,8,9,A) - print("Error parsing input: \(error)") // malstep(1,2,3,4,5,6,7,8,9,A) - } catch { // malstep(1,2,3,4,5,6,7,8,9,A) - print("Error parsing input: \(error)") // malstep(1,2,3,4,5,6,7,8,9,A) - } // malstep(1,2,3,4,5,6,7,8,9,A) - } // malstep(1,2,3,4,5,6,7,8,9,A) - return nil // malstep(1,2,3,4,5,6,7,8,9,A) -} // malstep(1,2,3,4,5,6,7,8,9,A) - // malstep(0,1,2,3,4,5,6,7,8,9,A) -// -// >>> NOTE: The following function has several versions. -// - -// Perform the full READ/EVAL/PRINT, returning a printable string. // malstep(0,1,2,3,4,5,6,7,8,9,A) -// // malstep(0,1,2,3,4,5,6,7,8,9,A) -private func REP(text: String) -> String { // malstep(0) - let exp = RE(text) // malstep(0) - return PRINT(exp) // malstep(0) -} // malstep(0) -private func REP(text: String) -> String? { // malstep(1) - let exp = RE(text) // malstep(1) - if exp == nil { return nil } // malstep(1) - return PRINT(exp!) // malstep(1) -} // malstep(1) -private func REP(text: String, _ env: Environment) -> String? { // malstep(2,3,4,5,6,7,8,9,A) - let exp = RE(text, env) // malstep(2,3,4,5,6,7,8,9,A) - if exp == nil { return nil } // malstep(2,3,4,5,6,7,8,9,A) - return PRINT(exp!) // malstep(2,3,4,5,6,7,8,9,A) -} // malstep(2,3,4,5,6,7,8,9,A) - // malstep(0,1,2,3,4,5,6,7,8,9,A) -// -// >>> NOTE: The following function has several versions. -// - -// Perform the full REPL. // malstep(0,1,2,3,4,5,6,7,8,9,A) -// // malstep(0,1,2,3,4,5,6,7,8,9,A) -private func REPL() { // malstep(0) - while true { // malstep(0) - if let text = _readline("user> ") { // malstep(0) - print("\(REP(text))") // malstep(0) - } else { // malstep(0) - print("") // malstep(0) - break // malstep(0) - } // malstep(0) - } // malstep(0) -} // malstep(0) -private func REPL() { // malstep(1) - while true { // malstep(1) - if let text = _readline("user> ") { // malstep(1) - if let output = REP(text) { // malstep(1) - print("\(output)") // malstep(1) - } // malstep(1) - } else { // malstep(1) - print("") // malstep(1) - break // malstep(1) - } // malstep(1) - } // malstep(1) -} // malstep(1) -private func REPL(env: Environment) { // malstep(2,3,4,5,6,7,8,9,A) - while true { // malstep(2,3,4,5,6,7,8,9,A) - if let text = _readline("user> ") { // malstep(2,3,4,5,6,7,8,9,A) - if let output = REP(text, env) { // malstep(2,3,4,5,6,7,8,9,A) - print("\(output)") // malstep(2,3,4,5,6,7,8,9,A) - } // malstep(2,3,4,5,6,7,8,9,A) - } else { // malstep(2,3,4,5,6,7,8,9,A) - print("") // malstep(2,3,4,5,6,7,8,9,A) - break // malstep(2,3,4,5,6,7,8,9,A) - } // malstep(2,3,4,5,6,7,8,9,A) - } // malstep(2,3,4,5,6,7,8,9,A) -} // malstep(2,3,4,5,6,7,8,9,A) - // malstep(0,1,2,3,4,5,6,7,8,9,A) -// Process any command line arguments. Any trailing arguments are incorporated // malstep(6,7,8,9,A) -// into the environment. Any argument immediately after the process name is // malstep(6,7,8,9,A) -// taken as a script to execute. If one exists, it is executed in lieu of // malstep(6,7,8,9,A) -// running the REPL. // malstep(6,7,8,9,A) -// // malstep(6,7,8,9,A) -private func process_command_line(args: [String], _ env: Environment) -> Bool { // malstep(6,7,8,9,A) - var argv = make_list() // malstep(6,7,8,9,A) - if args.count > 2 { // malstep(6,7,8,9,A) - let args1 = args[2.. 1 { // malstep(6,7,8,9,A) - RE("(load-file \"\(args[1])\")", env) // malstep(6,7,8,9,A) - return false // malstep(6,7,8,9,A) - } // malstep(6,7,8,9,A) - // malstep(6,7,8,9,A) - return true // malstep(6,7,8,9,A) -} // malstep(6,7,8,9,A) - // malstep(6,7,8,9,A) -func main() { // malstep(0,1,2,3,4,5,6,7,8,9,A) - let env = Environment(outer: nil) // malstep(2,3,4,5,6,7,8,9,A) - // malstep(2,3,4,5,6,7,8,9,A) - load_history_file() // malstep(0,1,2,3,4,5,6,7,8,9,A) - load_builtins(env) // malstep(2,3,4,5,6,7,8,9,A) - // malstep(2,3,4,5,6,7,8,9,A) - RE("(def! *host-language* \"swift\")", env) // malstep(A) - RE("(def! not (fn* (a) (if a false true)))", env) // malstep(4,5,6,7,8,9,A) - RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))", env) // malstep(6,7,8,9,A) - RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) " + // malstep(8,9,A) - "(throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", env) // malstep(8,9,A) - RE("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) " + // malstep(8,9) - "`(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))", env) // malstep(8,9) - RE("(def! *gensym-counter* (atom 0))", env) // malstep(A) - RE("(def! gensym (fn* [] (symbol (str \"G__\" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))", env) // malstep(A) - RE("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) " + // malstep(A) - "(let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))", env) // malstep(A) - // malstep(6,7,8,9,A) - env.set(kSymbolEval, make_builtin({ // malstep(6,7,8,9,A) - try! unwrap_args($0) { // malstep(6,7,8,9,A) - (ast: MalVal) -> MalVal in // malstep(6,7,8,9,A) - try EVAL(ast, env) // malstep(6,7,8,9,A) - } // malstep(6,7,8,9,A) - })) // malstep(6,7,8,9,A) - // malstep(6,7,8,9,A) -// -// >>> NOTE: The call to REPL() is managed in three different ways. First, we -// >>> just call it with no parameters. Second, we call it with an "env" -// >>> parameter. Finally, we call it only if there is no program on the -// >>> command line to execute. -// - REPL() // malstep(0,1) - REPL(env) // malstep(2,3,4,5) - if process_command_line(Process.arguments, env) { // malstep(6,7,8,9,A) - RE("(println (str \"Mal [\" *host-language*\"]\"))", env) // malstep(A) - REPL(env) // malstep(6,7,8,9,A) - } // malstep(6,7,8,9,A) - // malstep(2,3,4,5,6,7,8,9,A) - save_history_file() // malstep(0,1,2,3,4,5,6,7,8,9,A) -} // malstep(0,1,2,3,4,5,6,7,8,9,A) diff --git a/swift/types_class.swift b/swift/types_class.swift deleted file mode 100644 index 569bfa51de..0000000000 --- a/swift/types_class.swift +++ /dev/null @@ -1,1101 +0,0 @@ -//****************************************************************************** -// MAL - types, implemented as a Swift "class". -//****************************************************************************** - -import Foundation - -// ==================== Types / Constants / Variables ==================== - -typealias MalProtocol = protocol - -typealias MalIntType = Int64 -typealias MalFloatType = Double -typealias MalSymbolType = String -typealias MalKeywordType = String -typealias MalStringType = String -typealias MalVectorType = ArraySlice -typealias MalHashType = Dictionary - -private let kUnknown = MalUnknown() -private let kNil = MalNil() -private let kTrue = MalTrue() -private let kFalse = MalFalse() -private let kComment = MalComment() - -// ==================== MalVal ==================== - -class MalVal : MalProtocol { - init() { - self._meta = nil - } - init(_ other: MalVal, _ meta: MalVal?) { - self._meta = meta - } - init(_ meta: MalVal?) { - self._meta = meta - } - - // CustomStringConvertible - // - var description: String { die() } - - // Hashable - // - var hashValue: Int { return description.hashValue } - - // MalVal - // - func clone_with_meta(meta: MalVal) -> MalVal { die() } - final var meta: MalVal? { return self._meta } - - let _meta: MalVal? -} - -// Equatable -// -let tMalUnknown = class_getName(MalUnknown) -let tMalNil = class_getName(MalNil) -let tMalTrue = class_getName(MalTrue) -let tMalFalse = class_getName(MalFalse) -let tMalComment = class_getName(MalComment) -let tMalInteger = class_getName(MalInteger) -let tMalFloat = class_getName(MalFloat) -let tMalSymbol = class_getName(MalSymbol) -let tMalKeyword = class_getName(MalKeyword) -let tMalString = class_getName(MalString) -let tMalList = class_getName(MalList) -let tMalVector = class_getName(MalVector) -let tMalHashMap = class_getName(MalHashMap) -let tMalAtom = class_getName(MalAtom) -let tMalClosure = class_getName(MalClosure) -let tMalBuiltin = class_getName(MalBuiltin) -let tMalMacro = class_getName(MalMacro) - -func ==(left: MalVal, right: MalVal) -> Bool { - let leftClass = object_getClassName(left) - let rightClass = object_getClassName(right) - - if leftClass == tMalUnknown && rightClass == tMalUnknown { return as_unknown(left) == as_unknown(right) } - if leftClass == tMalNil && rightClass == tMalNil { return as_nil(left) == as_nil(right) } - if leftClass == tMalTrue && rightClass == tMalTrue { return as_true(left) == as_true(right) } - if leftClass == tMalFalse && rightClass == tMalFalse { return as_false(left) == as_false(right) } - if leftClass == tMalComment && rightClass == tMalComment { return as_comment(left) == as_comment(right) } - if leftClass == tMalInteger && rightClass == tMalInteger { return as_integer(left) == as_integer(right) } - if leftClass == tMalFloat && rightClass == tMalFloat { return as_float(left) == as_float(right) } - if leftClass == tMalSymbol && rightClass == tMalSymbol { return as_symbol(left) == as_symbol(right) } - if leftClass == tMalKeyword && rightClass == tMalKeyword { return as_keyword(left) == as_keyword(right) } - if leftClass == tMalString && rightClass == tMalString { return as_string(left) == as_string(right) } - //if leftClass == tMalList && rightClass == tMalList { return as_sequence(left) == as_sequence(right) } - //if leftClass == tMalVector && rightClass == tMalVector { return as_sequence(left) == as_sequence(right) } - if leftClass == tMalHashMap && rightClass == tMalHashMap { return as_hashmap(left) == as_hashmap(right) } - if leftClass == tMalAtom && rightClass == tMalAtom { return as_atom(left) == as_atom(right) } - if leftClass == tMalClosure && rightClass == tMalClosure { return as_closure(left) == as_closure(right) } - if leftClass == tMalBuiltin && rightClass == tMalBuiltin { return as_builtin(left) == as_builtin(right) } - if leftClass == tMalMacro && rightClass == tMalMacro { return as_macro(left) == as_macro(right) } - // - // Special case lists/vectors, since they are different types that are - // nonetheless comparable. - if - (leftClass == tMalList || leftClass == tMalVector) && - (rightClass == tMalList || rightClass == tMalVector) { - return as_sequence(left) == as_sequence(right) - } - - return false -} - -func !=(left: MalVal, right: MalVal) -> Bool { - return !(left == right) -} - -// ==================== MalUnknown ==================== - -final class MalUnknown: MalVal { - override var description: String { return "unknown" } - override func clone_with_meta(meta: MalVal) -> MalVal { return MalUnknown(meta) } -} -func ==(left: MalUnknown, right: MalUnknown) -> Bool { return false } - -// ==================== MalNil ==================== - -final class MalNil: MalVal { - override var description: String { return "nil" } - override func clone_with_meta(meta: MalVal) -> MalVal { return MalNil(meta) } -} -func ==(left: MalNil, right: MalNil) -> Bool { return true } - -// ==================== MalTrue ==================== - -final class MalTrue: MalVal { - override var description: String { return "true" } - override func clone_with_meta(meta: MalVal) -> MalVal { return MalTrue(meta) } -} -func ==(left: MalTrue, right: MalTrue) -> Bool { return true } - -// ==================== MalFalse ==================== - -final class MalFalse: MalVal { - override var description: String { return "false" } - override func clone_with_meta(meta: MalVal) -> MalVal { return MalFalse(meta) } -} -func ==(left: MalFalse, right: MalFalse) -> Bool { return true } - -// ==================== MalComment ==================== - -final class MalComment: MalVal { - override var description: String { return "Comment" } - override func clone_with_meta(meta: MalVal) -> MalVal { return MalComment(meta) } -} - -// Equatable -// -func ==(left: MalComment, right: MalComment) -> Bool { return false } - -// ==================== MalInteger ==================== - -final class MalInteger: MalVal { - override init() { - self._integer = 0 - super.init() - } - init(_ other: MalInteger, _ meta: MalVal? = nil) { - self._integer = other._integer - super.init(other, meta) - } - init(_ integer: MalIntType) { - self._integer = integer - super.init() - } - - // CustomStringConvertible - // - override var description: String { return "\(self._integer)" } - - // Hashable - // - override var hashValue: Int { return Int(self._integer) } - - // MalInteger - // - override func clone_with_meta(meta: MalVal) -> MalVal { return MalInteger(self, meta) } - var integer: MalIntType { return self._integer } - - private let _integer: MalIntType -} - -// Equatable -// -func ==(left: MalInteger, right: MalInteger) -> Bool { return left.integer == right.integer } - -// ==================== MalFloat ==================== - -final class MalFloat: MalVal { - override init() { - self._float = 0 - super.init() - } - init(_ other: MalFloat, _ meta: MalVal? = nil) { - self._float = other._float - super.init(other, meta) - } - init(_ float: Double) { - self._float = float - super.init() - } - - // CustomStringConvertible - // - override var description: String { return "\(self._float)" } - - // Hashable - // - override var hashValue: Int { return Int(self._float) } - - // MalFloat - // - override func clone_with_meta(meta: MalVal) -> MalVal { return MalFloat(self, meta) } - var float: MalFloatType { return self._float } - - private let _float: Double -} - -// Equatable -// -func ==(left: MalFloat, right: MalFloat) -> Bool { return left.float == right.float } - -// ==================== MalSymbol ==================== - -private var symbolHash = [MalSymbolType : Int]() -private var symbolArray = [MalSymbolType]() - -private func indexForSymbol(s: MalSymbolType) -> Int { - if let i = symbolHash[s] { - return i - } - - symbolArray.append(s) - symbolHash[s] = symbolArray.count - 1 - return symbolArray.count - 1 -} - -private func symbolForIndex(i: Int) -> MalSymbolType { - return symbolArray[i] -} - -final class MalSymbol: MalVal { - override init() { - self._index = indexForSymbol("") - super.init() - } - init(_ other: MalSymbol, _ meta: MalVal? = nil) { - self._index = other._index - super.init(other, meta) - } - init(_ symbol: MalSymbolType) { - self._index = indexForSymbol(symbol) - super.init() - } - - // CustomStringConvertible - // - override var description: String { return symbolForIndex(self._index) } - - // Hashable - // - override var hashValue: Int { return self._index } - - // MalSymbol - override func clone_with_meta(meta: MalVal) -> MalVal { return MalSymbol(self, meta) } - var index: Int { return self._index } - - private let _index: Int -} - -// Equatable -// -func ==(left: MalSymbol, right: MalSymbol) -> Bool { return left.index == right.index } - -// ==================== MalKeyword ==================== - -final class MalKeyword: MalVal { - override init() { - self._keyword = "" - super.init() - } - init(_ other: MalKeyword, _ meta: MalVal? = nil) { - self._keyword = other._keyword - super.init(other, meta) - } - init(_ keyword: MalKeywordType) { - self._keyword = keyword - super.init() - } - init(_ string: MalString) { - self._keyword = string.string - super.init() - } - - // CustomStringConvertible - // - override var description: String { return self._keyword } // ":" added in pr_str - - // MalKeyword - // - override func clone_with_meta(meta: MalVal) -> MalVal { return MalKeyword(self, meta) } - var keyword: MalKeywordType { return self._keyword } - - private let _keyword: MalKeywordType -} - -// Equatable -// -func ==(left: MalKeyword, right: MalKeyword) -> Bool { return left._keyword == right._keyword } - -// ==================== MalString ==================== - -final class MalString: MalVal { - override init() { - self._string = "" - super.init() - } - init(_ other: MalString, _ meta: MalVal? = nil) { - self._string = other._string - super.init(other, meta) - } - init(_ string: MalStringType) { - self._string = string - super.init() - } - - // CustomStringConvertible - // - override var description: String { return self._string } - - // MalString - // - override func clone_with_meta(meta: MalVal) -> MalVal { return MalString(self, meta) } - var string: MalStringType { return self._string } - - private let _string: MalStringType -} - -// Equatable -// -func ==(left: MalString, right: MalString) -> Bool { return left.string == right.string } - -// ==================== MalSequence ==================== - -class MalSequence: MalVal, SequenceType { - override init() { - self.count = 0 - self.isEmpty = true - super.init() - } - init(_ other: MalSequence, _ meta: MalVal? = nil) { - self.count = other.count - self.isEmpty = other.isEmpty - super.init(other, meta) - } - init(_ count: MalIntType, _ isEmpty: Bool) { - self.count = count - self.isEmpty = isEmpty - super.init() - } - - // SequenceType - // - func generate() -> MalVectorType.Generator { die() } - - // MalSequence - // - var count: MalIntType - var isEmpty: Bool - - func first() -> MalVal { die() } - func last() -> MalVal { die() } - func rest() -> MalVal { die() } - func nth(n: MalIntType) throws -> MalVal { die() } - func range_from(from: MalIntType, to: MalIntType) -> MalVal { die() } - func cons(element: MalVal) -> MalVal { die() } - func concat(seq: MalSequence) throws -> MalVal { die() } - func conj(seq: MalSequence) throws -> MalVal { die() } - func map(@noescape transform: (MalVal) -> U) -> ArraySlice { die() } - func reduce(initial: U, @noescape combine: (U, MalVal) -> U) -> U { die() } -} - -// Equatable -// -func ==(left: MalSequence, right: MalSequence) -> Bool { - if left.count != right.count { return false } - var left_gen = left.generate() - var right_gen = right.generate() - while true { - if let left = left_gen.next(), right = right_gen.next() { - if left != right { - return false - } - } else { - break - } - } - return true -} - -// ==================== MalList ==================== - -final class MalList: MalSequence { - override init() { - self._slice = MalVectorType() - super.init(MalIntType(self._slice.count), self._slice.isEmpty) - } - init(_ other: MalList, _ meta: MalVal? = nil) { - self._slice = other._slice - super.init(other, meta) - } - init(seq: MalSequence) { // We need the "seq" in order to differentiate it from the previous init() - self._slice = seq.reduce(MalVectorType()){ var s = $0; s.append($1); return s } - super.init(MalIntType(self._slice.count), self._slice.isEmpty) - } - init(_ slice: MalVectorType) { - self._slice = slice - super.init(MalIntType(self._slice.count), self._slice.isEmpty) - } - init(_ array: Array) { - self._slice = array[0..(_ collection: T) { - self._slice = collection.reduce(MalVectorType()){ var s = $0; s.append($1); return s } - super.init(MalIntType(self._slice.count), self._slice.isEmpty) - } - - // CustomStringConvertible - // - override var description: String { return "(" + self.map { pr_str($0) }.joinWithSeparator(" ") + ")" } - - // SequenceType - // - override func generate() -> MalVectorType.Generator { return self._slice.generate() } - - // MalSequence - // - override func first() -> MalVal { return isEmpty ? make_nil() : try! nth(0) } - override func last() -> MalVal { return try! nth(count - 1) } - override func rest() -> MalVal { return range_from(MalIntType(1), to: MalIntType(count)) } - override func nth(n: MalIntType) throws -> MalVal { guard n < count else { try throw_error("index (\(n)) out of range (\(count))") }; return self._slice[self._slice.startIndex.advancedBy(Int(n))] } - override func range_from(from: MalIntType, to: MalIntType) -> MalVal { - return from <= to && to <= count - ? make_list(self._slice[self._slice.startIndex.advancedBy(Int(from)).. MalVal { - var result = self._slice - result.insert(element, atIndex: result.startIndex) - return make_list(result) - } - override func concat(seq: MalSequence) throws -> MalVal { - var result = self._slice - if let list = as_listQ(seq) { - result.appendContentsOf(list._slice) - } else if let vector = as_vectorQ(seq) { - result.appendContentsOf(vector._slice) - } else { - try throw_error("Expected sequence, got \(seq)") - } - return make_list(result) - } - override func conj(seq: MalSequence) throws -> MalVal { - var result: Array - if let list = as_listQ(seq) { - result = list._slice.reverse() - } else if let vector = as_vectorQ(seq) { - result = vector._slice.reverse() - } else { - try throw_error("Expected sequence, got \(seq)") - } - result.appendContentsOf(self._slice) - return make_list(result) - } - override func map(@noescape transform: (MalVal) -> U) -> ArraySlice { return ArraySlice(self._slice.map(transform)) } - override func reduce(initial: U, @noescape combine: (U, MalVal) -> U) -> U { return self._slice.reduce(initial, combine: combine) } - - // MalList - // - override func clone_with_meta(meta: MalVal) -> MalVal { return MalList(self, meta) } - - private let _slice: MalVectorType -} - -// Equatable -// -func ==(left: MalList, right: MalList) -> Bool { - return as_sequence(left) == as_sequence(right) -} - -// ==================== MalVector ==================== - -final class MalVector: MalSequence { - override init() { - self._slice = MalVectorType() - super.init(MalIntType(self._slice.count), self._slice.isEmpty) - } - init(_ other: MalVector, _ meta: MalVal? = nil) { - self._slice = other._slice - super.init(other, meta) - } - init(seq: MalSequence) { // We need the "seq" in order to differentiate it from the previous init() - self._slice = seq.reduce(MalVectorType()){ var s = $0; s.append($1); return s } - super.init(MalIntType(self._slice.count), self._slice.isEmpty) - } - init(_ slice: MalVectorType) { - self._slice = slice - super.init(MalIntType(self._slice.count), self._slice.isEmpty) - } - init(_ array: Array) { - self._slice = array[0..(_ collection: T) { - self._slice = collection.reduce(MalVectorType()){ var s = $0; s.append($1); return s } - super.init(MalIntType(self._slice.count), self._slice.isEmpty) - } - - // CustomStringConvertible - // - override var description: String { return "[" + self.map { pr_str($0) }.joinWithSeparator(" ") + "]" } - - // SequenceType - // - override func generate() -> MalVectorType.Generator { return self._slice.generate() } - - // MalSequence - // - override func first() -> MalVal { return isEmpty ? make_nil() : try! nth(0) } - override func last() -> MalVal { return try! nth(count - 1) } - override func rest() -> MalVal { return range_from(MalIntType(1), to: MalIntType(count)) } - override func nth(n: MalIntType) throws -> MalVal { guard n < count else { try throw_error("index (\(n)) out of range (\(count))") }; return self._slice[self._slice.startIndex.advancedBy(Int(n))] } - override func range_from(from: MalIntType, to: MalIntType) -> MalVal { - return from <= to && to <= count - ? make_list(self._slice[self._slice.startIndex.advancedBy(Int(from)).. MalVal { - var result = self._slice - result.insert(element, atIndex: result.startIndex) - return make_list(result) // Yes, make_list - } - override func concat(seq: MalSequence) throws -> MalVal { - var result = self._slice - if let list = as_listQ(seq) { - result.appendContentsOf(list._slice) - } else if let vector = as_vectorQ(seq) { - result.appendContentsOf(vector._slice) - } else { - try throw_error("Expected sequence, got \(seq)") - } - return make_list(result) - } - override func conj(seq: MalSequence) throws -> MalVal { - var result = self._slice - if let list = as_listQ(seq) { - result.appendContentsOf(list._slice) - } else if let vector = as_vectorQ(seq) { - result.appendContentsOf(vector._slice) - } else { - try throw_error("Expected sequence, got \(seq)") - } - return make_vector(result) - } - override func map(@noescape transform: (MalVal) -> U) -> ArraySlice { return ArraySlice(self._slice.map(transform)) } - override func reduce(initial: U, @noescape combine: (U, MalVal) -> U) -> U { return self._slice.reduce(initial, combine: combine) } - - // MalVector - // - override func clone_with_meta(meta: MalVal) -> MalVal { return MalVector(self, meta) } - - private let _slice: MalVectorType -} - -// Equatable -// -func ==(left: MalVector, right: MalVector) -> Bool { - return as_sequence(left) == as_sequence(right) -} - -// ==================== MalHashMap ==================== - -final class MalHashMap: MalVal, SequenceType { - override init() { - self._hash = MalHashType() - self.count = MalIntType(self._hash.count) - self.isEmpty = self._hash.isEmpty - super.init() - } - init(_ other: MalHashMap, _ meta: MalVal? = nil) { - self._hash = other._hash - self.count = MalIntType(self._hash.count) - self.isEmpty = self._hash.isEmpty - super.init(other, meta) - } - init(_ hash: MalHashType) { - self._hash = hash - self.count = MalIntType(self._hash.count) - self.isEmpty = self._hash.isEmpty - super.init() - } - convenience init(_ seq: MalSequence) { - var hash = MalHashType() - for var index: MalIntType = 0; index < seq.count; index += 2 { - hash[try! seq.nth(index)] = try! seq.nth(index + 1) - } - self.init(hash) - } - convenience init(_ collection: T) { - // TBD: Use SequenceType/generate - var hash = MalHashType() - for var index = collection.startIndex; index != collection.endIndex; { - let key = collection[index++] - let value = collection[index++] - hash[key] = value - } - self.init(hash) - } - - // CustomStringConvertible - // - override var description: String { - // TBD: Use reduce - var a = [String]() - for (k, v) in self._hash { - a.append("\(pr_str(k)) \(pr_str(v))") - } - let s = a.joinWithSeparator(" ") - return "{\(s)}" - } - - // SequenceType - // - func generate() -> MalHashType.Generator { return self._hash.generate() } - - // MalHashMap - // - let count: MalIntType - let isEmpty: Bool - var hash: MalHashType { return self._hash } - var keys: MalVal { return make_list(self._hash.keys) } - var values: MalVal { return make_list(self._hash.values) } - - override func clone_with_meta(meta: MalVal) -> MalVal { return MalHashMap(self, meta) } - - func value_for(key: MalVal) -> MalVal? { - return self._hash[key] - } - - private let _hash: MalHashType -} - -// Equatable -// -func ==(left: MalHashMap, right: MalHashMap) -> Bool { - if left.count != right.count { return false } - var left_gen = left.generate() - var right_gen = right.generate() - while true { - if let left = left_gen.next(), let right = right_gen.next() { - if left.0 != right.0 || left.1 != right.1 { - return false - } - } else { - break - } - } - return true -} - -// ==================== MalAtom ==================== - -final class MalAtom: MalVal { - override init() { - self._object = make_nil() - super.init() - } - init(_ other: MalAtom, _ meta: MalVal? = nil) { - self._object = other._object - super.init(other, meta) - } - init(object: MalVal) { - self._object = object - super.init() - } - - // CustomStringConvertible - // - override var description: String { return "(atom \(self._object.description))" } - - // MalAtom - // - override func clone_with_meta(meta: MalVal) -> MalVal { return MalAtom(self, meta) } - var object: MalVal { return self._object } - - func set_object(obj: MalVal) -> MalVal { - self._object = obj - return obj - } - - private var _object: MalVal -} - -// Equatable -// -func ==(left: MalAtom, right: MalAtom) -> Bool { return left.object == right.object } - -// ==================== MalFunction ==================== - -class MalFunction: MalVal { - override init() { - super.init() - } - init(_ other: MalFunction, _ meta: MalVal? = nil) { - super.init(other, meta) - } - - // MalFunction - // - func apply(exprs: MalSequence) throws -> MalVal { die() } -} - -// ==================== MalClosure ==================== - -final class MalClosure: MalFunction { - typealias Evaluator = (MalVal, Environment) throws -> MalVal - typealias Parameters = (eval: Evaluator, args: MalSequence, body: MalVal, env: Environment) - - override init() { - self._eval = nil - self._args = as_sequence(make_list()) - self._body = make_nil() - self._env = Environment(outer: nil) - super.init() - } - init(_ other: MalClosure, _ meta: MalVal? = nil) { - self._eval = other._eval - self._args = other._args - self._body = other._body - self._env = other._env - super.init(other, meta) - } - init(_ p: Parameters) { - self._eval = p.eval - self._args = p.args - self._body = p.body - self._env = p.env - super.init() - } - - // CustomStringConvertible - // - override var description: String { return "#: (fn* \(self._args.description) \(self._body.description))" } - - // MalFunction - // - override func apply(exprs: MalSequence) throws -> MalVal { - let new_env = Environment(outer: self._env) - let _ = try new_env.set_bindings(self._args, with_exprs: exprs) - // Calling EVAL indirectly via an 'eval' data member is a bit of a hack. - // We can't call EVAL directly because this file (types.swift) needs to - // be used with many different versions of the main MAL file - // (step[0-10]*.swift), and EVAL is declared differently across those - // versions. By using this indirection, we avoid that problem. - return try self._eval(self._body, new_env) - } - - // MalClosure - // - override func clone_with_meta(meta: MalVal) -> MalVal { return MalClosure(self, meta) } - - var args: MalSequence { return self._args } - var body: MalVal { return self._body } - var env: Environment { return self._env } - - private let _eval: Evaluator! - private let _args: MalSequence - private let _body: MalVal - private let _env: Environment -} - -// Equatable -// -func ==(left: MalClosure, right: MalClosure) -> Bool { return false } - -// ==================== MalBuiltin ==================== - -final class MalBuiltin: MalFunction { - typealias Signature = (MalSequence) throws -> MalVal - - override init() { - self._fn = nil - super.init() - } - init(_ other: MalBuiltin, _ meta: MalVal? = nil) { - self._fn = other._fn - super.init(other, meta) - } - init(_ fn: Signature) { - self._fn = fn - super.init() - } - - // CustomStringConvertible - // - override var description: String { return "#" } - - // MalFunction - // - override func apply(exprs: MalSequence) throws -> MalVal { return try self._fn(exprs) } - - // MalBuiltin - // - override func clone_with_meta(meta: MalVal) -> MalVal { return MalBuiltin(self, meta) } - - private let _fn: Signature! -} - -// Equatable -// -func ==(left: MalBuiltin, right: MalBuiltin) -> Bool { return false } // Can't compare function references in Swift - -// ==================== MalMacro ==================== - -final class MalMacro : MalVal { - override init() { - self._closure = as_closure(make_closure()) - super.init() - } - init(_ other: MalMacro, _ meta: MalVal? = nil) { - self._closure = other._closure - super.init(other, meta) - } - init(_ closure: MalClosure) { - self._closure = closure - super.init() - } - - // CustomStringConvertible - // - override var description: String { return self._closure.description } - - // MalMacro - // - override func clone_with_meta(meta: MalVal) -> MalVal { return MalMacro(self, meta) } - - var args: MalSequence { return self._closure.args } - var body: MalVal { return self._closure.body } - var env: Environment { return self._closure.env } - - private let _closure: MalClosure -} - -// Equatable -// -func ==(left: MalMacro, right: MalMacro) -> Bool { return false } - - -// ==================== Constructors ==================== - -// ----- Default ----- - -func make_unknown () -> MalVal { return kUnknown } -func make_nil () -> MalVal { return kNil } -func make_true () -> MalVal { return kTrue } -func make_false () -> MalVal { return kFalse } -func make_comment () -> MalVal { return kComment } -func make_integer () -> MalVal { return MalInteger() } -func make_float () -> MalVal { return MalFloat() } -func make_symbol () -> MalVal { return MalSymbol() } -func make_keyword () -> MalVal { return MalKeyword() } -func make_string () -> MalVal { return MalString() } -func make_list () -> MalVal { return MalList() } -func make_vector () -> MalVal { return MalVector() } -func make_hashmap () -> MalVal { return MalHashMap() } -func make_atom () -> MalVal { return MalAtom() } -func make_closure () -> MalVal { return MalClosure() } -func make_builtin () -> MalVal { return MalBuiltin() } -func make_macro () -> MalVal { return MalMacro() } - -// ----- Copy ----- - -func make_integer (v: MalInteger) -> MalVal { return MalInteger(v) } -func make_float (v: MalFloat) -> MalVal { return MalFloat(v) } -func make_symbol (v: MalSymbol) -> MalVal { return MalSymbol(v) } -func make_keyword (v: MalKeyword) -> MalVal { return MalKeyword(v) } -func make_string (v: MalString) -> MalVal { return MalString(v) } -func make_list (v: MalList) -> MalVal { return MalList(v) } -func make_vector (v: MalVector) -> MalVal { return MalVector(v) } -func make_hashmap (v: MalHashMap) -> MalVal { return MalHashMap(v) } -func make_atom (v: MalAtom) -> MalVal { return MalAtom(v) } -func make_closure (v: MalClosure) -> MalVal { return MalClosure(v) } -func make_builtin (v: MalBuiltin) -> MalVal { return MalBuiltin(v) } -func make_macro (v: MalMacro) -> MalVal { return MalMacro(v) } - -// ----- Parameterized ----- - -func make_integer (v: MalIntType) -> MalVal { return MalInteger(v) } -func make_float (v: MalFloatType) -> MalVal { return MalFloat(v) } -func make_symbol (v: String) -> MalVal { return MalSymbol(v) } -func make_keyword (v: String) -> MalVal { return MalKeyword(v) } -func make_keyword (v: MalString) -> MalVal { return MalKeyword(v) } -func make_string (v: String) -> MalVal { return MalString(v) } -func make_list (v: MalSequence) -> MalVal { return MalList(seq: v) } -func make_list (v: MalVectorType) -> MalVal { return MalList(v) } -func make_list (v: Array) -> MalVal { return MalList(v) } -func make_list_from (v: MalVal...) -> MalVal { return MalList(v) } -func make_list - (v: T) -> MalVal { return MalList(v) } -func make_vector (v: MalSequence) -> MalVal { return MalVector(seq: v) } -func make_vector (v: MalVectorType) -> MalVal { return MalVector(v) } -func make_vector (v: Array) -> MalVal { return MalVector(v) } -func make_vector - (v: T) -> MalVal { return MalVector(v) } -func make_hashmap (v: MalSequence) -> MalVal { return MalHashMap(v) } -func make_hashmap (v: MalHashType) -> MalVal { return MalHashMap(v) } -func make_hashmap - (v: T) -> MalVal { return MalHashMap(v) } -func make_atom (v: MalVal) -> MalVal { return MalAtom(object: v) } -func make_closure (v: MalClosure.Parameters) -> MalVal { return MalClosure(v) } -func make_builtin (v: MalBuiltin.Signature) -> MalVal { return MalBuiltin(v) } -func make_macro (v: MalClosure) -> MalVal { return MalMacro(v) } - -// ==================== Predicates ==================== - -// ----- Simple ----- - -func is_unknown (v: MalVal) -> Bool { return v is MalUnknown } -func is_nil (v: MalVal) -> Bool { return v is MalNil } -func is_true (v: MalVal) -> Bool { return v is MalTrue } -func is_false (v: MalVal) -> Bool { return v is MalFalse } -func is_comment (v: MalVal) -> Bool { return v is MalComment } -func is_integer (v: MalVal) -> Bool { return v is MalInteger } -func is_float (v: MalVal) -> Bool { return v is MalFloat } -func is_symbol (v: MalVal) -> Bool { return v is MalSymbol } -func is_keyword (v: MalVal) -> Bool { return v is MalKeyword } -func is_string (v: MalVal) -> Bool { return v is MalString } -func is_list (v: MalVal) -> Bool { return v is MalList } -func is_vector (v: MalVal) -> Bool { return v is MalVector } -func is_hashmap (v: MalVal) -> Bool { return v is MalHashMap } -func is_atom (v: MalVal) -> Bool { return v is MalAtom } -func is_closure (v: MalVal) -> Bool { return v is MalClosure } -func is_builtin (v: MalVal) -> Bool { return v is MalBuiltin } -func is_macro (v: MalVal) -> Bool { return v is MalMacro } - -// ----- Compound ----- - -func is_truthy (v: MalVal) -> Bool { return !is_falsey(v) } -func is_falsey (v: MalVal) -> Bool { return is_nil(v) || is_false(v) } -func is_number (v: MalVal) -> Bool { return is_integer(v) || is_float(v) } -func is_sequence (v: MalVal) -> Bool { return is_list(v) || is_vector(v) } -func is_function (v: MalVal) -> Bool { return is_closure(v) || is_builtin(v) } - -// ==================== Converters/Extractors ==================== - -func as_unknown (v: MalVal) -> MalUnknown { return v as! MalUnknown } -func as_nil (v: MalVal) -> MalNil { return v as! MalNil } -func as_true (v: MalVal) -> MalTrue { return v as! MalTrue } -func as_false (v: MalVal) -> MalFalse { return v as! MalFalse } -func as_comment (v: MalVal) -> MalComment { return v as! MalComment } -func as_integer (v: MalVal) -> MalInteger { return v as! MalInteger } -func as_float (v: MalVal) -> MalFloat { return v as! MalFloat } -func as_symbol (v: MalVal) -> MalSymbol { return v as! MalSymbol } -func as_keyword (v: MalVal) -> MalKeyword { return v as! MalKeyword } -func as_string (v: MalVal) -> MalString { return v as! MalString } -func as_list (v: MalVal) -> MalList { return v as! MalList } -func as_vector (v: MalVal) -> MalVector { return v as! MalVector } -func as_hashmap (v: MalVal) -> MalHashMap { return v as! MalHashMap } -func as_atom (v: MalVal) -> MalAtom { return v as! MalAtom } -func as_closure (v: MalVal) -> MalClosure { return v as! MalClosure } -func as_builtin (v: MalVal) -> MalBuiltin { return v as! MalBuiltin } -func as_macro (v: MalVal) -> MalMacro { return v as! MalMacro } - -func as_sequence (v: MalVal) -> MalSequence { return v as! MalSequence } -func as_function (v: MalVal) -> MalFunction { return v as! MalFunction } - -func as_inttype (v: MalVal) -> MalIntType { return as_integer(v).integer } -func as_floattype (v: MalVal) -> MalFloatType { return as_float(v).float } -func as_stringtype (v: MalVal) -> MalStringType { return as_string(v).string } - -func as_inttype (v: MalInteger) -> MalIntType { return v.integer } -func as_floattype (v: MalFloat) -> MalFloatType { return v.float } -func as_stringtype (v: MalString) -> MalStringType { return v.string } - -func as_unknownQ (v: MalVal) -> MalUnknown? { return v as? MalUnknown } -func as_nilQ (v: MalVal) -> MalNil? { return v as? MalNil } -func as_trueQ (v: MalVal) -> MalTrue? { return v as? MalTrue } -func as_falseQ (v: MalVal) -> MalFalse? { return v as? MalFalse } -func as_commentQ (v: MalVal) -> MalComment? { return v as? MalComment } -func as_integerQ (v: MalVal) -> MalInteger? { return v as? MalInteger } -func as_floatQ (v: MalVal) -> MalFloat? { return v as? MalFloat } -func as_symbolQ (v: MalVal) -> MalSymbol? { return v as? MalSymbol } -func as_keywordQ (v: MalVal) -> MalKeyword? { return v as? MalKeyword } -func as_stringQ (v: MalVal) -> MalString? { return v as? MalString } -func as_listQ (v: MalVal) -> MalList? { return v as? MalList } -func as_vectorQ (v: MalVal) -> MalVector? { return v as? MalVector } -func as_hashmapQ (v: MalVal) -> MalHashMap? { return v as? MalHashMap } -func as_atomQ (v: MalVal) -> MalAtom? { return v as? MalAtom } -func as_closureQ (v: MalVal) -> MalClosure? { return v as? MalClosure } -func as_builtinQ (v: MalVal) -> MalBuiltin? { return v as? MalBuiltin } -func as_macroQ (v: MalVal) -> MalMacro? { return v as? MalMacro } - -func as_sequenceQ (v: MalVal) -> MalSequence? { return v as? MalSequence } -func as_functionQ (v: MalVal) -> MalFunction? { return v as? MalFunction } - -func as_inttypeQ (v: MalVal) -> MalIntType? { return as_integerQ(v)?.integer } -func as_floattypeQ (v: MalVal) -> MalFloatType? { return as_floatQ(v)?.float } -func as_stringtypeQ (v: MalVal) -> MalStringType? { return as_stringQ(v)?.string } - -// ==================== Exceptions ==================== - -enum MalException: ErrorType, CustomStringConvertible { - case None - case Message(String) - case Object(MalVal) - - var exception: MalVal { - switch self { - case .None: - return make_nil() - case .Message(let v): - return make_string(v) - case .Object(let v): - return v - } - } - - // CustomStringConvertible - // - var description: String { - switch self { - case .None: - return "NIL Exception" - case .Message(let v): - return v - case .Object(let v): - return v.description - } - } -} - -@noreturn -func throw_error(v: String) throws { throw MalException.Message(v) } - -@noreturn -func throw_error(v: MalVal) throws { throw MalException.Object(v) } - -// ==================== Utilities ==================== - -@noreturn private func die() { - preconditionFailure("Should not get here") -} - -func get_meta(v: MalVal) -> MalVal? { - return v.meta -} - -func with_meta(obj: MalVal, _ meta: MalVal) -> MalVal { - return obj.clone_with_meta(meta) -} - -func unescape(s: String) -> String { - var index = 0 - var prev_is_escape = false - var str = "" - let chars = s.characters - for ch in chars { - if index == chars.count - 1 { continue } - if index++ == 0 { continue } - if prev_is_escape { - prev_is_escape = false - if ch == "n" { str.appendContentsOf("\n") } - else if ch == "r" { str.appendContentsOf("\r") } - else if ch == "t" { str.appendContentsOf("\t") } - else { str.append(ch) } - } else if ch == "\\" { - prev_is_escape = true - } else { - str.append(ch) - } - } - return str -} - -func escape(s: String) -> String { - var str = "" - let chars = s.characters - for ch in chars { - if ch == "\n" { str.appendContentsOf("\\n"); continue } - if ch == "\r" { str.appendContentsOf("\\r"); continue } - if ch == "\t" { str.appendContentsOf("\\t"); continue } - if ch == "\"" || ch == "\\" { str.appendContentsOf("\\") } - str.append(ch) - } - str = "\"" + str + "\"" - return str -} diff --git a/swift/types_enum.swift b/swift/types_enum.swift deleted file mode 100644 index 1f610c318d..0000000000 --- a/swift/types_enum.swift +++ /dev/null @@ -1,1010 +0,0 @@ -//****************************************************************************** -// MAL - types, implemented as a Swift "enum". -//****************************************************************************** - -import Foundation - -// ===== Types / Constants / Variables ===== - -typealias MalProtocol = protocol - -typealias MalIntType = Int64 -typealias MalFloatType = Double -typealias MalSymbolType = String -typealias MalKeywordType = String -typealias MalStringType = String -typealias MalVectorType = ArraySlice -typealias MalHashType = Dictionary - -typealias MalInteger = MalIntType -typealias MalFloat = MalFloatType -typealias MalSymbol = MalSymbolType -typealias MalKeyword = MalKeywordType -typealias MalString = MalStringType - -private let kUnknown = MalVal.TypeUnknown -private let kNil = MalVal.TypeNil -private let kTrue = MalVal.TypeTrue -private let kFalse = MalVal.TypeFalse -private let kComment = MalVal.TypeComment - -// ==================== MalSequence ==================== - -class MalSequence : MalProtocol, SequenceType { - init() { - self.count = 0 - self.isEmpty = true - } - init(_ seq: MalSequence) { - self.count = seq.count - self.isEmpty = seq.isEmpty - } - init(_ count: MalIntType) { - self.count = count - self.isEmpty = self.count == 0 - } - - // CustomStringConvertible - // - var description: String { die() } - - // Hashable - // - var hashValue: Int { die() } - - // SequenceType - // - func generate() -> MalVectorType.Generator { die() } - - // MalSequence - // - let count: MalIntType - let isEmpty: Bool - - func first() -> MalVal { die() } - func last() -> MalVal { die() } - func rest() -> MalVal { die() } - func nth(n: MalIntType) throws -> MalVal { die() } - func range_from(from: MalIntType, to: MalIntType) -> MalVal { die() } - func cons(element: MalVal) -> MalVal { die() } - func concat(seq: MalSequence) throws -> MalVal { die() } - func conj(seq: MalSequence) throws -> MalVal { die() } - func map(@noescape transform: (MalVal) -> U) -> ArraySlice { die() } - func reduce(initial: U, @noescape combine: (U, MalVal) -> U) -> U { die() } -} - -// Equatable -// -func ==(left: MalSequence, right: MalSequence) -> Bool { - if left.count != right.count { return false } - var left_gen = left.generate() - var right_gen = right.generate() - while true { - if let left = left_gen.next(), right = right_gen.next() { - if left != right { - return false - } - } else { - break - } - } - return true -} - -// ==================== MalList ==================== - -final class MalList : MalSequence { - override convenience init() { - self.init(MalVectorType()) - } - init(_ other: MalList, _ meta: MalVal?) { - self._slice = other._slice - self._meta = meta - super.init(other) - } - override convenience init(_ seq: MalSequence) { - if let list = seq as? MalList { self.init(list._slice) } - else - if let vector = seq as? MalVector { self.init(vector._slice) } - else - { self.init(seq.reduce(MalVectorType()){ var s = $0; s.append($1); return s }) } - } - init(_ slice: MalVectorType) { - self._slice = slice - self._meta = nil - super.init(MalIntType(self._slice.count)) - } - convenience init(_ array: Array) { - self.init(array[0..(_ collection: T) { - self.init(collection.reduce(MalVectorType()){ var s = $0; s.append($1); return s }) - } - - // CustomStringConvertible - // - override var description: String { return "(" + self.map { pr_str($0) }.joinWithSeparator(" ") + ")" } - - // Hashable - // - override var hashValue: Int { return description.hashValue } - - // SequenceType - // - override func generate() -> MalVectorType.Generator { return self._slice.generate() } - - // MalSequence - // - override func first() -> MalVal { return isEmpty ? make_nil() : try! nth(0) } - override func last() -> MalVal { return try! nth(count - 1) } - override func rest() -> MalVal { return range_from(MalIntType(1), to: MalIntType(count)) } - override func nth(n: MalIntType) throws -> MalVal { guard n < count else { try throw_error("index (\(n)) out of range (\(count))") }; return self._slice[self._slice.startIndex.advancedBy(Int(n))] } - override func range_from(from: MalIntType, to: MalIntType) -> MalVal { - return from <= to && to <= count - ? make_list(self._slice[self._slice.startIndex.advancedBy(Int(from)).. MalVal { - var result = self._slice - result.insert(element, atIndex: result.startIndex) - return make_list(result) - } - override func concat(seq: MalSequence) throws -> MalVal { - var result = self._slice - if let list = as_listQ(seq) { - result.appendContentsOf(list._slice) - } else if let vector = as_vectorQ(seq) { - result.appendContentsOf(vector._slice) - } else { - try throw_error("Expected sequence, got \(seq)") - } - return make_list(result) - } - override func conj(seq: MalSequence) throws -> MalVal { - var result: Array - if let list = as_listQ(seq) { - result = list._slice.reverse() - } else if let vector = as_vectorQ(seq) { - result = vector._slice.reverse() - } else { - try throw_error("Expected sequence, got \(seq)") - } - result.appendContentsOf(self._slice) - return make_list(result) - } - override func map(@noescape transform: (MalVal) -> U) -> ArraySlice { return ArraySlice(self._slice.map(transform)) } - override func reduce(initial: U, @noescape combine: (U, MalVal) -> U) -> U { return self._slice.reduce(initial, combine: combine) } - - // MalList - // - var meta: MalVal? { return self._meta } - - private let _slice: MalVectorType - private let _meta: MalVal? -} - -// Equatable -// -func ==(left: MalList, right: MalList) -> Bool { - return (left as MalSequence) == (right as MalSequence) -} - -// ==================== MalVector ==================== - -final class MalVector : MalSequence { - override convenience init() { - self.init(MalVectorType()) - } - init(_ other: MalVector, _ meta: MalVal?) { - self._slice = other._slice - self._meta = meta - super.init(other) - } - override convenience init(_ seq: MalSequence) { - if let list = seq as? MalList { self.init(list._slice) } - else - if let vector = seq as? MalVector { self.init(vector._slice) } - else - { self.init(seq.reduce(MalVectorType()){ var s = $0; s.append($1); return s }) } - } - init(_ slice: MalVectorType) { - self._slice = slice - self._meta = nil - super.init(MalIntType(self._slice.count)) - } - convenience init(_ array: Array) { - self.init(array[0..(_ collection: T) { - self.init(collection.reduce(MalVectorType()){ var s = $0; s.append($1); return s }) - } - - // CustomStringConvertible - // - override var description: String { return "[" + self.map { pr_str($0) }.joinWithSeparator(" ") + "]" } - - // Hashable - // - override var hashValue: Int { return description.hashValue } - - // SequenceType - // - override func generate() -> MalVectorType.Generator { return self._slice.generate() } - - // MalSequence - // - override func first() -> MalVal { return isEmpty ? make_nil() : try! nth(0) } - override func last() -> MalVal { return try! nth(count - 1) } - override func rest() -> MalVal { return range_from(MalIntType(1), to: MalIntType(count)) } - override func nth(n: MalIntType) throws -> MalVal { guard n < count else { try throw_error("index (\(n)) out of range (\(count))") }; return self._slice[self._slice.startIndex.advancedBy(Int(n))] } - override func range_from(from: MalIntType, to: MalIntType) -> MalVal { - return from <= to && to <= count - ? make_list(self._slice[self._slice.startIndex.advancedBy(Int(from)).. MalVal { - var result = self._slice - result.insert(element, atIndex: result.startIndex) - return make_list(result) // Yes, make_list - } - override func concat(seq: MalSequence) throws -> MalVal { - var result = self._slice - if let list = as_listQ(seq) { - result.appendContentsOf(list._slice) - } else if let vector = as_vectorQ(seq) { - result.appendContentsOf(vector._slice) - } else { - try throw_error("Expected sequence, got \(seq)") - } - return make_vector(result) - } - override func conj(seq: MalSequence) throws -> MalVal { - var result = self._slice - if let list = as_listQ(seq) { - result.appendContentsOf(list._slice) - } else if let vector = as_vectorQ(seq) { - result.appendContentsOf(vector._slice) - } else { - try throw_error("Expected sequence, got \(seq)") - } - return make_vector(result) - } - override func map(@noescape transform: (MalVal) -> U) -> ArraySlice { return ArraySlice(self._slice.map(transform)) } - override func reduce(initial: U, @noescape combine: (U, MalVal) -> U) -> U { return self._slice.reduce(initial, combine: combine) } - - // MalVector - // - var meta: MalVal? { return self._meta } - - private let _slice: MalVectorType - private let _meta: MalVal? -} - -// Equatable -// -func ==(left: MalVector, right: MalVector) -> Bool { - return (left as MalSequence) == (right as MalSequence) -} - -// ==================== MalHashMap ==================== - -final class MalHashMap : MalProtocol, SequenceType { - convenience init() { - self.init(MalHashType()) - } - init(_ other: MalHashMap, _ meta: MalVal?) { - self._hash = other._hash - self._meta = meta - self.count = MalIntType(self._hash.count) - self.isEmpty = self._hash.isEmpty - } - init(_ hash: MalHashType) { - self._hash = hash - self._meta = nil - self.count = MalIntType(self._hash.count) - self.isEmpty = self._hash.isEmpty - } - convenience init(_ seq: MalSequence) { - var hash = MalHashType() - for var index: MalIntType = 0; index < seq.count; index += 2 { - hash[try! seq.nth(index)] = try! seq.nth(index + 1) - } - self.init(hash) - } - convenience init(_ collection: T) { - var hash = MalHashType() - for var index = collection.startIndex; index != collection.endIndex; { - let key = collection[index++] - let value = collection[index++] - hash[key] = value - } - self.init(hash) - } - - // CustomStringConvertible - // - var description: String { - var a = [String]() - for (k, v) in self._hash { - a.append("\(pr_str(k)) \(pr_str(v))") - } - let s = a.joinWithSeparator(" ") - return "{\(s)}" - } - - // Hashable - // - var hashValue: Int { return description.hashValue } - - // SequenceType - // - func generate() -> MalHashType.Generator { return self._hash.generate() } - - // MalHashMap - // - let count: MalIntType - let isEmpty: Bool - var hash: MalHashType { return self._hash } - var keys: MalVal { return make_list(self._hash.keys) } - var values: MalVal { return make_list(self._hash.values) } - var meta: MalVal? { return self._meta } - - func value_for(key: MalVal) -> MalVal? { - return self._hash[key] - } - - private let _hash: MalHashType - private let _meta: MalVal? -} - -// Equatable -// -func ==(left: MalHashMap, right: MalHashMap) -> Bool { - if left.count != right.count { return false } - var left_gen = left.generate() - var right_gen = right.generate() - while true { - if let left = left_gen.next(), right = right_gen.next() { - if left.0 != right.0 || left.1 != right.1 { - return false - } - } else { - break - } - } - return true -} - -// ==================== MalAtom ==================== - -final class MalAtom : MalProtocol { - convenience init() { - self.init(make_nil()) - } - init(_ other: MalAtom, _ meta: MalVal?) { - self._object = other._object - self._meta = meta - } - init(_ object: MalVal) { - self._object = object - self._meta = nil - } - - // CustomStringConvertible - // - var description: String { return "(atom \(pr_str(self._object)))" } - - // Hashable - // - var hashValue: Int { return description.hashValue } - - // MalAtom - // - var object: MalVal { return self._object } - var meta: MalVal? { return self._meta } - - func set_object(obj: MalVal) -> MalVal { - self._object = obj - return obj - } - - private var _object: MalVal - private let _meta: MalVal? -} - -// Equatable -// -func ==(left: MalAtom, right: MalAtom) -> Bool { return left.object == right.object } - -// ==================== MalFunction ==================== - -class MalFunction : MalProtocol { - init() { - } - init(_ other: MalFunction) { - } - - // CustomStringConvertible - // - var description: String { die() } - - // Hashable - // - var hashValue: Int { die() } - - // MalFunction - // - func apply(exprs: MalSequence) throws -> MalVal { die() } -} - -// Equatable -// -func ==(left: MalFunction, right: MalFunction) -> Bool { return false } - -// ==================== MalClosure ==================== - - -final class MalClosure : MalFunction { - typealias Evaluator = (MalVal, Environment) throws -> MalVal - typealias Parameters = (eval: Evaluator, args: MalSequence, body: MalVal, env: Environment) - - override convenience init() { - self.init(( - eval: {(a: MalVal, b: Environment) -> MalVal in make_nil() }, - args: as_sequence(make_list()), - body: make_nil(), - env: Environment(outer: nil) - )) - } - init(_ other: MalClosure, _ meta: MalVal?) { - self._eval = other._eval - self._args = other._args - self._body = other._body - self._env = other._env - self._meta = meta - super.init(other) - } - init(_ p: Parameters) { - self._eval = p.eval - self._args = p.args - self._body = p.body - self._env = p.env - self._meta = nil - super.init() - } - - // CustomStringConvertible - // - override var description: String { return "#: (fn* \(self._args.description) \(self._body.description))" } - - // Hashable - // - override var hashValue: Int { return description.hashValue } - - // MalFunction - // - override func apply(exprs: MalSequence) throws -> MalVal { - let new_env = Environment(outer: self._env) - let _ = try new_env.set_bindings(self._args, with_exprs: exprs) - // Calling EVAL indirectly via an 'eval' data member is a bit of a hack. - // We can't call EVAL directly because this file (types.swift) needs to - // be used with many different versions of the main MAL file - // (step[0-10]*.swift), and EVAL is declared differently across those - // versions. By using this indirection, we avoid that problem. - return try self._eval(self._body, new_env) - } - - var args: MalSequence { return self._args } - var body: MalVal { return self._body } - var env: Environment { return self._env } - var meta: MalVal? { return self._meta } - - private let _eval: Evaluator! - private let _args: MalSequence - private let _body: MalVal - private let _env: Environment - private let _meta: MalVal? -} - -// Equatable -// -func ==(left: MalClosure, right: MalClosure) -> Bool { return false } - -// ==================== MalBuiltin ==================== - -final class MalBuiltin : MalFunction { - typealias Signature = (MalSequence) throws -> MalVal - - override convenience init() { - self.init( {(MalSequence) -> MalVal in make_nil()} ) - } - init(_ other: MalBuiltin, _ meta: MalVal?) { - self._fn = other._fn - self._meta = meta - super.init(other) - } - init(_ fn: Signature) { - self._fn = fn - self._meta = nil - super.init() - } - - // CustomStringConvertible - // - override var description: String { return "#" } - - // Hashable - // - override var hashValue: Int { return description.hashValue } - - // MalBuiltin - // - override func apply(exprs: MalSequence) throws -> MalVal { return try self._fn(exprs) } - var meta: MalVal? { return self._meta } - - private let _fn: Signature! - private let _meta: MalVal? -} - -// Equatable -// -func ==(left: MalBuiltin, right: MalBuiltin) -> Bool { return false } // Can't compare function references in Swift - -// ==================== MalMacro ==================== - -final class MalMacro : MalProtocol { - convenience init() { - self.init(as_closure(make_closure())) - } - init(_ other: MalMacro, _ meta: MalVal?) { - self._closure = other._closure - self._meta = meta - } - init(_ closure: MalClosure) { - self._closure = closure - self._meta = nil - } - - // CustomStringConvertible - // - var description: String { return self._closure.description } - - // Hashable - // - var hashValue: Int { return description.hashValue } - - var args: MalSequence { return self._closure.args } - var body: MalVal { return self._closure.body } - var env: Environment { return self._closure.env } - var meta: MalVal? { return self._meta } - - private let _closure: MalClosure - private let _meta: MalVal? -} - -// Equatable -// -func ==(left: MalMacro, right: MalMacro) -> Bool { return false } - -// ==================== MalVal ==================== - -enum MalVal : MalProtocol { - case TypeUnknown - case TypeNil - case TypeTrue - case TypeFalse - case TypeComment - case TypeInteger (MalInteger) - case TypeFloat (MalFloat) - case TypeSymbol (MalSymbol) - case TypeKeyword (MalKeyword) - case TypeString (MalString) - case TypeList (MalList) - case TypeVector (MalVector) - case TypeHashMap (MalHashMap) - case TypeAtom (MalAtom) - case TypeClosure (MalClosure) - case TypeBuiltin (MalBuiltin) - case TypeMacro (MalMacro) - - // CustomStringConvertible - // - var description: String { - switch self { - case .TypeUnknown: return "unknown" - case .TypeNil: return "nil" - case .TypeTrue: return "true" - case .TypeFalse: return "false" - case .TypeComment: return "comment" - case .TypeInteger (let v): return v.description - case .TypeFloat (let v): return v.description - case .TypeSymbol (let v): return v - case .TypeKeyword (let v): return v - case .TypeString (let v): return v - case .TypeList (let v): return v.description - case .TypeVector (let v): return v.description - case .TypeHashMap (let v): return v.description - case .TypeAtom (let v): return v.description - case .TypeClosure (let v): return v.description - case .TypeBuiltin (let v): return v.description - case .TypeMacro (let v): return v.description - } - } - - // Hashable - // - var hashValue: Int { - switch self { - case .TypeUnknown: return 0 - case .TypeNil: return 0 - case .TypeTrue: return 0 - case .TypeFalse: return 0 - case .TypeComment: return 0 - case .TypeInteger (let v): return v.hashValue - case .TypeFloat (let v): return v.hashValue - case .TypeSymbol (let v): return v.hashValue - case .TypeKeyword (let v): return v.hashValue - case .TypeString (let v): return v.hashValue - case .TypeList (let v): return v.hashValue - case .TypeVector (let v): return v.hashValue - case .TypeHashMap (let v): return v.hashValue - case .TypeAtom (let v): return v.hashValue - case .TypeClosure (let v): return v.hashValue - case .TypeBuiltin (let v): return v.hashValue - case .TypeMacro (let v): return v.hashValue - } - } -} - -// Equatable -// -func ==(left: MalVal, right: MalVal) -> Bool { - switch (left, right) { - case (.TypeUnknown, .TypeUnknown): return true - case (.TypeNil, .TypeNil): return true - case (.TypeTrue, .TypeTrue): return true - case (.TypeFalse, .TypeFalse): return true - case (.TypeComment, .TypeComment): return false - case (.TypeInteger (let vLeft), .TypeInteger (let vRight)): return vLeft == vRight - case (.TypeFloat (let vLeft), .TypeFloat (let vRight)): return vLeft == vRight - case (.TypeSymbol (let vLeft), .TypeSymbol (let vRight)): return vLeft == vRight - case (.TypeKeyword (let vLeft), .TypeKeyword (let vRight)): return vLeft == vRight - case (.TypeString (let vLeft), .TypeString (let vRight)): return vLeft == vRight - case (.TypeList (let vLeft), .TypeList (let vRight)): return vLeft == vRight - case (.TypeVector (let vLeft), .TypeVector (let vRight)): return vLeft == vRight - case (.TypeHashMap (let vLeft), .TypeHashMap (let vRight)): return vLeft == vRight - case (.TypeAtom (let vLeft), .TypeAtom (let vRight)): return vLeft == vRight - case (.TypeClosure (let vLeft), .TypeClosure (let vRight)): return vLeft == vRight - case (.TypeBuiltin (let vLeft), .TypeBuiltin (let vRight)): return vLeft == vRight - case (.TypeMacro (let vLeft), .TypeMacro (let vRight)): return vLeft == vRight - - case (.TypeList (let vLeft), .TypeVector (let vRight)): return vLeft == vRight - case (.TypeVector (let vLeft), .TypeList (let vRight)): return vLeft == vRight - - default: return false - } -} - -func ==(left: MalList, right: MalVector) -> Bool { - if left.count != right.count { return false } - var left_gen = left.generate() - var right_gen = right.generate() - while true { - if let left = left_gen.next(), right = right_gen.next() { - if left != right { - return false - } - } else { - break - } - } - return true -} - -func ==(left: MalVector, right: MalList) -> Bool { - if left.count != right.count { return false } - var left_gen = left.generate() - var right_gen = right.generate() - while true { - if let left = left_gen.next(), right = right_gen.next() { - if left != right { - return false - } - } else { - break - } - } - return true -} - -// ==================== Constructors ==================== - -// ----- Default ----- - -func make_unknown () -> MalVal { return kUnknown } -func make_nil () -> MalVal { return kNil } -func make_true () -> MalVal { return kTrue } -func make_false () -> MalVal { return kFalse } -func make_comment () -> MalVal { return kComment } -func make_integer () -> MalVal { return make_integer (MalInteger()) } -func make_float () -> MalVal { return make_float (MalFloat()) } -func make_symbol () -> MalVal { return make_symbol (MalSymbol()) } -func make_keyword () -> MalVal { return make_keyword (MalKeyword()) } -func make_string () -> MalVal { return make_string (MalString()) } -func make_list () -> MalVal { return make_list (MalList()) } -func make_vector () -> MalVal { return make_vector (MalVector()) } -func make_hashmap () -> MalVal { return make_hashmap (MalHashMap()) } -func make_atom () -> MalVal { return make_atom (MalAtom()) } -func make_closure () -> MalVal { return make_closure (MalClosure()) } -func make_builtin () -> MalVal { return make_builtin (MalBuiltin()) } -func make_macro () -> MalVal { return make_macro (MalMacro()) } - -// ----- Base ----- - -func make_integer (v: MalInteger) -> MalVal { return MalVal.TypeInteger(v) } -func make_float (v: MalFloat) -> MalVal { return MalVal.TypeFloat(v) } -func make_symbol (v: MalSymbol) -> MalVal { return MalVal.TypeSymbol(v) } -func make_keyword (v: MalKeyword) -> MalVal { return MalVal.TypeKeyword(v) } -func make_string (v: MalString) -> MalVal { return MalVal.TypeString(v) } -func make_list (v: MalList) -> MalVal { return MalVal.TypeList(v) } -func make_vector (v: MalVector) -> MalVal { return MalVal.TypeVector(v) } -func make_hashmap (v: MalHashMap) -> MalVal { return MalVal.TypeHashMap(v) } -func make_atom (v: MalAtom) -> MalVal { return MalVal.TypeAtom(v) } -func make_closure (v: MalClosure) -> MalVal { return MalVal.TypeClosure(v) } -func make_builtin (v: MalBuiltin) -> MalVal { return MalVal.TypeBuiltin(v) } -func make_macro (v: MalMacro) -> MalVal { return MalVal.TypeMacro(v) } - -// ----- Parameterized ----- - -func make_list (v: MalSequence) -> MalVal { return make_list(MalList(v)) } -func make_list (v: MalVectorType) -> MalVal { return make_list(MalList(v)) } -func make_list (v: Array) -> MalVal { return make_list(MalList(v)) } -func make_list_from (v: MalVal...) -> MalVal { return make_list(MalList(v)) } -func make_list - (v: T) -> MalVal { return make_list(MalList(v)) } -func make_vector (v: MalSequence) -> MalVal { return make_vector(MalVector(v)) } -func make_vector (v: MalVectorType) -> MalVal { return make_vector(MalVector(v)) } -func make_vector (v: Array) -> MalVal { return make_vector(MalVector(v)) } -func make_vector_from (v: MalVal...) -> MalVal { return make_vector(MalVector(v)) } -func make_vector - (v: T) -> MalVal { return make_vector(MalVector(v)) } -func make_hashmap (v: MalSequence) -> MalVal { return make_hashmap(MalHashMap(v)) } -func make_hashmap (v: MalHashType) -> MalVal { return make_hashmap(MalHashMap(v)) } -func make_hashmap - (v: T) -> MalVal { return make_hashmap(MalHashMap(v)) } -func make_atom (v: MalVal) -> MalVal { return make_atom(MalAtom(v)) } -func make_closure (v: MalClosure.Parameters) -> MalVal { return make_closure(MalClosure(v)) } -func make_builtin (v: MalBuiltin.Signature) -> MalVal { return make_builtin(MalBuiltin(v)) } -func make_macro (v: MalClosure) -> MalVal { return make_macro(MalMacro(v)) } - -// ==================== Predicates ==================== - -// ----- Simple ----- - -func is_unknown (v: MalVal) -> Bool { if case .TypeUnknown = v { return true } else { return false } } -func is_nil (v: MalVal) -> Bool { if case .TypeNil = v { return true } else { return false } } -func is_true (v: MalVal) -> Bool { if case .TypeTrue = v { return true } else { return false } } -func is_false (v: MalVal) -> Bool { if case .TypeFalse = v { return true } else { return false } } -func is_comment (v: MalVal) -> Bool { if case .TypeComment = v { return true } else { return false } } -func is_integer (v: MalVal) -> Bool { if case .TypeInteger = v { return true } else { return false } } -func is_float (v: MalVal) -> Bool { if case .TypeFloat = v { return true } else { return false } } -func is_symbol (v: MalVal) -> Bool { if case .TypeSymbol = v { return true } else { return false } } -func is_keyword (v: MalVal) -> Bool { if case .TypeKeyword = v { return true } else { return false } } -func is_string (v: MalVal) -> Bool { if case .TypeString = v { return true } else { return false } } -func is_list (v: MalVal) -> Bool { if case .TypeList = v { return true } else { return false } } -func is_vector (v: MalVal) -> Bool { if case .TypeVector = v { return true } else { return false } } -func is_hashmap (v: MalVal) -> Bool { if case .TypeHashMap = v { return true } else { return false } } -func is_atom (v: MalVal) -> Bool { if case .TypeAtom = v { return true } else { return false } } -func is_closure (v: MalVal) -> Bool { if case .TypeClosure = v { return true } else { return false } } -func is_builtin (v: MalVal) -> Bool { if case .TypeBuiltin = v { return true } else { return false } } -func is_macro (v: MalVal) -> Bool { if case .TypeMacro = v { return true } else { return false } } - -// ----- Compound ----- - -func is_truthy (v: MalVal) -> Bool { return !is_falsey(v) } -func is_falsey (v: MalVal) -> Bool { switch v { case .TypeNil, .TypeFalse: return true; default: return false } } -func is_number (v: MalVal) -> Bool { switch v { case .TypeInteger, .TypeFloat: return true; default: return false } } -func is_sequence (v: MalVal) -> Bool { switch v { case .TypeList, .TypeVector: return true; default: return false } } -func is_function (v: MalVal) -> Bool { switch v { case .TypeClosure, .TypeBuiltin: return true; default: return false } } - -// ==================== Converters/Extractors ==================== - -func as_integer (v: MalVal) -> MalInteger { if case .TypeInteger(let w) = v { return w }; die("expected integer, got \(v)") } -func as_float (v: MalVal) -> MalFloat { if case .TypeFloat(let w) = v { return w }; die("expected float, got \(v)") } -func as_symbol (v: MalVal) -> MalSymbol { if case .TypeSymbol(let w) = v { return w }; die("expected symbol, got \(v)") } -func as_keyword (v: MalVal) -> MalKeyword { if case .TypeKeyword(let w) = v { return w }; die("expected keyword, got \(v)") } -func as_string (v: MalVal) -> MalString { if case .TypeString(let w) = v { return w }; die("expected string, got \(v)") } -func as_list (v: MalVal) -> MalList { if case .TypeList(let w) = v { return w }; die("expected list, got \(v)") } -func as_vector (v: MalVal) -> MalVector { if case .TypeVector(let w) = v { return w }; die("expected vector, got \(v)") } -func as_hashmap (v: MalVal) -> MalHashMap { if case .TypeHashMap(let w) = v { return w }; die("expected hashmap, got \(v)") } -func as_atom (v: MalVal) -> MalAtom { if case .TypeAtom(let w) = v { return w }; die("expected atom, got \(v)") } -func as_closure (v: MalVal) -> MalClosure { if case .TypeClosure(let w) = v { return w }; die("expected closure, got \(v)") } -func as_builtin (v: MalVal) -> MalBuiltin { if case .TypeBuiltin(let w) = v { return w }; die("expected builtin, got \(v)") } -func as_macro (v: MalVal) -> MalMacro { if case .TypeMacro(let w) = v { return w }; die("expected macro, got \(v)") } - -func as_sequence (v: MalVal) -> MalSequence { - switch v { - case .TypeList(let v): return v - case .TypeVector(let v): return v - default: die("expected sequence, got \(v)") - } -} -func as_function (v: MalVal) -> MalFunction { - switch v { - case .TypeClosure(let v): return v - case .TypeBuiltin(let v): return v - default: die("expected function, got \(v)") - } -} - -func as_inttype (v: MalVal) -> MalIntType { return as_integer(v) } -func as_floattype (v: MalVal) -> MalFloatType { return as_float(v) } -func as_stringtype (v: MalVal) -> MalStringType { return as_string(v) } - -func as_inttype (v: MalInteger) -> MalIntType { return v } -func as_floattype (v: MalFloat) -> MalFloatType { return v } -func as_stringtype (v: MalString) -> MalStringType { return v } - -func as_integerQ (v: MalVal) -> MalInteger? { if case .TypeInteger(let w) = v { return w }; return nil } -func as_floatQ (v: MalVal) -> MalFloat? { if case .TypeFloat(let w) = v { return w }; return nil } -func as_symbolQ (v: MalVal) -> MalSymbol? { if case .TypeSymbol(let w) = v { return w }; return nil } -func as_keywordQ (v: MalVal) -> MalKeyword? { if case .TypeKeyword(let w) = v { return w }; return nil } -func as_stringQ (v: MalVal) -> MalString? { if case .TypeString(let w) = v { return w }; return nil } -func as_listQ (v: MalVal) -> MalList? { if case .TypeList(let w) = v { return w }; return nil } -func as_vectorQ (v: MalVal) -> MalVector? { if case .TypeVector(let w) = v { return w }; return nil } -func as_hashmapQ (v: MalVal) -> MalHashMap? { if case .TypeHashMap(let w) = v { return w }; return nil } -func as_atomQ (v: MalVal) -> MalAtom? { if case .TypeAtom(let w) = v { return w }; return nil } -func as_closureQ (v: MalVal) -> MalClosure? { if case .TypeClosure(let w) = v { return w }; return nil } -func as_builtinQ (v: MalVal) -> MalBuiltin? { if case .TypeBuiltin(let w) = v { return w }; return nil } -func as_macroQ (v: MalVal) -> MalMacro? { if case .TypeMacro(let w) = v { return w }; return nil } - -func as_listQ (v: MalSequence) -> MalList? { return v as? MalList } -func as_vectorQ (v: MalSequence) -> MalVector? { return v as? MalVector } - -func as_sequenceQ (v: MalVal) -> MalSequence? { - switch v { - case .TypeList(let v): return v - case .TypeVector(let v): return v - default: return nil - } -} -func as_functionQ (v: MalVal) -> MalFunction? { - switch v { - case .TypeClosure(let v): return v - case .TypeBuiltin(let v): return v - default: return nil - } -} - -func as_inttypeQ (v: MalVal) -> MalIntType? { return as_integerQ(v) } -func as_floattypeQ (v: MalVal) -> MalFloatType? { return as_floatQ(v) } -func as_stringtypeQ (v: MalVal) -> MalStringType? { return as_stringQ(v) } - -// ==================== Exceptions ==================== - -enum MalException: ErrorType, CustomStringConvertible { - case None - case Message(String) - case Object(MalVal) - - var exception: MalVal { - switch self { - case .None: - return make_nil() - case .Message(let v): - return make_string(v) - case .Object(let v): - return v - } - } - - // CustomStringConvertible - // - var description: String { - switch self { - case .None: - return "NIL Exception" - case .Message(let v): - return v - case .Object(let v): - return v.description - } - } -} - -@noreturn -func throw_error(v: String) throws { throw MalException.Message(v) } - -@noreturn -func throw_error(v: MalVal) throws { throw MalException.Object(v) } - -// ==================== Utilities ==================== - -@noreturn private func die(msg: String) { - preconditionFailure(msg) -} - -@noreturn private func die() { - die("Should not get here") -} - -func get_meta(v: MalVal) -> MalVal? { - switch v { - case .TypeUnknown: return nil - case .TypeNil: return nil - case .TypeTrue: return nil - case .TypeFalse: return nil - case .TypeComment: return nil - case .TypeInteger: return nil - case .TypeFloat: return nil - case .TypeSymbol: return nil - case .TypeKeyword: return nil - case .TypeString: return nil - case .TypeList (let v): return v.meta - case .TypeVector (let v): return v.meta - case .TypeHashMap (let v): return v.meta - case .TypeAtom (let v): return v.meta - case .TypeClosure (let v): return v.meta - case .TypeBuiltin (let v): return v.meta - case .TypeMacro (let v): return v.meta - } -} - -func with_meta(obj: MalVal, _ meta: MalVal) -> MalVal { - switch obj { - case .TypeUnknown: return obj - case .TypeNil: return obj - case .TypeTrue: return obj - case .TypeFalse: return obj - case .TypeComment: return obj - case .TypeInteger: return obj - case .TypeFloat: return obj - case .TypeSymbol: return obj - case .TypeKeyword: return obj - case .TypeString: return obj - case .TypeList (let v): return make_list(MalList(v, meta)) - case .TypeVector (let v): return make_vector(MalVector(v, meta)) - case .TypeHashMap (let v): return make_hashmap(MalHashMap(v, meta)) - case .TypeAtom (let v): return make_atom(MalAtom(v, meta)) - case .TypeClosure (let v): return make_closure(MalClosure(v, meta)) - case .TypeBuiltin (let v): return make_builtin(MalBuiltin(v, meta)) - case .TypeMacro (let v): return make_macro(MalMacro(v, meta)) - } -} - -func unescape(s: String) -> String { - var index = 0 - var prev_is_escape = false - var str = "" - let chars = s.characters - for ch in chars { - if index == chars.count - 1 { continue } - if index++ == 0 { continue } - if prev_is_escape { - prev_is_escape = false - if ch == "n" { str.appendContentsOf("\n") } - else if ch == "r" { str.appendContentsOf("\r") } - else if ch == "t" { str.appendContentsOf("\t") } - else { str.append(ch) } - } else if ch == "\\" { - prev_is_escape = true - } else { - str.append(ch) - } - } - return str -} - -func escape(s: String) -> String { - var str = "" - let chars = s.characters - for ch in chars { - if ch == "\n" { str.appendContentsOf("\\n"); continue } - if ch == "\r" { str.appendContentsOf("\\r"); continue } - if ch == "\t" { str.appendContentsOf("\\t"); continue } - if ch == "\"" || ch == "\\" { str.appendContentsOf("\\") } - str.append(ch) - } - str = "\"" + str + "\"" - return str -} diff --git a/swift3/Dockerfile b/swift3/Dockerfile deleted file mode 100644 index cc70fb788c..0000000000 --- a/swift3/Dockerfile +++ /dev/null @@ -1,50 +0,0 @@ -FROM ubuntu:wily -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 - -ENV SWIFT_PREFIX swift-DEVELOPMENT-SNAPSHOT-2016-02-08-a -ENV SWIFT_RELEASE ${SWIFT_PREFIX}-ubuntu15.10 - -RUN cd /opt && \ - curl -O https://swift.org/builds/development/ubuntu1510/${SWIFT_PREFIX}/${SWIFT_RELEASE}.tar.gz && \ - tar xvzf ${SWIFT_RELEASE}.tar.gz && \ - rm ${SWIFT_RELEASE}.tar.gz - -# tar xvzf ${SWIFT_RELEASE}.tar.gz --directory / --strip-components 1 && \ -#RUN find /usr -type f | xargs -ifoo chmod go+r foo && \ -# find /usr -type d | xargs -ifoo chmod go+rx foo - -#RUN find /opt/${SWIFT_RELEASE}/ -type f | xargs -ifoo chmod go+r foo && \ -# find /opt/${SWIFT_RELEASE}/ -type d | xargs -ifoo chmod go+rx foo - -ENV PATH /opt/${SWIFT_RELEASE}/usr/bin/:$PATH - -# TODO: better way to do this? And move up. -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 - diff --git a/swift3/Makefile b/swift3/Makefile deleted file mode 100644 index 1a16beae7c..0000000000 --- a/swift3/Makefile +++ /dev/null @@ -1,40 +0,0 @@ -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 - -SOURCES = $(STEP4_DEPS) Sources/stepA_mal/main.swift -SOURCES_LISP = Sources/env.swift Sources/core.swift Sources/stepA_mal/main.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 - -.PHONY: stats tests - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" diff --git a/swift3/Sources/core.swift b/swift3/Sources/core.swift deleted file mode 100644 index 46bb032a02..0000000000 --- a/swift3/Sources/core.swift +++ /dev/null @@ -1,450 +0,0 @@ -// 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 - } - }, - - "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) }.joinWithSeparator(" ") - return MV.MalString(s) - }, - "str": { - // The comment for "pr-str" applies here, too. - let s = $0.map { pr_str($0,false) }.joinWithSeparator("") - return MV.MalString(s) - }, - "prn": { - print($0.map { pr_str($0,true) }.joinWithSeparator(" ")) - return MV.MalNil - }, - "println": { - print($0.map { pr_str($0,false) }.joinWithSeparator(" ")) - 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(stripNewline: 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): - // TODO: replace with this when it is available - // let data = try String(contentsOfFile: file, encoding: NSUTF8StringEncoding) - - let BUFSIZE = 1024 - var pp = popen("cat " + file, "r") - var buf = [CChar](count:BUFSIZE, repeatedValue:CChar(0)) - var data = String() - - while fgets(&buf, Int32(BUFSIZE), pp) != nil { - data = data + String.fromCString(buf)!; - } - 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": { - $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) - }, - "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]).reverse() - 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/swift3/Sources/env.swift b/swift3/Sources/env.swift deleted file mode 100644 index 6c88d0a45e..0000000000 --- a/swift3/Sources/env.swift +++ /dev/null @@ -1,88 +0,0 @@ -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[pos.successor()] { - case MalVal.MalSymbol(let sym): - if pos < es.endIndex { - let slc = es[pos.. Env? { - switch key { - case MalVal.MalSymbol(let str): - if data[str] != nil { - return self - } else if outer != nil { - return try outer!.find(key) - } else { - return nil - } - default: - throw MalError.General(msg: "invalid Env.find call") - } - } - - func get(key: MalVal) throws -> MalVal { - switch key { - case MalVal.MalSymbol(let str): - let env = try self.find(key) - if env == nil { - throw MalError.General(msg: "'\(str)' not found") - } - return env!.data[str]! - default: - throw MalError.General(msg: "invalid Env.find call") - } - } - - 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/swift3/Sources/printer.swift b/swift3/Sources/printer.swift deleted file mode 100644 index 01e8a23788..0000000000 --- a/swift3/Sources/printer.swift +++ /dev/null @@ -1,46 +0,0 @@ - -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.joinWithSeparator(" ") + ")" - case MalVal.MalVector(let lst, _): - let elems = lst.map { pr_str($0, print_readably) } - return "[" + elems.joinWithSeparator(" ") + "]" - case MalVal.MalHashMap(let dict, _): - let elems = dict.map { - pr_str(MalVal.MalString($0), print_readably) + - " " + pr_str($1, print_readably) - } - return "{" + elems.joinWithSeparator(" ") + "}" - case MalVal.MalString(let str): - //print("kw: '\(str[str.startIndex])'") - if str.characters.count > 0 && str[str.startIndex] == "\u{029e}" { - return ":" + str[str.startIndex.successor().." - 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(obj) - } -} diff --git a/swift3/Sources/reader.swift b/swift3/Sources/reader.swift deleted file mode 100644 index 04ea59b005..0000000000 --- a/swift3/Sources/reader.swift +++ /dev/null @@ -1,200 +0,0 @@ -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 = pos.successor() } -} - -func read_int(rdr: Reader) -> MalVal { - let start = rdr.pos - for cidx in rdr.pos.. MalVal { - let start = rdr.pos - var escaped = false - if rdr.str[rdr.pos] != "\"" { - throw MalError.Reader(msg: "read_string call on non-string") - } - for cidx in rdr.pos.successor().. rdr.str.endIndex { - throw MalError.Reader(msg: "Expected '\"', got EOF") - } - let matchStr = rdr.str.substringWithRange( - start.successor().. String { - let start = rdr.pos - for cidx in rdr.pos.. 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 !int_char.contains(rdr.str[rdr.pos.successor()]): - 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() - 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.pos.successor()] { - 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/swift3/Sources/step0_repl/main.swift b/swift3/Sources/step0_repl/main.swift deleted file mode 100644 index 2fadc16c56..0000000000 --- a/swift3/Sources/step0_repl/main.swift +++ /dev/null @@ -1,10 +0,0 @@ -import Foundation - -while true { - print("user> ", terminator: "") - let line = readLine(stripNewline: true) - if line == nil { break } - if line == "" { continue } - - print("\(line!)") -} diff --git a/swift3/Sources/step1_read_print/main.swift b/swift3/Sources/step1_read_print/main.swift deleted file mode 100644 index a37d0e7876..0000000000 --- a/swift3/Sources/step1_read_print/main.swift +++ /dev/null @@ -1,35 +0,0 @@ -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(stripNewline: true) - if line == nil { break } - if line == "" { continue } - - do { - print(try rep(line!)) - } catch (MalError.Reader(let msg)) { - print("Error: \(msg)") - } -} diff --git a/swift3/Sources/step2_eval/main.swift b/swift3/Sources/step2_eval/main.swift deleted file mode 100644 index 1d7203976a..0000000000 --- a/swift3/Sources/step2_eval/main.swift +++ /dev/null @@ -1,88 +0,0 @@ -import Foundation - -// read -func READ(str: String) throws -> MalVal { - return try read_str(str) -} - -// eval -func eval_ast(ast: MalVal, _ env: Dictionary) throws -> MalVal { - switch ast { - case MalVal.MalSymbol(let sym): - if env[sym] == nil { - throw MalError.General(msg: "'\(sym)' not found") - } - return env[sym]! - case MalVal.MalList(let lst, _): - return list(try lst.map { try EVAL($0, env) }) - 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) - default: - return ast - } -} - -func EVAL(ast: MalVal, _ env: Dictionary) throws -> MalVal { - switch ast { - case MalVal.MalList(let lst, _): if lst.count == 0 { return ast } - default: return try eval_ast(ast, env) - } - - switch try eval_ast(ast, env) { - case MalVal.MalList(let elst, _): - switch elst[0] { - case MalVal.MalFunc(let fn,_,_,_,_,_): - let args = Array(elst[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(stripNewline: 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/swift3/Sources/step3_env/main.swift b/swift3/Sources/step3_env/main.swift deleted file mode 100644 index f1a762addc..0000000000 --- a/swift3/Sources/step3_env/main.swift +++ /dev/null @@ -1,115 +0,0 @@ -import Foundation - -// read -func READ(str: String) throws -> MalVal { - return try read_str(str) -} - -// eval -func eval_ast(ast: MalVal, _ env: Env) throws -> MalVal { - switch ast { - case MalVal.MalSymbol: - return try env.get(ast) - case MalVal.MalList(let lst, _): - return list(try lst.map { try EVAL($0, env) }) - 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) - default: - return ast - } -} - -func EVAL(ast: MalVal, _ env: Env) throws -> MalVal { - switch ast { - case MalVal.MalList(let lst, _): if lst.count == 0 { return ast } - default: return try eval_ast(ast, env) - } - - switch ast { - case MalVal.MalList(let lst, _): - 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[idx.successor()], let_env) - try let_env.set(binds[idx], v) - idx = idx.successor().successor() - } - return try EVAL(lst[2], let_env) - default: - switch try eval_ast(ast, env) { - case MalVal.MalList(let elst, _): - switch elst[0] { - case MalVal.MalFunc(let fn,_,_,_,_,_): - let args = Array(elst[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(stripNewline: 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/swift3/Sources/step4_if_fn_do/main.swift b/swift3/Sources/step4_if_fn_do/main.swift deleted file mode 100644 index 782e66a9f6..0000000000 --- a/swift3/Sources/step4_if_fn_do/main.swift +++ /dev/null @@ -1,130 +0,0 @@ -import Foundation - -// read -func READ(str: String) throws -> MalVal { - return try read_str(str) -} - -// eval -func eval_ast(ast: MalVal, _ env: Env) throws -> MalVal { - switch ast { - case MalVal.MalSymbol: - return try env.get(ast) - case MalVal.MalList(let lst, _): - return list(try lst.map { try EVAL($0, env) }) - 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) - default: - return ast - } -} - -func EVAL(ast: MalVal, _ env: Env) throws -> MalVal { - switch ast { - case MalVal.MalList(let lst, _): if lst.count == 0 { return ast } - default: return try eval_ast(ast, env) - } - - switch ast { - case MalVal.MalList(let lst, _): - 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[idx.successor()], let_env) - try let_env.set(binds[idx], v) - idx = idx.successor().successor() - } - return try EVAL(lst[2], let_env) - case MalVal.MalSymbol("do"): - let slc = lst[lst.startIndex.successor().. 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: - switch try eval_ast(ast, env) { - case MalVal.MalList(let elst, _): - switch elst[0] { - case MalVal.MalFunc(let fn,_,_,_,_,_): - let args = Array(elst[1.. String { - return pr_str(exp, true) -} - - -// repl -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(stripNewline: 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/swift3/Sources/step5_tco/main.swift b/swift3/Sources/step5_tco/main.swift deleted file mode 100644 index 866afbcc04..0000000000 --- a/swift3/Sources/step5_tco/main.swift +++ /dev/null @@ -1,135 +0,0 @@ -import Foundation - -// read -func READ(str: String) throws -> MalVal { - return try read_str(str) -} - -// eval -func eval_ast(ast: MalVal, _ env: Env) throws -> MalVal { - switch ast { - case MalVal.MalSymbol: - return try env.get(ast) - case MalVal.MalList(let lst, _): - return list(try lst.map { try EVAL($0, env) }) - 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) - default: - return ast - } -} - -func EVAL(orig_ast: MalVal, _ orig_env: Env) throws -> MalVal { - var ast = orig_ast, env = orig_env - while true { - switch ast { - case MalVal.MalList(let lst, _): if lst.count == 0 { return ast } - default: return try eval_ast(ast, env) - } - - switch ast { - case MalVal.MalList(let lst, _): - 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[idx.successor()], let_env) - try let_env.set(binds[idx], v) - idx = idx.successor().successor() - } - 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: - switch try eval_ast(ast, env) { - case MalVal.MalList(let elst, _): - switch elst[0] { - case MalVal.MalFunc(let fn, nil, _, _, _, _): - let args = Array(elst[1.. String { - return pr_str(exp, true) -} - - -// repl -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(stripNewline: 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/swift3/Sources/step6_file/main.swift b/swift3/Sources/step6_file/main.swift deleted file mode 100644 index 54451235bd..0000000000 --- a/swift3/Sources/step6_file/main.swift +++ /dev/null @@ -1,150 +0,0 @@ -import Foundation - -// read -func READ(str: String) throws -> MalVal { - return try read_str(str) -} - -// eval -func eval_ast(ast: MalVal, _ env: Env) throws -> MalVal { - switch ast { - case MalVal.MalSymbol: - return try env.get(ast) - case MalVal.MalList(let lst, _): - return list(try lst.map { try EVAL($0, env) }) - 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) - default: - return ast - } -} - -func EVAL(orig_ast: MalVal, _ orig_env: Env) throws -> MalVal { - var ast = orig_ast, env = orig_env - while true { - switch ast { - case MalVal.MalList(let lst, _): if lst.count == 0 { return ast } - default: return try eval_ast(ast, env) - } - - switch ast { - case MalVal.MalList(let lst, _): - 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[idx.successor()], let_env) - try let_env.set(binds[idx], v) - idx = idx.successor().successor() - } - 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: - switch try eval_ast(ast, env) { - case MalVal.MalList(let elst, _): - switch elst[0] { - case MalVal.MalFunc(let fn, nil, _, _, _, _): - let args = Array(elst[1.. String { - return pr_str(exp, true) -} - - -// repl -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 = Process.arguments.map { MalVal.MalString($0) } -// TODO: weird way to get empty list, fix this -var args = pargs[pargs.startIndex.. 1 { - try rep("(load-file \"" + Process.arguments[1] + "\")") - exit(0) -} - -while true { - print("user> ", terminator: "") - let line = readLine(stripNewline: 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/swift3/Sources/step7_quote/main.swift b/swift3/Sources/step7_quote/main.swift deleted file mode 100644 index 2ba74fa15f..0000000000 --- a/swift3/Sources/step7_quote/main.swift +++ /dev/null @@ -1,188 +0,0 @@ -import Foundation - -// read -func READ(str: String) throws -> MalVal { - return try read_str(str) -} - -// eval -func is_pair(ast: MalVal) -> Bool { - switch ast { - case MalVal.MalList(let lst, _): return lst.count > 0 - case MalVal.MalVector(let lst, _): return lst.count > 0 - default: return false - } -} - -func quasiquote(ast: MalVal) -> MalVal { - if !is_pair(ast) { - return list([MalVal.MalSymbol("quote"), ast]) - } - let a0 = try! _nth(ast, 0) - switch a0 { - case MalVal.MalSymbol("unquote"): - return try! _nth(ast, 1) - default: true // fallthrough - } - if is_pair(a0) { - let a00 = try! _nth(a0, 0) - switch a00 { - case MalVal.MalSymbol("splice-unquote"): - return list([MalVal.MalSymbol("concat"), - try! _nth(a0, 1), - quasiquote(try! rest(ast))]) - default: true // fallthrough - } - } - - return list([MalVal.MalSymbol("cons"), - quasiquote(a0), - quasiquote(try! rest(ast))]) -} - -func eval_ast(ast: MalVal, _ env: Env) throws -> MalVal { - switch ast { - case MalVal.MalSymbol: - return try env.get(ast) - case MalVal.MalList(let lst, _): - return list(try lst.map { try EVAL($0, env) }) - 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) - default: - return ast - } -} - -func EVAL(orig_ast: MalVal, _ orig_env: Env) throws -> MalVal { - var ast = orig_ast, env = orig_env - while true { - switch ast { - case MalVal.MalList(let lst, _): if lst.count == 0 { return ast } - default: return try eval_ast(ast, env) - } - - switch ast { - case MalVal.MalList(let lst, _): - 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[idx.successor()], let_env) - try let_env.set(binds[idx], v) - idx = idx.successor().successor() - } - 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: - switch try eval_ast(ast, env) { - case MalVal.MalList(let elst, _): - switch elst[0] { - case MalVal.MalFunc(let fn, nil, _, _, _, _): - let args = Array(elst[1.. String { - return pr_str(exp, true) -} - - -// repl -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 = Process.arguments.map { MalVal.MalString($0) } -// TODO: weird way to get empty list, fix this -var args = pargs[pargs.startIndex.. 1 { - try rep("(load-file \"" + Process.arguments[1] + "\")") - exit(0) -} - -while true { - print("user> ", terminator: "") - let line = readLine(stripNewline: 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/swift3/Sources/step8_macros/main.swift b/swift3/Sources/step8_macros/main.swift deleted file mode 100644 index 5830f7d6c1..0000000000 --- a/swift3/Sources/step8_macros/main.swift +++ /dev/null @@ -1,240 +0,0 @@ -import Foundation - -// read -func READ(str: String) throws -> MalVal { - return try read_str(str) -} - -// eval -func is_pair(ast: MalVal) -> Bool { - switch ast { - case MalVal.MalList(let lst, _): return lst.count > 0 - case MalVal.MalVector(let lst, _): return lst.count > 0 - default: return false - } -} - -func quasiquote(ast: MalVal) -> MalVal { - if !is_pair(ast) { - return list([MalVal.MalSymbol("quote"), ast]) - } - let a0 = try! _nth(ast, 0) - switch a0 { - case MalVal.MalSymbol("unquote"): - return try! _nth(ast, 1) - default: true // fallthrough - } - if is_pair(a0) { - let a00 = try! _nth(a0, 0) - switch a00 { - case MalVal.MalSymbol("splice-unquote"): - return list([MalVal.MalSymbol("concat"), - try! _nth(a0, 1), - quasiquote(try! rest(ast))]) - default: true // fallthrough - } - } - - return list([MalVal.MalSymbol("cons"), - quasiquote(a0), - quasiquote(try! rest(ast))]) -} - -func is_macro(ast: MalVal, _ env: Env) -> Bool { - switch ast { - case MalVal.MalList(let lst, _) where lst.count > 0: - let a0 = lst[lst.startIndex] - switch a0 { - case MalVal.MalSymbol: - let e = try! env.find(a0) - if e != nil { - let mac = try! e!.get(a0) - switch mac { - case MalVal.MalFunc(_,_,_,_,let macro,_): return macro - default: return false - } - } else { - return false - } - default: return false - } - default: return false - } -} - -func macroexpand(orig_ast: MalVal, _ env: Env) throws -> MalVal { - var ast: MalVal = orig_ast - while is_macro(ast, env) { - switch try! env.get(try! _nth(ast, 0)) { - case MalVal.MalFunc(let mac,_,_,_,_,_): - ast = try mac(_rest(ast)) - default: throw MalError.General(msg: "impossible state in macroexpand") - } - } - return ast -} - -func eval_ast(ast: MalVal, _ env: Env) throws -> MalVal { - switch ast { - case MalVal.MalSymbol: - return try env.get(ast) - case MalVal.MalList(let lst, _): - return list(try lst.map { try EVAL($0, env) }) - 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) - default: - return ast - } -} - -func EVAL(orig_ast: MalVal, _ orig_env: Env) throws -> MalVal { - var ast = orig_ast, env = orig_env - while true { - switch ast { - case MalVal.MalList(let lst, _): if lst.count == 0 { return ast } - default: return try eval_ast(ast, env) - } - - ast = try macroexpand(ast, env) - switch ast { - case MalVal.MalList: true - default: return try eval_ast(ast, env) - } - - switch ast { - case MalVal.MalList(let lst, _): - 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[idx.successor()], let_env) - try let_env.set(binds[idx], v) - idx = idx.successor().successor() - } - 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("macroexpand"): - return try macroexpand(lst[1], env) - 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: - switch try eval_ast(ast, env) { - case MalVal.MalList(let elst, _): - switch elst[0] { - case MalVal.MalFunc(let fn, nil, _, _, _, _): - let args = Array(elst[1.. String { - return pr_str(exp, true) -} - - -// repl -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 = Process.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)))))))") -try 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.arguments.count > 1 { - try rep("(load-file \"" + Process.arguments[1] + "\")") - exit(0) -} - -while true { - print("user> ", terminator: "") - let line = readLine(stripNewline: 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/swift3/Sources/step9_try/main.swift b/swift3/Sources/step9_try/main.swift deleted file mode 100644 index d7b04147e2..0000000000 --- a/swift3/Sources/step9_try/main.swift +++ /dev/null @@ -1,273 +0,0 @@ -import Foundation - -// read -func READ(str: String) throws -> MalVal { - return try read_str(str) -} - -// eval -func is_pair(ast: MalVal) -> Bool { - switch ast { - case MalVal.MalList(let lst, _): return lst.count > 0 - case MalVal.MalVector(let lst, _): return lst.count > 0 - default: return false - } -} - -func quasiquote(ast: MalVal) -> MalVal { - if !is_pair(ast) { - return list([MalVal.MalSymbol("quote"), ast]) - } - let a0 = try! _nth(ast, 0) - switch a0 { - case MalVal.MalSymbol("unquote"): - return try! _nth(ast, 1) - default: true // fallthrough - } - if is_pair(a0) { - let a00 = try! _nth(a0, 0) - switch a00 { - case MalVal.MalSymbol("splice-unquote"): - return list([MalVal.MalSymbol("concat"), - try! _nth(a0, 1), - quasiquote(try! rest(ast))]) - default: true // fallthrough - } - } - - return list([MalVal.MalSymbol("cons"), - quasiquote(a0), - quasiquote(try! rest(ast))]) -} - -func is_macro(ast: MalVal, _ env: Env) -> Bool { - switch ast { - case MalVal.MalList(let lst, _) where lst.count > 0: - let a0 = lst[lst.startIndex] - switch a0 { - case MalVal.MalSymbol: - let e = try! env.find(a0) - if e != nil { - let mac = try! e!.get(a0) - switch mac { - case MalVal.MalFunc(_,_,_,_,let macro,_): return macro - default: return false - } - } else { - return false - } - default: return false - } - default: return false - } -} - -func macroexpand(orig_ast: MalVal, _ env: Env) throws -> MalVal { - var ast: MalVal = orig_ast - while is_macro(ast, env) { - switch try! env.get(try! _nth(ast, 0)) { - case MalVal.MalFunc(let mac,_,_,_,_,_): - ast = try mac(_rest(ast)) - default: throw MalError.General(msg: "impossible state in macroexpand") - } - } - return ast -} - -func eval_ast(ast: MalVal, _ env: Env) throws -> MalVal { - switch ast { - case MalVal.MalSymbol: - return try env.get(ast) - case MalVal.MalList(let lst, _): - return list(try lst.map { try EVAL($0, env) }) - 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) - default: - return ast - } -} - -func EVAL(orig_ast: MalVal, _ orig_env: Env) throws -> MalVal { - var ast = orig_ast, env = orig_env - while true { - switch ast { - case MalVal.MalList(let lst, _): if lst.count == 0 { return ast } - default: return try eval_ast(ast, env) - } - - ast = try macroexpand(ast, env) - switch ast { - case MalVal.MalList: true - default: return try eval_ast(ast, env) - } - - switch ast { - case MalVal.MalList(let lst, _): - 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[idx.successor()], let_env) - try let_env.set(binds[idx], v) - idx = idx.successor().successor() - } - 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("macroexpand"): - return try macroexpand(lst[1], env) - 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(exc)) - } - return try EVAL(a22, Env(env, binds: list([a21]), - exprs: list([err]))) - default: true // fall through - } - default: true // fall through - } - } - 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: - switch try eval_ast(ast, env) { - case MalVal.MalList(let elst, _): - switch elst[0] { - case MalVal.MalFunc(let fn, nil, _, _, _, _): - let args = Array(elst[1.. String { - return pr_str(exp, true) -} - - -// repl -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 = Process.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)))))))") -try 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.arguments.count > 1 { - try rep("(load-file \"" + Process.arguments[1] + "\")") - exit(0) -} - -while true { - print("user> ", terminator: "") - let line = readLine(stripNewline: 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/swift3/Sources/stepA_mal/main.swift b/swift3/Sources/stepA_mal/main.swift deleted file mode 100644 index 47d6751453..0000000000 --- a/swift3/Sources/stepA_mal/main.swift +++ /dev/null @@ -1,276 +0,0 @@ -import Foundation - -// read -func READ(str: String) throws -> MalVal { - return try read_str(str) -} - -// eval -func is_pair(ast: MalVal) -> Bool { - switch ast { - case MalVal.MalList(let lst, _): return lst.count > 0 - case MalVal.MalVector(let lst, _): return lst.count > 0 - default: return false - } -} - -func quasiquote(ast: MalVal) -> MalVal { - if !is_pair(ast) { - return list([MalVal.MalSymbol("quote"), ast]) - } - let a0 = try! _nth(ast, 0) - switch a0 { - case MalVal.MalSymbol("unquote"): - return try! _nth(ast, 1) - default: true // fallthrough - } - if is_pair(a0) { - let a00 = try! _nth(a0, 0) - switch a00 { - case MalVal.MalSymbol("splice-unquote"): - return list([MalVal.MalSymbol("concat"), - try! _nth(a0, 1), - quasiquote(try! rest(ast))]) - default: true // fallthrough - } - } - - return list([MalVal.MalSymbol("cons"), - quasiquote(a0), - quasiquote(try! rest(ast))]) -} - -func is_macro(ast: MalVal, _ env: Env) -> Bool { - switch ast { - case MalVal.MalList(let lst, _) where lst.count > 0: - let a0 = lst[lst.startIndex] - switch a0 { - case MalVal.MalSymbol: - let e = try! env.find(a0) - if e != nil { - let mac = try! e!.get(a0) - switch mac { - case MalVal.MalFunc(_,_,_,_,let macro,_): return macro - default: return false - } - } else { - return false - } - default: return false - } - default: return false - } -} - -func macroexpand(orig_ast: MalVal, _ env: Env) throws -> MalVal { - var ast: MalVal = orig_ast - while is_macro(ast, env) { - switch try! env.get(try! _nth(ast, 0)) { - case MalVal.MalFunc(let mac,_,_,_,_,_): - ast = try mac(_rest(ast)) - default: throw MalError.General(msg: "impossible state in macroexpand") - } - } - return ast -} - -func eval_ast(ast: MalVal, _ env: Env) throws -> MalVal { - switch ast { - case MalVal.MalSymbol: - return try env.get(ast) - case MalVal.MalList(let lst, _): - return list(try lst.map { try EVAL($0, env) }) - 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) - default: - return ast - } -} - -func EVAL(orig_ast: MalVal, _ orig_env: Env) throws -> MalVal { - var ast = orig_ast, env = orig_env - while true { - switch ast { - case MalVal.MalList(let lst, _): if lst.count == 0 { return ast } - default: return try eval_ast(ast, env) - } - - ast = try macroexpand(ast, env) - switch ast { - case MalVal.MalList: true - default: return try eval_ast(ast, env) - } - - switch ast { - case MalVal.MalList(let lst, _): - 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[idx.successor()], let_env) - try let_env.set(binds[idx], v) - idx = idx.successor().successor() - } - 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("macroexpand"): - return try macroexpand(lst[1], env) - 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(exc)) - } - return try EVAL(a22, Env(env, binds: list([a21]), - exprs: list([err]))) - default: true // fall through - } - default: true // fall through - } - } - 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: - switch try eval_ast(ast, env) { - case MalVal.MalList(let elst, _): - switch elst[0] { - case MalVal.MalFunc(let fn, nil, _, _, _, _): - let args = Array(elst[1.. String { - return pr_str(exp, true) -} - - -// repl -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 = Process.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)))))))") -try rep("(def! *gensym-counter* (atom 0))") -try rep("(def! gensym (fn* [] (symbol (str \"G__\" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))") -try 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 Process.arguments.count > 1 { - try rep("(load-file \"" + Process.arguments[1] + "\")") - exit(0) -} - -while true { - print("user> ", terminator: "") - let line = readLine(stripNewline: 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/swift3/Sources/types.swift b/swift3/Sources/types.swift deleted file mode 100644 index 33c7be9f9e..0000000000 --- a/swift3/Sources/types.swift +++ /dev/null @@ -1,210 +0,0 @@ - -enum MalError: ErrorType { - 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 = idx.successor() - } - 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.removeValueForKey(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: (Array) throws -> MalVal) -> MalVal { - return MV.MalFunc(fn, ast: nil, env: nil, params: nil, - macro: false, meta: nil) -} -func malfunc(fn: (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: (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: (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 slc = lst[lst.startIndex.successor().. 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.advancedBy(idx)] - case MV.MalVector(let l,_): return l[l.startIndex.advancedBy(idx)] - default: throw MalError.General(msg: "Invalid nth call") - } -} diff --git a/swift3/run b/swift3/run deleted file mode 100755 index 8ba68a5484..0000000000 --- a/swift3/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec $(dirname $0)/${STEP:-stepA_mal} "${@}" diff --git a/tcl/Dockerfile b/tcl/Dockerfile deleted file mode 100644 index 2ad3f330c3..0000000000 --- a/tcl/Dockerfile +++ /dev/null @@ -1,26 +0,0 @@ -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 -########################################################## - -RUN apt-get -y install tcl tcl-tclreadline - -ENV HOME /mal diff --git a/tcl/Makefile b/tcl/Makefile deleted file mode 100644 index 5105437e71..0000000000 --- a/tcl/Makefile +++ /dev/null @@ -1,29 +0,0 @@ -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) - -.PHONY: stats stats-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 - - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*\"|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*\"|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" diff --git a/tcl/run b/tcl/run deleted file mode 100755 index e73c2a63fe..0000000000 --- a/tcl/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec tclsh $(dirname $0)/${STEP:-stepA_mal}.tcl ${RAW:+--raw} "${@}" diff --git a/tcl/step7_quote.tcl b/tcl/step7_quote.tcl deleted file mode 100644 index 770d6960f0..0000000000 --- a/tcl/step7_quote.tcl +++ /dev/null @@ -1,209 +0,0 @@ -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 is_pair {ast} { - expr {[sequential_q $ast] && [llength [obj_val $ast]] > 0} -} - -proc quasiquote {ast} { - if {![is_pair $ast]} { - return [list_new [list [symbol_new "quote"] $ast]] - } - lassign [obj_val $ast] a0 a1 - if {[symbol_q $a0] && [obj_val $a0] == "unquote"} { - return $a1 - } - lassign [obj_val $a0] a00 a01 - set rest [list_new [lrange [obj_val $ast] 1 end]] - if {[is_pair $a0] && [symbol_q $a00] && [obj_val $a00] == "splice-unquote"} { - return [list_new [list [symbol_new "concat"] $a01 [quasiquote $rest]]] - } else { - return [list_new [list [symbol_new "cons"] [quasiquote $a0] [quasiquote $rest]]] - } -} - -proc eval_ast {ast env} { - switch [obj_type $ast] { - "symbol" { - set varname [obj_val $ast] - return [$env get $varname] - } - "list" { - set res {} - foreach element [obj_val $ast] { - lappend res [EVAL $element $env] - } - return [list_new $res] - } - "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 } - } -} - -proc EVAL {ast env} { - while {true} { - if {![list_q $ast]} { - return [eval_ast $ast $env] - } - 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" { - set el [list_new [lrange [obj_val $ast] 1 end-1]] - eval_ast $el $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_obj [eval_ast $ast $env] - set lst [obj_val $lst_obj] - 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) \")\")))))" $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/tcl/step8_macros.tcl b/tcl/step8_macros.tcl deleted file mode 100644 index 7329d8b4c0..0000000000 --- a/tcl/step8_macros.tcl +++ /dev/null @@ -1,261 +0,0 @@ -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 is_pair {ast} { - expr {[sequential_q $ast] && [llength [obj_val $ast]] > 0} -} - -proc quasiquote {ast} { - if {![is_pair $ast]} { - return [list_new [list [symbol_new "quote"] $ast]] - } - lassign [obj_val $ast] a0 a1 - if {[symbol_q $a0] && [obj_val $a0] == "unquote"} { - return $a1 - } - lassign [obj_val $a0] a00 a01 - set rest [list_new [lrange [obj_val $ast] 1 end]] - if {[is_pair $a0] && [symbol_q $a00] && [obj_val $a00] == "splice-unquote"} { - return [list_new [list [symbol_new "concat"] $a01 [quasiquote $rest]]] - } else { - return [list_new [list [symbol_new "cons"] [quasiquote $a0] [quasiquote $rest]]] - } -} - -proc is_macro_call {ast env} { - if {![list_q $ast]} { - return 0 - } - set a0 [lindex [obj_val $ast] 0] - if {$a0 == "" || ![symbol_q $a0]} { - return 0 - } - set varname [obj_val $a0] - set foundenv [$env find $varname] - if {$foundenv == 0} { - return 0 - } - macro_q [$env get $varname] -} - -proc macroexpand {ast env} { - while {[is_macro_call $ast $env]} { - set a0 [mal_first [list $ast]] - set macro_name [obj_val $a0] - set macro_obj [$env get $macro_name] - set macro_args [obj_val [mal_rest [list $ast]]] - - set funcdict [obj_val $macro_obj] - set body [dict get $funcdict body] - set env [dict get $funcdict env] - set binds [dict get $funcdict binds] - set funcenv [Env new $env $binds $macro_args] - set ast [EVAL $body $funcenv] - } - return $ast -} - -proc eval_ast {ast env} { - switch [obj_type $ast] { - "symbol" { - set varname [obj_val $ast] - return [$env get $varname] - } - "list" { - set res {} - foreach element [obj_val $ast] { - lappend res [EVAL $element $env] - } - return [list_new $res] - } - "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 } - } -} - -proc EVAL {ast env} { - while {true} { - if {![list_q $ast]} { - return [eval_ast $ast $env] - } - - set ast [macroexpand $ast $env] - if {![list_q $ast]} { - return [eval_ast $ast $env] - } - - 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] - set fn [obj_val $value] - dict set fn is_macro 1 - obj_set_val $value $fn - return [$env set $varname $value] - } - "macroexpand" { - return [macroexpand $a1 $env] - } - "do" { - set el [list_new [lrange [obj_val $ast] 1 end-1]] - eval_ast $el $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_obj [eval_ast $ast $env] - set lst [obj_val $lst_obj] - 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) \")\")))))" $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 -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))))))))" $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/tcl/step9_try.tcl b/tcl/step9_try.tcl deleted file mode 100644 index cbe6e798c3..0000000000 --- a/tcl/step9_try.tcl +++ /dev/null @@ -1,276 +0,0 @@ -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 is_pair {ast} { - expr {[sequential_q $ast] && [llength [obj_val $ast]] > 0} -} - -proc quasiquote {ast} { - if {![is_pair $ast]} { - return [list_new [list [symbol_new "quote"] $ast]] - } - lassign [obj_val $ast] a0 a1 - if {[symbol_q $a0] && [obj_val $a0] == "unquote"} { - return $a1 - } - lassign [obj_val $a0] a00 a01 - set rest [list_new [lrange [obj_val $ast] 1 end]] - if {[is_pair $a0] && [symbol_q $a00] && [obj_val $a00] == "splice-unquote"} { - return [list_new [list [symbol_new "concat"] $a01 [quasiquote $rest]]] - } else { - return [list_new [list [symbol_new "cons"] [quasiquote $a0] [quasiquote $rest]]] - } -} - -proc is_macro_call {ast env} { - if {![list_q $ast]} { - return 0 - } - set a0 [lindex [obj_val $ast] 0] - if {$a0 == "" || ![symbol_q $a0]} { - return 0 - } - set varname [obj_val $a0] - set foundenv [$env find $varname] - if {$foundenv == 0} { - return 0 - } - macro_q [$env get $varname] -} - -proc macroexpand {ast env} { - while {[is_macro_call $ast $env]} { - set a0 [mal_first [list $ast]] - set macro_name [obj_val $a0] - set macro_obj [$env get $macro_name] - set macro_args [obj_val [mal_rest [list $ast]]] - - set funcdict [obj_val $macro_obj] - set body [dict get $funcdict body] - set env [dict get $funcdict env] - set binds [dict get $funcdict binds] - set funcenv [Env new $env $binds $macro_args] - set ast [EVAL $body $funcenv] - } - return $ast -} - -proc eval_ast {ast env} { - switch [obj_type $ast] { - "symbol" { - set varname [obj_val $ast] - return [$env get $varname] - } - "list" { - set res {} - foreach element [obj_val $ast] { - lappend res [EVAL $element $env] - } - return [list_new $res] - } - "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 } - } -} - -proc EVAL {ast env} { - while {true} { - if {![list_q $ast]} { - return [eval_ast $ast $env] - } - - set ast [macroexpand $ast $env] - if {![list_q $ast]} { - return [eval_ast $ast $env] - } - - 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] - set fn [obj_val $value] - dict set fn is_macro 1 - obj_set_val $value $fn - return [$env set $varname $value] - } - "macroexpand" { - return [macroexpand $a1 $env] - } - "try*" { - 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" { - set el [list_new [lrange [obj_val $ast] 1 end-1]] - eval_ast $el $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_obj [eval_ast $ast $env] - set lst [obj_val $lst_obj] - 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) \")\")))))" $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 -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))))))))" $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/tcl/stepA_mal.tcl b/tcl/stepA_mal.tcl deleted file mode 100644 index 010c2f5230..0000000000 --- a/tcl/stepA_mal.tcl +++ /dev/null @@ -1,284 +0,0 @@ -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 is_pair {ast} { - expr {[sequential_q $ast] && [llength [obj_val $ast]] > 0} -} - -proc quasiquote {ast} { - if {![is_pair $ast]} { - return [list_new [list [symbol_new "quote"] $ast]] - } - lassign [obj_val $ast] a0 a1 - if {[symbol_q $a0] && [obj_val $a0] == "unquote"} { - return $a1 - } - lassign [obj_val $a0] a00 a01 - set rest [list_new [lrange [obj_val $ast] 1 end]] - if {[is_pair $a0] && [symbol_q $a00] && [obj_val $a00] == "splice-unquote"} { - return [list_new [list [symbol_new "concat"] $a01 [quasiquote $rest]]] - } else { - return [list_new [list [symbol_new "cons"] [quasiquote $a0] [quasiquote $rest]]] - } -} - -proc is_macro_call {ast env} { - if {![list_q $ast]} { - return 0 - } - set a0 [lindex [obj_val $ast] 0] - if {$a0 == "" || ![symbol_q $a0]} { - return 0 - } - set varname [obj_val $a0] - set foundenv [$env find $varname] - if {$foundenv == 0} { - return 0 - } - macro_q [$env get $varname] -} - -proc macroexpand {ast env} { - while {[is_macro_call $ast $env]} { - set a0 [mal_first [list $ast]] - set macro_name [obj_val $a0] - set macro_obj [$env get $macro_name] - set macro_args [obj_val [mal_rest [list $ast]]] - - set funcdict [obj_val $macro_obj] - set body [dict get $funcdict body] - set env [dict get $funcdict env] - set binds [dict get $funcdict binds] - set funcenv [Env new $env $binds $macro_args] - set ast [EVAL $body $funcenv] - } - return $ast -} - -proc eval_ast {ast env} { - switch [obj_type $ast] { - "symbol" { - set varname [obj_val $ast] - return [$env get $varname] - } - "list" { - set res {} - foreach element [obj_val $ast] { - lappend res [EVAL $element $env] - } - return [list_new $res] - } - "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 } - } -} - -proc EVAL {ast env} { - while {true} { - if {![list_q $ast]} { - return [eval_ast $ast $env] - } - - set ast [macroexpand $ast $env] - if {![list_q $ast]} { - return [eval_ast $ast $env] - } - - 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] - set fn [obj_val $value] - dict set fn is_macro 1 - obj_set_val $value $fn - return [$env set $varname $value] - } - "macroexpand" { - return [macroexpand $a1 $env] - } - "tcl*" { - return [string_new [eval [obj_val $a1]]] - } - "try*" { - 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" { - set el [list_new [lrange [obj_val $ast] 1 end-1]] - eval_ast $el $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_obj [eval_ast $ast $env] - set lst [obj_val $lst_obj] - 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! *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) \")\")))))" $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 -RE "(def! *gensym-counter* (atom 0))" $repl_env -RE "(def! gensym (fn* \[\] (symbol (str \"G__\" (swap! *gensym-counter* (fn* \[x\] (+ 1 x)))))))" $repl_env -RE "(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)))))))))" $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] } { - puts "Error: $exception" - if { $DEBUG_MODE } { - puts $::errorInfo - } - } -} -puts "" diff --git a/tcl/tests/stepA_mal.mal b/tcl/tests/stepA_mal.mal deleted file mode 100644 index 57bdd18378..0000000000 --- a/tcl/tests/stepA_mal.mal +++ /dev/null @@ -1,28 +0,0 @@ -;; 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/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/docker/Dockerfile b/tests/docker/Dockerfile deleted file mode 100644 index 3286498781..0000000000 --- a/tests/docker/Dockerfile +++ /dev/null @@ -1,175 +0,0 @@ -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.11.0.tar.xz \ - && tar xvJf /tmp/nim-0.11.0.tar.xz && cd nim-0.11.0 \ - && make && sh install.sh /usr/local/bin \ - && rm -r /tmp/nim-0.11.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/OS X only -ENV SKIP_IMPLS matlab swift - -ENV DEBIAN_FRONTEND newt -ENV HOME / - -WORKDIR /mal 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/step0_repl.mal b/tests/step0_repl.mal deleted file mode 100644 index 2b83a01f02..0000000000 --- a/tests/step0_repl.mal +++ /dev/null @@ -1,17 +0,0 @@ -;; 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 (;:() []{}"'* ;:() []{}"'* ;:() []{}"'*) - diff --git a/tests/step1_read_print.mal b/tests/step1_read_print.mal deleted file mode 100644 index 69e4336bc8..0000000000 --- a/tests/step1_read_print.mal +++ /dev/null @@ -1,147 +0,0 @@ -;; 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 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) -(* -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" -;;;"abc\ndef" -;;;;=>"abc\ndef" -"" -;=>"" - -;; Testing reader errors -;;; TODO: fix these so they fail correctly -(1 2 -; expected ')', got EOF -[1 2 -; expected ']', got EOF -"abc -; expected '"', got EOF -(1 "abc -; expected ')', got EOF - -;; 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)) - - -;>>> optional=True -;; -;; -------- 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 a077d20363..0000000000 --- a/tests/step2_eval.mal +++ /dev/null @@ -1,43 +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 - -(* -3 6) -;=>-18 - -(/ (- (+ 515 (* -222 311)) 296) 27) -;=>-2549 - -(abc 1 2 3) -; .*\'abc\' not found.* - -;; Testing empty list -() -;=>() - -;>>> deferrable=True -;>>> optional=True -;; -;; -------- Deferrable/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 ab2aa57569..0000000000 --- a/tests/step3_env.mal +++ /dev/null @@ -1,72 +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 - -;; Verifying symbols are case-sensitive -(def! mynum 111) -;=>111 -(def! MYNUM 222) -;=>222 -mynum -;=>111 -MYNUM -;=>222 - - -;; 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 - -;; 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 -(let* (x 4) (def! a 5)) -;=>5 -a -;=>4 - -;>>> deferrable=True -;>>> optional=True -;; -;; -------- Deferrable/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 87e39d0f48..0000000000 --- a/tests/step4_if_fn_do.mal +++ /dev/null @@ -1,464 +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" "abc") -;=>true -(= "abc" "") -;=>false -(= "" "abc") -;=>false -(= "abc" "def") -;=>false -(= "abc" "ABC") -;=>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 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 -;;; Too slow for bash, erlang, make and miniMAL -;;;(fib 10) -;;;;=>89 - - -;>>> deferrable=True -;; -;; -------- Deferrable Functionality -------- - -;; 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 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" - -;; 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 - -;>>> optional=True -;; -;; -------- Optional Functionality -------- - -;; Testing keywords -(= :abc :abc) -;=>true -(= :abc :def) -;=>false -(= :abc ":abc") -;=>false - -;; 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 -(= (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/tests/step5_tco.mal b/tests/step5_tco.mal deleted file mode 100644 index 42c7fa421a..0000000000 --- a/tests/step5_tco.mal +++ /dev/null @@ -1,21 +0,0 @@ -;; 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 - - -;; 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/tests/step6_file.mal b/tests/step6_file.mal deleted file mode 100644 index c024e0d629..0000000000 --- a/tests/step6_file.mal +++ /dev/null @@ -1,127 +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 "(1 2 (3 4) nil)") -;=>(1 2 (3 4) nil) - -(read-string "(+ 2 3)") -;=>(+ 2 3) - -(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" - -;; 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* -;=>() - -;; -;; 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 - -;; 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 - -;>>> deferrable=True -;>>> optional=True -;; -;; -------- Deferrable/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} - -;; 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 - diff --git a/tests/step7_quote.mal b/tests/step7_quote.mal deleted file mode 100644 index bd5b22fe6f..0000000000 --- a/tests/step7_quote.mal +++ /dev/null @@ -1,180 +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) - -(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)) -;=>() - -(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 7) -;=>7 -(quasiquote (1 2 3)) -;=>(1 2 3) -(quasiquote (1 2 (3 4))) -;=>(1 2 (3 4)) -(quasiquote (nil)) -;=>(nil) - -;; 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) - - -;; 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) - - -;; 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 - -;;;;; 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))))))) - -;>>> 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 ` (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) - - -;>>> optional=True -;; -;; -------- 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 8d0ac4ba2f..0000000000 --- a/tests/step8_macros.mal +++ /dev/null @@ -1,169 +0,0 @@ -;; 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 macroexpand -(macroexpand (unless2 2 3 4)) -;=>(if (not 2) 3 4) - -;; Testing evaluation of macro result -(defmacro! identity (fn* (x) x)) -(let* (a 123) (identity a)) -;=>123 - - -;>>> 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 -(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 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 -(or (or false 4)) -;=>4 - -;; 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 EVAL in let* - -(let* (x (or nil "yes")) x) -;=>"yes" - - -;>>> optional=True -;; -;; -------- 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 nil) -;=>nil -(first [10]) -;=>10 -(first [10 11 12]) -;=>10 -(rest []) -;=>() -(rest nil) -;=>() -(rest [10]) -;=>() -(rest [10 11 12]) -;=>(11 12) - -;; Testing EVAL in vector let* - -(let* [x (or nil "yes")] x) -;=>"yes" - -;; -;; Loading core.mal -(load-file "../core.mal") - -;; 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/tests/step9_try.mal b/tests/step9_try.mal deleted file mode 100644 index 3d6f86ea5f..0000000000 --- a/tests/step9_try.mal +++ /dev/null @@ -1,337 +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 - -(try* (throw "my exception") (catch* exc (do (prn "exc:" exc) 7))) -; "exc:" "my exception" -;=>7 - -;;; 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? true) -;=>false - -(true? true) -;=>true -(true? false) -;=>false -(true? true?) -;=>false - -(false? false) -;=>true -(false? true) -;=>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 - -;; 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 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) - -;>>> deferrable=True -;; -;; ------- Deferrable 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? "") -;=>false -(keyword? (keyword "abc")) -;=>true - -(symbol "abc") -;=>abc -;;;TODO: all implementations should suppport this too -;;;(keyword :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 -;; 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) - -;; 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} - -(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 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 nil as hash-map values -(contains? {:abc nil} :abc) -;=>true -(assoc {} :bcd nil) -;=>{:bcd nil} -(dissoc {:cde nil :fgh 456} :cde) -;=>{:fgh 456} - -;; Testing equality of hash-maps -(= {} {}) -;=>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 - -;; -;; 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"})) -(or (= s "{:abc val1 :def val2}") (= s "{:def val2 :abc val1}")) -;=>true - -(def! p (pr-str {:abc "val1" :def "val2"})) -(or (= p "{:abc \"val1\" :def \"val2\"}") (= p "{:def \"val2\" :abc \"val1\"}")) -;=>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) ------- - - -;;;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 throwing non-strings -(try* (throw (list 1 2 3)) (catch* exc (do (prn "err:" exc) 7))) -; "err:" (1 2 3) -;=>7 - diff --git a/tests/stepA_mal.mal b/tests/stepA_mal.mal deleted file mode 100644 index a349c09b6b..0000000000 --- a/tests/stepA_mal.mal +++ /dev/null @@ -1,237 +0,0 @@ -;;; -;;; 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 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 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) - - -;>>> soft=True -;>>> optional=True -;; -;; ------- Optional Functionality -------------- -;; ------- (Not needed for self-hosting) ------- - -;; -;; 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 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" - -(meta (with-meta (list 1 2 3) {"a" 1})) -;=>{"a" 1} - -(list? (with-meta (list 1 2 3) {"a" 1})) -;=>true - -(meta (with-meta {"abc" 123} {"a" 1})) -;=>{"a" 1} - -(map? (with-meta {"abc" 123} {"a" 1})) -;=>true - -;;; 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 - -;; -;; Testing gensym and clean or macro -(= (gensym) (gensym)) -;=>false -(let* [or_FIXME 23] (or false (+ or_FIXME 100))) -;=>123 - -;; -;; Testing time-ms function -(def! start-time (time-ms)) -(> start-time 0) -;=>true -(let* [sumdown (fn* (N) (if (> N 0) (+ N (sumdown (- N 1))) 0))] (sumdown 10)) ; Waste some time -;=>55 -(> (time-ms) start-time) -;=>true diff --git a/vb/Dockerfile b/vb/Dockerfile deleted file mode 100644 index f5f133484d..0000000000 --- a/vb/Dockerfile +++ /dev/null @@ -1,25 +0,0 @@ -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 -########################################################## - -# Deps for Mono-based languages (C#, VB.Net) -RUN apt-get -y install mono-runtime mono-mcs mono-vbnc mono-devel diff --git a/vb/Makefile b/vb/Makefile deleted file mode 100644 index ce5145a08f..0000000000 --- a/vb/Makefile +++ /dev/null @@ -1,56 +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: $(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 - -.PHONY: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*'|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*'|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" - -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/run b/vb/run deleted file mode 100755 index fa517a6ec7..0000000000 --- a/vb/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec mono $(dirname $0)/${STEP:-stepA_mal}.exe ${RAW:+--raw} "${@}" 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 1e977aed6b..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 eval_ast(expanded, env) - 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 e94cca7824..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 eval_ast(expanded, env) - 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 08ba138c6f..0000000000 --- a/vb/stepA_mal.vb +++ /dev/null @@ -1,319 +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 eval_ast(expanded, env) - 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("(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)))))))))") - - 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/vhdl/Dockerfile b/vhdl/Dockerfile deleted file mode 100644 index 6b841c0d2c..0000000000 --- a/vhdl/Dockerfile +++ /dev/null @@ -1,30 +0,0 @@ -FROM ubuntu:14.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 software-properties-common && \ - apt-add-repository -y ppa:pgavin/ghdl && \ - apt-get update -y - -RUN apt-get -y install ghdl - -ENV HOME /mal diff --git a/vhdl/Makefile b/vhdl/Makefile deleted file mode 100644 index 0649e7863c..0000000000 --- a/vhdl/Makefile +++ /dev/null @@ -1,61 +0,0 @@ -TESTS = - -SOURCES_BASE = pkg_readline.vhdl types.vhdl printer.vhdl reader.vhdl -SOURCES_LISP = env.vhdl core.vhdl stepA_mal.vhdl -SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) - -##################### - -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 $@ - -# The ghdl linker creates a lowercase executable file; rename it to stepA_mal -stepA_mal: stepA_mal.o - ghdl -e -g $@ - mv stepa_mal stepA_mal - -clean: - rm -f $(OBJS) $(BINS) $(OTHER_OBJS) work-obj93.cf mal - -.PHONY: stats stats-lisp tests $(TESTS) - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" - -tests: $(TESTS) - -$(TESTS): - @echo "Running $@"; \ - ./$@ || exit 1; \ diff --git a/vhdl/env.vhdl b/vhdl/env.vhdl deleted file mode 100644 index 1625a9aba6..0000000000 --- a/vhdl/env.vhdl +++ /dev/null @@ -1,72 +0,0 @@ -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; err: 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_find(e: inout env_ptr; key: inout mal_val_ptr; found_env: out env_ptr) is - variable found: boolean; - begin - hashmap_contains(e.data, key, found); - if found then - found_env := e; - else - if e.outer = null then - found_env := null; - else - env_find(e.outer, key, found_env); - end if; - end if; - end procedure env_find; - - procedure env_get(e: inout env_ptr; key: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is - variable found_env: env_ptr; - begin - env_find(e, key, found_env); - if found_env = null then - new_string("'" & key.string_val.all & "' not found", err); - result := null; - return; - end if; - hashmap_get(found_env.data, key, result); - end procedure env_get; - -end package body env; diff --git a/vhdl/run b/vhdl/run deleted file mode 100755 index 12de079d1f..0000000000 --- a/vhdl/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec $(dirname $0)/run_vhdl.sh $(dirname $0)/${STEP:-stepA_mal} "${@}" diff --git a/vhdl/step7_quote.vhdl b/vhdl/step7_quote.vhdl deleted file mode 100644 index fdfc2efda0..0000000000 --- a/vhdl/step7_quote.vhdl +++ /dev/null @@ -1,381 +0,0 @@ -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 is_pair(ast: inout mal_val_ptr; pair: out boolean) is - begin - pair := is_sequential_type(ast.val_type) and ast.seq_val'length > 0; - end procedure is_pair; - - procedure quasiquote(ast: inout mal_val_ptr; result: out mal_val_ptr) is - variable ast_pair, a0_pair: boolean; - variable seq: mal_seq_ptr; - variable a0, rest: mal_val_ptr; - begin - is_pair(ast, ast_pair); - if not ast_pair then - seq := new mal_seq(0 to 1); - new_symbol("quote", seq(0)); - seq(1) := ast; - new_seq_obj(mal_list, seq, result); - return; - end if; - a0 := ast.seq_val(0); - if a0.val_type = mal_symbol and a0.string_val.all = "unquote" then - result := ast.seq_val(1); - else - is_pair(a0, a0_pair); - if a0_pair and a0.seq_val(0).val_type = mal_symbol and a0.seq_val(0).string_val.all = "splice-unquote" then - seq := new mal_seq(0 to 2); - new_symbol("concat", seq(0)); - seq(1) := a0.seq_val(1); - seq_drop_prefix(ast, 1, rest); - quasiquote(rest, seq(2)); - new_seq_obj(mal_list, seq, result); - else - seq := new mal_seq(0 to 2); - new_symbol("cons", seq(0)); - quasiquote(a0, seq(1)); - seq_drop_prefix(ast, 1, rest); - quasiquote(rest, seq(2)); - new_seq_obj(mal_list, seq, result); - end if; - end if; - 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; 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); - for i in result'range loop - EVAL(ast_seq(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(ast: inout mal_val_ptr; env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is - variable key, val, eval_err, env_err: mal_val_ptr; - variable new_seq: mal_seq_ptr; - variable i: integer; - begin - case ast.val_type is - when mal_symbol => - env_get(env, ast, val, env_err); - if env_err /= null then - err := env_err; - return; - end if; - result := val; - return; - when mal_list | mal_vector | mal_hashmap => - eval_ast_seq(ast.seq_val, 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; - end procedure eval_ast; - - 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 i: integer; - variable ast, evaled_ast, a0, call_args, val, vars, sub_err, fn: mal_val_ptr; - variable env, let_env, fn_env: env_ptr; - begin - ast := in_ast; - env := in_env; - loop - if ast.val_type /= mal_list then - eval_ast(ast, env, result, err); - return; - end if; - - 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_ast(ast, env, evaled_ast, sub_err); - if sub_err /= null then - err := sub_err; - return; - end if; - seq_drop_prefix(evaled_ast, 1, call_args); - fn := evaled_ast.seq_val(0); - case fn.val_type is - when mal_nativefn => - apply_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 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) " & '"' & ")" & '"' & ")))))", 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/vhdl/step8_macros.vhdl b/vhdl/step8_macros.vhdl deleted file mode 100644 index 662b3959b1..0000000000 --- a/vhdl/step8_macros.vhdl +++ /dev/null @@ -1,441 +0,0 @@ -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 is_pair(ast: inout mal_val_ptr; pair: out boolean) is - begin - pair := is_sequential_type(ast.val_type) and ast.seq_val'length > 0; - end procedure is_pair; - - procedure quasiquote(ast: inout mal_val_ptr; result: out mal_val_ptr) is - variable ast_pair, a0_pair: boolean; - variable seq: mal_seq_ptr; - variable a0, rest: mal_val_ptr; - begin - is_pair(ast, ast_pair); - if not ast_pair then - seq := new mal_seq(0 to 1); - new_symbol("quote", seq(0)); - seq(1) := ast; - new_seq_obj(mal_list, seq, result); - return; - end if; - a0 := ast.seq_val(0); - if a0.val_type = mal_symbol and a0.string_val.all = "unquote" then - result := ast.seq_val(1); - else - is_pair(a0, a0_pair); - if a0_pair and a0.seq_val(0).val_type = mal_symbol and a0.seq_val(0).string_val.all = "splice-unquote" then - seq := new mal_seq(0 to 2); - new_symbol("concat", seq(0)); - seq(1) := a0.seq_val(1); - seq_drop_prefix(ast, 1, rest); - quasiquote(rest, seq(2)); - new_seq_obj(mal_list, seq, result); - else - seq := new mal_seq(0 to 2); - new_symbol("cons", seq(0)); - quasiquote(a0, seq(1)); - seq_drop_prefix(ast, 1, rest); - quasiquote(rest, seq(2)); - new_seq_obj(mal_list, seq, result); - end if; - end if; - 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 is_macro_call(ast: inout mal_val_ptr; env: inout env_ptr; is_macro: out boolean) is - variable f, env_err: mal_val_ptr; - begin - is_macro := false; - if ast.val_type = mal_list and - ast.seq_val'length > 0 and - ast.seq_val(0).val_type = mal_symbol then - env_get(env, ast.seq_val(0), f, env_err); - if env_err = null and f /= null and - f.val_type = mal_fn and f.func_val.f_is_macro then - is_macro := true; - end if; - end if; - end procedure is_macro_call; - - procedure macroexpand(in_ast: inout mal_val_ptr; env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is - variable ast, macro_fn, call_args, macro_err: mal_val_ptr; - variable is_macro: boolean; - begin - ast := in_ast; - is_macro_call(ast, env, is_macro); - while is_macro loop - env_get(env, ast.seq_val(0), macro_fn, macro_err); - seq_drop_prefix(ast, 1, call_args); - apply_func(macro_fn, call_args, ast, macro_err); - if macro_err /= null then - err := macro_err; - return; - end if; - is_macro_call(ast, env, is_macro); - end loop; - result := ast; - end procedure macroexpand; - - 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; 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); - for i in result'range loop - EVAL(ast_seq(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(ast: inout mal_val_ptr; env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is - variable key, val, eval_err, env_err: mal_val_ptr; - variable new_seq: mal_seq_ptr; - variable i: integer; - begin - case ast.val_type is - when mal_symbol => - env_get(env, ast, val, env_err); - if env_err /= null then - err := env_err; - return; - end if; - result := val; - return; - when mal_list | mal_vector | mal_hashmap => - eval_ast_seq(ast.seq_val, 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; - end procedure eval_ast; - - 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 i: integer; - variable ast, evaled_ast, a0, call_args, val, vars, sub_err, fn: mal_val_ptr; - variable env, let_env, fn_env: env_ptr; - begin - ast := in_ast; - env := in_env; - loop - if ast.val_type /= mal_list then - eval_ast(ast, env, result, err); - return; - end if; - - macroexpand(ast, env, ast, sub_err); - if sub_err /= null then - err := sub_err; - return; - end if; - if ast.val_type /= mal_list then - eval_ast(ast, env, result, err); - return; - end if; - 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, val, sub_err); - if sub_err /= null then - err := sub_err; - return; - end if; - val.func_val.f_is_macro := true; - env_set(env, ast.seq_val(1), val); - result := val; - return; - - elsif a0.string_val.all = "macroexpand" then - macroexpand(ast.seq_val(1), env, result, err); - 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_ast(ast, env, evaled_ast, sub_err); - if sub_err /= null then - err := sub_err; - return; - end if; - seq_drop_prefix(evaled_ast, 1, call_args); - fn := evaled_ast.seq_val(0); - case fn.val_type is - when mal_nativefn => - apply_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 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) " & '"' & ")" & '"' & ")))))", 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); - 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))))))))", 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/vhdl/step9_try.vhdl b/vhdl/step9_try.vhdl deleted file mode 100644 index 6c811dd499..0000000000 --- a/vhdl/step9_try.vhdl +++ /dev/null @@ -1,498 +0,0 @@ -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 is_pair(ast: inout mal_val_ptr; pair: out boolean) is - begin - pair := is_sequential_type(ast.val_type) and ast.seq_val'length > 0; - end procedure is_pair; - - procedure quasiquote(ast: inout mal_val_ptr; result: out mal_val_ptr) is - variable ast_pair, a0_pair: boolean; - variable seq: mal_seq_ptr; - variable a0, rest: mal_val_ptr; - begin - is_pair(ast, ast_pair); - if not ast_pair then - seq := new mal_seq(0 to 1); - new_symbol("quote", seq(0)); - seq(1) := ast; - new_seq_obj(mal_list, seq, result); - return; - end if; - a0 := ast.seq_val(0); - if a0.val_type = mal_symbol and a0.string_val.all = "unquote" then - result := ast.seq_val(1); - else - is_pair(a0, a0_pair); - if a0_pair and a0.seq_val(0).val_type = mal_symbol and a0.seq_val(0).string_val.all = "splice-unquote" then - seq := new mal_seq(0 to 2); - new_symbol("concat", seq(0)); - seq(1) := a0.seq_val(1); - seq_drop_prefix(ast, 1, rest); - quasiquote(rest, seq(2)); - new_seq_obj(mal_list, seq, result); - else - seq := new mal_seq(0 to 2); - new_symbol("cons", seq(0)); - quasiquote(a0, seq(1)); - seq_drop_prefix(ast, 1, rest); - quasiquote(rest, seq(2)); - new_seq_obj(mal_list, seq, result); - end if; - end if; - 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 is_macro_call(ast: inout mal_val_ptr; env: inout env_ptr; is_macro: out boolean) is - variable f, env_err: mal_val_ptr; - begin - is_macro := false; - if ast.val_type = mal_list and - ast.seq_val'length > 0 and - ast.seq_val(0).val_type = mal_symbol then - env_get(env, ast.seq_val(0), f, env_err); - if env_err = null and f /= null and - f.val_type = mal_fn and f.func_val.f_is_macro then - is_macro := true; - end if; - end if; - end procedure is_macro_call; - - procedure macroexpand(in_ast: inout mal_val_ptr; env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is - variable ast, macro_fn, call_args, macro_err: mal_val_ptr; - variable is_macro: boolean; - begin - ast := in_ast; - is_macro_call(ast, env, is_macro); - while is_macro loop - env_get(env, ast.seq_val(0), macro_fn, macro_err); - seq_drop_prefix(ast, 1, call_args); - apply_func(macro_fn, call_args, ast, macro_err); - if macro_err /= null then - err := macro_err; - return; - end if; - is_macro_call(ast, env, is_macro); - end loop; - result := ast; - end procedure macroexpand; - - 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; 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); - for i in result'range loop - EVAL(ast_seq(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(ast: inout mal_val_ptr; env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is - variable key, val, eval_err, env_err: mal_val_ptr; - variable new_seq: mal_seq_ptr; - variable i: integer; - begin - case ast.val_type is - when mal_symbol => - env_get(env, ast, val, env_err); - if env_err /= null then - err := env_err; - return; - end if; - result := val; - return; - when mal_list | mal_vector | mal_hashmap => - eval_ast_seq(ast.seq_val, 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; - end procedure eval_ast; - - 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 i: integer; - variable ast, evaled_ast, a0, call_args, val, vars, sub_err, fn: mal_val_ptr; - variable env, let_env, catch_env, fn_env: env_ptr; - begin - ast := in_ast; - env := in_env; - loop - if ast.val_type /= mal_list then - eval_ast(ast, env, result, err); - return; - end if; - - macroexpand(ast, env, ast, sub_err); - if sub_err /= null then - err := sub_err; - return; - end if; - if ast.val_type /= mal_list then - eval_ast(ast, env, result, err); - return; - end if; - 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, val, sub_err); - if sub_err /= null then - err := sub_err; - return; - end if; - val.func_val.f_is_macro := true; - env_set(env, ast.seq_val(1), val); - result := val; - return; - - elsif a0.string_val.all = "macroexpand" then - macroexpand(ast.seq_val(1), env, result, err); - 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 - new_nil(result); - 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_ast(ast, env, evaled_ast, sub_err); - if sub_err /= null then - err := sub_err; - return; - end if; - seq_drop_prefix(evaled_ast, 1, call_args); - fn := evaled_ast.seq_val(0); - case fn.val_type is - when mal_nativefn => - apply_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 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) " & '"' & ")" & '"' & ")))))", 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); - 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))))))))", 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/vhdl/stepA_mal.vhdl b/vhdl/stepA_mal.vhdl deleted file mode 100644 index d67507bbfe..0000000000 --- a/vhdl/stepA_mal.vhdl +++ /dev/null @@ -1,502 +0,0 @@ -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 is_pair(ast: inout mal_val_ptr; pair: out boolean) is - begin - pair := is_sequential_type(ast.val_type) and ast.seq_val'length > 0; - end procedure is_pair; - - procedure quasiquote(ast: inout mal_val_ptr; result: out mal_val_ptr) is - variable ast_pair, a0_pair: boolean; - variable seq: mal_seq_ptr; - variable a0, rest: mal_val_ptr; - begin - is_pair(ast, ast_pair); - if not ast_pair then - seq := new mal_seq(0 to 1); - new_symbol("quote", seq(0)); - seq(1) := ast; - new_seq_obj(mal_list, seq, result); - return; - end if; - a0 := ast.seq_val(0); - if a0.val_type = mal_symbol and a0.string_val.all = "unquote" then - result := ast.seq_val(1); - else - is_pair(a0, a0_pair); - if a0_pair and a0.seq_val(0).val_type = mal_symbol and a0.seq_val(0).string_val.all = "splice-unquote" then - seq := new mal_seq(0 to 2); - new_symbol("concat", seq(0)); - seq(1) := a0.seq_val(1); - seq_drop_prefix(ast, 1, rest); - quasiquote(rest, seq(2)); - new_seq_obj(mal_list, seq, result); - else - seq := new mal_seq(0 to 2); - new_symbol("cons", seq(0)); - quasiquote(a0, seq(1)); - seq_drop_prefix(ast, 1, rest); - quasiquote(rest, seq(2)); - new_seq_obj(mal_list, seq, result); - end if; - end if; - 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 is_macro_call(ast: inout mal_val_ptr; env: inout env_ptr; is_macro: out boolean) is - variable f, env_err: mal_val_ptr; - begin - is_macro := false; - if ast.val_type = mal_list and - ast.seq_val'length > 0 and - ast.seq_val(0).val_type = mal_symbol then - env_get(env, ast.seq_val(0), f, env_err); - if env_err = null and f /= null and - f.val_type = mal_fn and f.func_val.f_is_macro then - is_macro := true; - end if; - end if; - end procedure is_macro_call; - - procedure macroexpand(in_ast: inout mal_val_ptr; env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is - variable ast, macro_fn, call_args, macro_err: mal_val_ptr; - variable is_macro: boolean; - begin - ast := in_ast; - is_macro_call(ast, env, is_macro); - while is_macro loop - env_get(env, ast.seq_val(0), macro_fn, macro_err); - seq_drop_prefix(ast, 1, call_args); - apply_func(macro_fn, call_args, ast, macro_err); - if macro_err /= null then - err := macro_err; - return; - end if; - is_macro_call(ast, env, is_macro); - end loop; - result := ast; - end procedure macroexpand; - - 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; 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); - for i in result'range loop - EVAL(ast_seq(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(ast: inout mal_val_ptr; env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is - variable key, val, eval_err, env_err: mal_val_ptr; - variable new_seq: mal_seq_ptr; - variable i: integer; - begin - case ast.val_type is - when mal_symbol => - env_get(env, ast, val, env_err); - if env_err /= null then - err := env_err; - return; - end if; - result := val; - return; - when mal_list | mal_vector | mal_hashmap => - eval_ast_seq(ast.seq_val, 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; - end procedure eval_ast; - - 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 i: integer; - variable ast, evaled_ast, a0, call_args, val, vars, sub_err, fn: mal_val_ptr; - variable env, let_env, catch_env, fn_env: env_ptr; - begin - ast := in_ast; - env := in_env; - loop - if ast.val_type /= mal_list then - eval_ast(ast, env, result, err); - return; - end if; - - macroexpand(ast, env, ast, sub_err); - if sub_err /= null then - err := sub_err; - return; - end if; - if ast.val_type /= mal_list then - eval_ast(ast, env, result, err); - return; - end if; - 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, val, sub_err); - if sub_err /= null then - err := sub_err; - return; - end if; - val.func_val.f_is_macro := true; - env_set(env, ast.seq_val(1), val); - result := val; - return; - - elsif a0.string_val.all = "macroexpand" then - macroexpand(ast.seq_val(1), env, result, err); - 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 - new_nil(result); - 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_ast(ast, env, evaled_ast, sub_err); - if sub_err /= null then - err := sub_err; - return; - end if; - seq_drop_prefix(evaled_ast, 1, call_args); - fn := evaled_ast.seq_val(0); - case fn.val_type is - when mal_nativefn => - apply_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 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) " & '"' & ")" & '"' & ")))))", 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); - RE("(def! *gensym-counter* (atom 0))", repl_env, dummy_val, err); - RE("(def! gensym (fn* [] (symbol (str " & '"' & "G__" & '"' & " (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))", repl_env, dummy_val, err); - RE("(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)))))))))", 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/vimscript/Dockerfile b/vimscript/Dockerfile deleted file mode 100644 index edb0878247..0000000000 --- a/vimscript/Dockerfile +++ /dev/null @@ -1,27 +0,0 @@ -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 -########################################################## - -# To build the readline plugin -RUN apt-get -y install g++ - -RUN apt-get -y install vim diff --git a/vimscript/Makefile b/vimscript/Makefile deleted file mode 100644 index 5062dafb31..0000000000 --- a/vimscript/Makefile +++ /dev/null @@ -1,37 +0,0 @@ -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 - -stats: $(SOURCES) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*\"|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" -stats-lisp: $(SOURCES_LISP) - @wc $^ - @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*\"|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" - -.PHONY: stats stats-lisp clean diff --git a/vimscript/core.vim b/vimscript/core.vim deleted file mode 100644 index ad88a9c673..0000000000 --- a/vimscript/core.vim +++ /dev/null @@ -1,423 +0,0 @@ -" core module - -function MalEqualQ(args) - return BoolNew(EqualQ(a:args[0], a:args[1])) -endfunction - -function MalLt(args) - return BoolNew(ObjValue(a:args[0]) < ObjValue(a:args[1])) -endfunction - -function MalLte(args) - return BoolNew(ObjValue(a:args[0]) <= ObjValue(a:args[1])) -endfunction - -function MalGt(args) - return BoolNew(ObjValue(a:args[0]) > ObjValue(a:args[1])) -endfunction - -function MalGte(args) - return BoolNew(ObjValue(a:args[0]) >= ObjValue(a:args[1])) -endfunction - -function MalAdd(args) - return IntegerNew(ObjValue(a:args[0]) + ObjValue(a:args[1])) -endfunction - -function MalSub(args) - return IntegerNew(ObjValue(a:args[0]) - ObjValue(a:args[1])) -endfunction - -function MalMul(args) - return IntegerNew(ObjValue(a:args[0]) * ObjValue(a:args[1])) -endfunction - -function MalDiv(args) - return IntegerNew(ObjValue(a:args[0]) / ObjValue(a:args[1])) -endfunction - -function MalTimeMs(args) - " vimtimems() is implemented in vimextras.c - return IntegerNew(libcallnr("libvimextras.so", "vimtimems", 0)) -endfunction - -function MalList(args) - return ListNew(a:args) -endfunction - -function MalListQ(args) - return BoolNew(ListQ(a:args[0])) -endfunction - -function MalVector(args) - return VectorNew(a:args) -endfunction - -function MalVectorQ(args) - return BoolNew(VectorQ(a:args[0])) -endfunction - -function MalSequentialQ(args) - return BoolNew(SequentialQ(a:args[0])) -endfunction - -function MalHashMap(args) - return HashBuild(a:args) -endfunction - -function MalMapQ(args) - return BoolNew(HashQ(a:args[0])) -endfunction - -function MalEmptyQ(args) - return BoolNew(EmptyQ(a:args[0])) -endfunction - -function MalCount(args) - return IntegerNew(ListCount(a:args[0])) -endfunction - -function MalAssoc(args) - let hash = copy(ObjValue(a:args[0])) - let new_elements = HashBuild(a:args[1:]) - call extend(hash, ObjValue(new_elements)) - return HashNew(hash) -endfunction - -function MalDissoc(args) - let hash = copy(ObjValue(a:args[0])) - 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 = ObjValue(a:args[0]) - 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 = ObjValue(a:args[0]) - let key = HashMakeKey(a:args[1]) - return BoolNew(has_key(hash, key)) -endfunction - -function MalKeys(args) - let listobjs = [] - for keyname in keys(ObjValue(a:args[0])) - let keyobj = HashParseKey(keyname) - call add(listobjs, keyobj) - endfor - return ListNew(listobjs) -endfunction - -function MalVals(args) - return ListNew(values(ObjValue(a:args[0]))) -endfunction - -function MalPrStr(args) - return StringNew(join(map(copy(a:args), 'PrStr(v:val, 1)'), " ")) -endfunction - -function MalStr(args) - return StringNew(join(map(copy(a:args), 'PrStr(v:val, 0)'), "")) -endfunction - -function MalPrn(args) - call PrintLn(join(map(copy(a:args), 'PrStr(v:val, 1)'), " ")) - return g:MalNil -endfunction - -function MalPrintLn(args) - call PrintLn(join(map(copy(a:args), 'PrStr(v:val, 0)'), " ")) - return g:MalNil -endfunction - -function MalReadString(args) - return ReadStr(ObjValue(a:args[0])) -endfunction - -function MalReadLine(args) - let [eof, line] = Readline(ObjValue(a:args[0])) - return eof ? g:MalNil : StringNew(line) -endfunction - -function MalSlurp(args) - let filename = ObjValue(a:args[0]) - let lines = readfile(filename, "b") - return StringNew(join(lines, "\n")) -endfunction - -function MalCons(args) - let items = copy(ObjValue(a:args[1])) - call insert(items, a:args[0]) - return ListNew(items) -endfunction - -function MalConcat(args) - let res = [] - for list in a:args - let res = res + ObjValue(list) - endfor - return ListNew(res) -endfunction - -function MalFirst(args) - return NilQ(a:args[0]) ? g:MalNil : ListFirst(a:args[0]) -endfunction - -function MalNth(args) - return ListNth(a:args[0], ObjValue(a:args[1])) -endfunction - -function MalRest(args) - return NilQ(a:args[0]) ? ListNew([]) : ListRest(a:args[0]) -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 = ObjValue(rest[-1]) - else - let funcargs = rest[:-2] + ObjValue(rest[-1]) - endif - if NativeFunctionQ(funcobj) - return NativeFuncInvoke(funcobj, ListNew(funcargs)) - elseif FunctionQ(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 ObjValue(a:args[1]) - 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 MalNilQ(args) - return BoolNew(NilQ(a:args[0])) -endfunction - -function MalTrueQ(args) - return BoolNew(TrueQ(a:args[0])) -endfunction - -function MalFalseQ(args) - return BoolNew(FalseQ(a:args[0])) -endfunction - -function MalSymbol(args) - return SymbolNew(ObjValue(a:args[0])) -endfunction - -function MalSymbolQ(args) - return BoolNew(SymbolQ(a:args[0])) -endfunction - -function MalStringQ(args) - return BoolNew(StringQ(a:args[0])) -endfunction - -function MalKeyword(args) - return KeywordNew(ObjValue(a:args[0])) -endfunction - -function MalKeywordQ(args) - return BoolNew(KeywordQ(a:args[0])) -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(ObjValue(a:vector)) - 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(ObjValue(obj)) - elseif StringQ(obj) - return ListNew(map(split(ObjValue(obj), '\zs'), 'StringNew(v:val)')) - endif - throw "seq requires string or list or vector or nil" -endfunction - -function MalMeta(args) - return ObjMeta(a:args[0]) -endfunction - -function MalWithMeta(args) - let obj = a:args[0] - return ObjNewWithMeta(ObjType(obj), copy(ObjValue(obj)), a:args[1]) -endfunction - -function MalAtom(args) - return AtomNew(a:args[0]) -endfunction - -function MalAtomQ(args) - return BoolNew(AtomQ(a:args[0])) -endfunction - -function MalDeref(args) - return ObjValue(a:args[0]) -endfunction - -function MalResetBang(args) - return ObjSetValue(a:args[0], a:args[1]) -endfunction - -function MalSwapBang(args) - let atomval = ObjValue(a:args[0]) - let funcobj = a:args[1] - let args = a:args[2:] - let res = MalApply([funcobj, ListNew([atomval] + args)]) - return ObjSetValue(a:args[0], res) -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 - -function MalVimStar(args) - let vimexpr = ObjValue(a:args[0]) - let vimres = eval(vimexpr) - return VimToMal(vimres) -endfunction - -let CoreNs = { - \ "=": NewNativeFn("MalEqualQ"), - \ "<": NewNativeFn("MalLt"), - \ "<=": NewNativeFn("MalLte"), - \ ">": NewNativeFn("MalGt"), - \ ">=": NewNativeFn("MalGte"), - \ "+": NewNativeFn("MalAdd"), - \ "-": NewNativeFn("MalSub"), - \ "*": NewNativeFn("MalMul"), - \ "/": NewNativeFn("MalDiv"), - \ "time-ms": NewNativeFn("MalTimeMs"), - \ "nil?": NewNativeFn("MalNilQ"), - \ "true?": NewNativeFn("MalTrueQ"), - \ "false?": NewNativeFn("MalFalseQ"), - \ "symbol": NewNativeFn("MalSymbol"), - \ "symbol?": NewNativeFn("MalSymbolQ"), - \ "string?": NewNativeFn("MalStringQ"), - \ "keyword": NewNativeFn("MalKeyword"), - \ "keyword?": NewNativeFn("MalKeywordQ"), - \ "list": NewNativeFn("MalList"), - \ "list?": NewNativeFn("MalListQ"), - \ "vector": NewNativeFn("MalVector"), - \ "vector?": NewNativeFn("MalVectorQ"), - \ "sequential?": NewNativeFn("MalSequentialQ"), - \ "hash-map": NewNativeFn("MalHashMap"), - \ "map?": NewNativeFn("MalMapQ"), - \ "empty?": NewNativeFn("MalEmptyQ"), - \ "count": NewNativeFn("MalCount"), - \ "assoc": NewNativeFn("MalAssoc"), - \ "dissoc": NewNativeFn("MalDissoc"), - \ "get": NewNativeFn("MalGet"), - \ "contains?": NewNativeFn("MalContainsQ"), - \ "keys": NewNativeFn("MalKeys"), - \ "vals": NewNativeFn("MalVals"), - \ "pr-str": NewNativeFn("MalPrStr"), - \ "str": NewNativeFn("MalStr"), - \ "prn": NewNativeFn("MalPrn"), - \ "println": NewNativeFn("MalPrintLn"), - \ "read-string": NewNativeFn("MalReadString"), - \ "readline": NewNativeFn("MalReadLine"), - \ "slurp": NewNativeFn("MalSlurp"), - \ "cons": NewNativeFn("MalCons"), - \ "concat": NewNativeFn("MalConcat"), - \ "first": NewNativeFn("MalFirst"), - \ "nth": NewNativeFn("MalNth"), - \ "rest": NewNativeFn("MalRest"), - \ "apply": NewNativeFn("MalApply"), - \ "map": NewNativeFn("MalMap"), - \ "throw": NewNativeFn("MalThrow"), - \ "conj": NewNativeFn("MalConj"), - \ "seq": NewNativeFn("MalSeq"), - \ "meta": NewNativeFn("MalMeta"), - \ "with-meta": NewNativeFn("MalWithMeta"), - \ "atom": NewNativeFn("MalAtom"), - \ "atom?": NewNativeFn("MalAtomQ"), - \ "deref": NewNativeFn("MalDeref"), - \ "reset!": NewNativeFn("MalResetBang"), - \ "swap!": NewNativeFn("MalSwapBang"), - \ "vim*": NewNativeFn("MalVimStar") - \ } diff --git a/vimscript/env.vim b/vimscript/env.vim deleted file mode 100644 index 4ff7dbd3ff..0000000000 --- a/vimscript/env.vim +++ /dev/null @@ -1,62 +0,0 @@ -" 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 = ObjValue(ListNth(a:binds, i)) - if varname == "&" - " TODO - let restvarname = ObjValue(ListNth(a:binds, i + 1)) - 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.find(key) dict - if has_key(self.data, a:key) - return self - elseif empty(self.outer) - return "" - else - return self.outer.find(a:key) - endif -endfunction - -function Env.set(key, value) dict - let self.data[a:key] = a:value - return a:value -endfunction - -function Env.get(key) dict - let env = self.find(a:key) - if empty(env) - throw "'" . a:key . "' not found" - endif - return env.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/vimscript/printer.vim b/vimscript/printer.vim deleted file mode 100644 index 13249da27b..0000000000 --- a/vimscript/printer.vim +++ /dev/null @@ -1,60 +0,0 @@ -" printer module - -function PrStr(ast, readable) - let obj = a:ast - let r = a:readable - if ListQ(obj) - let ret = [] - for e in ObjValue(obj) - call add(ret, PrStr(e, r)) - endfor - return "(" . join(ret, " ") . ")" - elseif VectorQ(obj) - let ret = [] - for e in ObjValue(obj) - call add(ret, PrStr(e, r)) - endfor - return "[" . join(ret, " ") . "]" - elseif HashQ(obj) - let ret = [] - for [k, v] in items(ObjValue(obj)) - 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(ObjValue(obj).params) - return "" - elseif FunctionQ(obj) - let numargs = ListCount(ObjValue(obj).params) - return "" - elseif NativeFunctionQ(obj) - let funcname = ObjValue(obj).name - return "" - elseif AtomQ(obj) - return "(atom " . PrStr(ObjValue(obj), 1) . ")" - elseif KeywordQ(obj) - return ':' . ObjValue(obj) - elseif StringQ(obj) - if r - let str = ObjValue(obj) - let str = substitute(str, '\\', '\\\\', "g") - let str = substitute(str, '"', '\\"', "g") - let str = substitute(str, "\n", '\\n', "g") - return '"' . str . '"' - else - return ObjValue(obj) - endif - elseif NilQ(obj) - return "nil" - elseif TrueQ(obj) - return "true" - elseif FalseQ(obj) - return "false" - elseif IntegerQ(obj) || FloatQ(obj) - return string(ObjValue(obj)) - else - return ObjValue(obj) - end -endfunction diff --git a/vimscript/run b/vimscript/run deleted file mode 100755 index 48e666b057..0000000000 --- a/vimscript/run +++ /dev/null @@ -1,3 +0,0 @@ -#!/bin/bash -cd $(dirname $0) -exec ./run_vimscript.sh ./${STEP:-stepA_mal}.vim "${@}" diff --git a/vimscript/step2_eval.vim b/vimscript/step2_eval.vim deleted file mode 100644 index 54f7b34ef8..0000000000 --- a/vimscript/step2_eval.vim +++ /dev/null @@ -1,103 +0,0 @@ -source readline.vim -source types.vim -source reader.vim -source printer.vim - -function READ(str) - return ReadStr(a:str) -endfunction - -function EvalAst(ast, env) - if SymbolQ(a:ast) - let varname = ObjValue(a:ast) - if !has_key(a:env, varname) - throw "'" . varname . "' not found" - end - return a:env[varname] - elseif ListQ(a:ast) - let ret = [] - for e in ObjValue(a:ast) - call add(ret, EVAL(e, a:env)) - endfor - return ListNew(ret) - elseif VectorQ(a:ast) - let ret = [] - for e in ObjValue(a:ast) - call add(ret, EVAL(e, a:env)) - endfor - return VectorNew(ret) - elseif HashQ(a:ast) - let ret = {} - for [k,v] in items(ObjValue(a:ast)) - let keyobj = HashParseKey(k) - let newkey = EVAL(keyobj, a:env) - let newval = EVAL(v, a:env) - let keystring = HashMakeKey(newkey) - let ret[keystring] = newval - endfor - return HashNew(ret) - else - return a:ast - end -endfunction - -function EVAL(ast, env) - if !ListQ(a:ast) - return EvalAst(a:ast, a:env) - end - if EmptyQ(a:ast) - return a:ast - endif - - " apply list - let el = EvalAst(a:ast, a:env) - - let Fn = ObjValue(el)[0] - return Fn(ObjValue(el)[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 - -function MalAdd(args) - return IntegerNew(ObjValue(a:args[0]) + ObjValue(a:args[1])) -endfunction - -function MalSub(args) - return IntegerNew(ObjValue(a:args[0]) - ObjValue(a:args[1])) -endfunction - -function MalMul(args) - return IntegerNew(ObjValue(a:args[0]) * ObjValue(a:args[1])) -endfunction - -function MalDiv(args) - return IntegerNew(ObjValue(a:args[0]) / ObjValue(a:args[1])) -endfunction - -let repl_env = {} -let repl_env["+"] = function("MalAdd") -let repl_env["-"] = function("MalSub") -let repl_env["*"] = function("MalMul") -let repl_env["/"] = function("MalDiv") - -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/vimscript/step3_env.vim b/vimscript/step3_env.vim deleted file mode 100644 index e8794ce536..0000000000 --- a/vimscript/step3_env.vim +++ /dev/null @@ -1,119 +0,0 @@ -source readline.vim -source types.vim -source reader.vim -source printer.vim -source env.vim - -function READ(str) - return ReadStr(a:str) -endfunction - -function EvalAst(ast, env) - if SymbolQ(a:ast) - let varname = ObjValue(a:ast) - return a:env.get(varname) - elseif ListQ(a:ast) - let ret = [] - for e in ObjValue(a:ast) - call add(ret, EVAL(e, a:env)) - endfor - return ListNew(ret) - elseif VectorQ(a:ast) - let ret = [] - for e in ObjValue(a:ast) - call add(ret, EVAL(e, a:env)) - endfor - return VectorNew(ret) - elseif HashQ(a:ast) - let ret = {} - for [k,v] in items(ObjValue(a:ast)) - let keyobj = HashParseKey(k) - let newkey = EVAL(keyobj, a:env) - let newval = EVAL(v, a:env) - let keystring = HashMakeKey(newkey) - let ret[keystring] = newval - endfor - return HashNew(ret) - else - return a:ast - end -endfunction - -function EVAL(ast, env) - if !ListQ(a:ast) - return EvalAst(a:ast, a:env) - end - if EmptyQ(a:ast) - return a:ast - endif - - let first_symbol = ObjValue(ObjValue(a:ast)[0]) - if first_symbol == "def!" - let a1 = ObjValue(a:ast)[1] - let a2 = ObjValue(a:ast)[2] - return a:env.set(ObjValue(a1), EVAL(a2, a:env)) - elseif first_symbol == "let*" - let a1 = ObjValue(a:ast)[1] - let a2 = ObjValue(a:ast)[2] - let let_env = NewEnv(a:env) - let let_binds = ObjValue(a1) - let i = 0 - while i < len(let_binds) - call let_env.set(ObjValue(let_binds[i]), EVAL(let_binds[i+1], let_env)) - let i = i + 2 - endwhile - return EVAL(a2, let_env) - else - " apply list - let el = EvalAst(a:ast, a:env) - let Fn = ObjValue(el)[0] - return Fn(ObjValue(el)[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 - -function MalAdd(args) - return IntegerNew(ObjValue(a:args[0]) + ObjValue(a:args[1])) -endfunction - -function MalSub(args) - return IntegerNew(ObjValue(a:args[0]) - ObjValue(a:args[1])) -endfunction - -function MalMul(args) - return IntegerNew(ObjValue(a:args[0]) * ObjValue(a:args[1])) -endfunction - -function MalDiv(args) - return IntegerNew(ObjValue(a:args[0]) / ObjValue(a:args[1])) -endfunction - -let repl_env = NewEnv("") -call repl_env.set("+", function("MalAdd")) -call repl_env.set("-", function("MalSub")) -call repl_env.set("*", function("MalMul")) -call repl_env.set("/", function("MalDiv")) - -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/vimscript/step4_if_fn_do.vim b/vimscript/step4_if_fn_do.vim deleted file mode 100644 index 4f10c3e6ee..0000000000 --- a/vimscript/step4_if_fn_do.vim +++ /dev/null @@ -1,131 +0,0 @@ -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 EvalAst(ast, env) - if SymbolQ(a:ast) - let varname = ObjValue(a:ast) - return a:env.get(varname) - elseif ListQ(a:ast) - let ret = [] - for e in ObjValue(a:ast) - call add(ret, EVAL(e, a:env)) - endfor - return ListNew(ret) - elseif VectorQ(a:ast) - let ret = [] - for e in ObjValue(a:ast) - call add(ret, EVAL(e, a:env)) - endfor - return VectorNew(ret) - elseif HashQ(a:ast) - let ret = {} - for [k,v] in items(ObjValue(a:ast)) - let keyobj = HashParseKey(k) - let newkey = EVAL(keyobj, a:env) - let newval = EVAL(v, a:env) - let keystring = HashMakeKey(newkey) - let ret[keystring] = newval - endfor - return HashNew(ret) - else - return a:ast - end -endfunction - -function EVAL(ast, env) - if !ListQ(a:ast) - return EvalAst(a:ast, a:env) - end - if EmptyQ(a:ast) - return a:ast - endif - - let first = ListFirst(a:ast) - let first_symbol = SymbolQ(first) ? ObjValue(first) : "" - if first_symbol == "def!" - let a1 = ObjValue(a:ast)[1] - let a2 = ObjValue(a:ast)[2] - let ret = a:env.set(ObjValue(a1), EVAL(a2, a:env)) - return ret - elseif first_symbol == "let*" - let a1 = ObjValue(a:ast)[1] - let a2 = ObjValue(a:ast)[2] - let let_env = NewEnv(a:env) - let let_binds = ObjValue(a1) - let i = 0 - while i < len(let_binds) - call let_env.set(ObjValue(let_binds[i]), EVAL(let_binds[i+1], let_env)) - let i = i + 2 - endwhile - return EVAL(a2, let_env) - elseif first_symbol == "if" - let condvalue = EVAL(ObjValue(a:ast)[1], a:env) - if FalseQ(condvalue) || NilQ(condvalue) - if len(ObjValue(a:ast)) < 4 - return g:MalNil - else - return EVAL(ObjValue(a:ast)[3], a:env) - endif - else - return EVAL(ObjValue(a:ast)[2], a:env) - endif - elseif first_symbol == "do" - let el = EvalAst(ListRest(a:ast), a:env) - return ObjValue(el)[-1] - elseif first_symbol == "fn*" - let fn = NewFn(ListNth(a:ast, 2), a:env, ListNth(a:ast, 1)) - return fn - else - " apply list - let el = EvalAst(a:ast, 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/vimscript/step5_tco.vim b/vimscript/step5_tco.vim deleted file mode 100644 index 8e9536e3ef..0000000000 --- a/vimscript/step5_tco.vim +++ /dev/null @@ -1,144 +0,0 @@ -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 EvalAst(ast, env) - if SymbolQ(a:ast) - let varname = ObjValue(a:ast) - return a:env.get(varname) - elseif ListQ(a:ast) - let ret = [] - for e in ObjValue(a:ast) - call add(ret, EVAL(e, a:env)) - endfor - return ListNew(ret) - elseif VectorQ(a:ast) - let ret = [] - for e in ObjValue(a:ast) - call add(ret, EVAL(e, a:env)) - endfor - return VectorNew(ret) - elseif HashQ(a:ast) - let ret = {} - for [k,v] in items(ObjValue(a:ast)) - let keyobj = HashParseKey(k) - let newkey = EVAL(keyobj, a:env) - let newval = EVAL(v, a:env) - let keystring = HashMakeKey(newkey) - let ret[keystring] = newval - endfor - return HashNew(ret) - else - return a:ast - end -endfunction - -function EVAL(ast, env) - let ast = a:ast - let env = a:env - - while 1 - if !ListQ(ast) - return EvalAst(ast, env) - end - if EmptyQ(ast) - return ast - endif - - let first = ListFirst(ast) - let first_symbol = SymbolQ(first) ? ObjValue(first) : "" - if first_symbol == "def!" - let a1 = ObjValue(ast)[1] - let a2 = ObjValue(ast)[2] - let ret = env.set(ObjValue(a1), EVAL(a2, env)) - return ret - elseif first_symbol == "let*" - let a1 = ObjValue(ast)[1] - let a2 = ObjValue(ast)[2] - let env = NewEnv(env) - let let_binds = ObjValue(a1) - let i = 0 - while i < len(let_binds) - call env.set(ObjValue(let_binds[i]), EVAL(let_binds[i+1], env)) - let i = i + 2 - endwhile - let ast = a2 - " TCO - elseif first_symbol == "if" - let condvalue = EVAL(ObjValue(ast)[1], env) - if FalseQ(condvalue) || NilQ(condvalue) - if len(ObjValue(ast)) < 4 - return g:MalNil - else - let ast = ObjValue(ast)[3] - endif - else - let ast = ObjValue(ast)[2] - endif - " TCO - elseif first_symbol == "do" - let astlist = ObjValue(ast) - call EvalAst(ListNew(astlist[1:-2]), env) - 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 = EvalAst(ast, env) - let funcobj = ListFirst(el) - let args = ListRest(el) - if NativeFunctionQ(funcobj) - return NativeFuncInvoke(funcobj, args) - elseif FunctionQ(funcobj) - let fn = ObjValue(funcobj) - 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/vimscript/step6_file.vim b/vimscript/step6_file.vim deleted file mode 100644 index 7cf7eec639..0000000000 --- a/vimscript/step6_file.vim +++ /dev/null @@ -1,169 +0,0 @@ -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 EvalAst(ast, env) - if SymbolQ(a:ast) - let varname = ObjValue(a:ast) - return a:env.get(varname) - elseif ListQ(a:ast) - let ret = [] - for e in ObjValue(a:ast) - call add(ret, EVAL(e, a:env)) - endfor - return ListNew(ret) - elseif VectorQ(a:ast) - let ret = [] - for e in ObjValue(a:ast) - call add(ret, EVAL(e, a:env)) - endfor - return VectorNew(ret) - elseif HashQ(a:ast) - let ret = {} - for [k,v] in items(ObjValue(a:ast)) - let keyobj = HashParseKey(k) - let newkey = EVAL(keyobj, a:env) - let newval = EVAL(v, a:env) - let keystring = HashMakeKey(newkey) - let ret[keystring] = newval - endfor - return HashNew(ret) - else - return a:ast - end -endfunction - -function EVAL(ast, env) - let ast = a:ast - let env = a:env - - while 1 - if !ListQ(ast) - return EvalAst(ast, env) - end - if EmptyQ(ast) - return ast - endif - - let first = ListFirst(ast) - let first_symbol = SymbolQ(first) ? ObjValue(first) : "" - if first_symbol == "def!" - let a1 = ObjValue(ast)[1] - let a2 = ObjValue(ast)[2] - let ret = env.set(ObjValue(a1), EVAL(a2, env)) - return ret - elseif first_symbol == "let*" - let a1 = ObjValue(ast)[1] - let a2 = ObjValue(ast)[2] - let env = NewEnv(env) - let let_binds = ObjValue(a1) - let i = 0 - while i < len(let_binds) - call env.set(ObjValue(let_binds[i]), EVAL(let_binds[i+1], env)) - let i = i + 2 - endwhile - let ast = a2 - " TCO - elseif first_symbol == "if" - let condvalue = EVAL(ObjValue(ast)[1], env) - if FalseQ(condvalue) || NilQ(condvalue) - if len(ObjValue(ast)) < 4 - return g:MalNil - else - let ast = ObjValue(ast)[3] - endif - else - let ast = ObjValue(ast)[2] - endif - " TCO - elseif first_symbol == "do" - let astlist = ObjValue(ast) - call EvalAst(ListNew(astlist[1:-2]), env) - 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 = EvalAst(ast, env) - let funcobj = ListFirst(el) - let args = ListRest(el) - if NativeFunctionQ(funcobj) - return NativeFuncInvoke(funcobj, args) - elseif FunctionQ(funcobj) - let fn = ObjValue(funcobj) - 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() - let args = argv() - let list = [] - for arg in args[1:] - call add(list, StringNew(arg)) - endfor - return ListNew(list) -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) \")\")))))", 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/vimscript/step7_quote.vim b/vimscript/step7_quote.vim deleted file mode 100644 index 390478fad0..0000000000 --- a/vimscript/step7_quote.vim +++ /dev/null @@ -1,192 +0,0 @@ -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 PairQ(obj) - return SequentialQ(a:obj) && !EmptyQ(a:obj) -endfunction - -function Quasiquote(ast) - if !PairQ(a:ast) - return ListNew([SymbolNew("quote"), a:ast]) - endif - let a0 = ListFirst(a:ast) - if SymbolQ(a0) && ObjValue(a0) == "unquote" - return ListNth(a:ast, 1) - elseif PairQ(a0) && SymbolQ(ListFirst(a0)) && ObjValue(ListFirst(a0)) == "splice-unquote" - return ListNew([SymbolNew("concat"), ListNth(a0, 1), Quasiquote(ListRest(a:ast))]) - else - return ListNew([SymbolNew("cons"), Quasiquote(a0), Quasiquote(ListRest(a:ast))]) - end -endfunction - -function EvalAst(ast, env) - if SymbolQ(a:ast) - let varname = ObjValue(a:ast) - return a:env.get(varname) - elseif ListQ(a:ast) - let ret = [] - for e in ObjValue(a:ast) - call add(ret, EVAL(e, a:env)) - endfor - return ListNew(ret) - elseif VectorQ(a:ast) - let ret = [] - for e in ObjValue(a:ast) - call add(ret, EVAL(e, a:env)) - endfor - return VectorNew(ret) - elseif HashQ(a:ast) - let ret = {} - for [k,v] in items(ObjValue(a:ast)) - let keyobj = HashParseKey(k) - let newkey = EVAL(keyobj, a:env) - let newval = EVAL(v, a:env) - let keystring = HashMakeKey(newkey) - let ret[keystring] = newval - endfor - return HashNew(ret) - else - return a:ast - end -endfunction - -function EVAL(ast, env) - let ast = a:ast - let env = a:env - - while 1 - if !ListQ(ast) - return EvalAst(ast, env) - end - if EmptyQ(ast) - return ast - endif - - let first = ListFirst(ast) - let first_symbol = SymbolQ(first) ? ObjValue(first) : "" - if first_symbol == "def!" - let a1 = ObjValue(ast)[1] - let a2 = ObjValue(ast)[2] - let ret = env.set(ObjValue(a1), EVAL(a2, env)) - return ret - elseif first_symbol == "let*" - let a1 = ObjValue(ast)[1] - let a2 = ObjValue(ast)[2] - let env = NewEnv(env) - let let_binds = ObjValue(a1) - let i = 0 - while i < len(let_binds) - call env.set(ObjValue(let_binds[i]), 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(ObjValue(ast)[1], env) - if FalseQ(condvalue) || NilQ(condvalue) - if len(ObjValue(ast)) < 4 - return g:MalNil - else - let ast = ObjValue(ast)[3] - endif - else - let ast = ObjValue(ast)[2] - endif - " TCO - elseif first_symbol == "do" - let astlist = ObjValue(ast) - call EvalAst(ListNew(astlist[1:-2]), env) - 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 = EvalAst(ast, env) - let funcobj = ListFirst(el) - let args = ListRest(el) - if NativeFunctionQ(funcobj) - return NativeFuncInvoke(funcobj, args) - elseif FunctionQ(funcobj) - let fn = ObjValue(funcobj) - 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() - let args = argv() - let list = [] - for arg in args[1:] - call add(list, StringNew(arg)) - endfor - return ListNew(list) -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) \")\")))))", 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/vimscript/step8_macros.vim b/vimscript/step8_macros.vim deleted file mode 100644 index b04d873ae6..0000000000 --- a/vimscript/step8_macros.vim +++ /dev/null @@ -1,230 +0,0 @@ -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 PairQ(obj) - return SequentialQ(a:obj) && !EmptyQ(a:obj) -endfunction - -function Quasiquote(ast) - if !PairQ(a:ast) - return ListNew([SymbolNew("quote"), a:ast]) - endif - let a0 = ListFirst(a:ast) - if SymbolQ(a0) && ObjValue(a0) == "unquote" - return ListNth(a:ast, 1) - elseif PairQ(a0) && SymbolQ(ListFirst(a0)) && ObjValue(ListFirst(a0)) == "splice-unquote" - return ListNew([SymbolNew("concat"), ListNth(a0, 1), Quasiquote(ListRest(a:ast))]) - else - return ListNew([SymbolNew("cons"), Quasiquote(a0), Quasiquote(ListRest(a:ast))]) - end -endfunction - -function IsMacroCall(ast, env) - if !ListQ(a:ast) - return 0 - endif - let a0 = ListFirst(a:ast) - if !SymbolQ(a0) - return 0 - endif - let macroname = ObjValue(a0) - if empty(a:env.find(macroname)) - return 0 - endif - return MacroQ(a:env.get(macroname)) -endfunction - -function MacroExpand(ast, env) - let ast = a:ast - while IsMacroCall(ast, a:env) - let macroobj = a:env.get(ObjValue(ListFirst(ast))) - let macroargs = ListRest(ast) - let ast = FuncInvoke(macroobj, macroargs) - endwhile - return ast -endfunction - -function EvalAst(ast, env) - if SymbolQ(a:ast) - let varname = ObjValue(a:ast) - return a:env.get(varname) - elseif ListQ(a:ast) - let ret = [] - for e in ObjValue(a:ast) - call add(ret, EVAL(e, a:env)) - endfor - return ListNew(ret) - elseif VectorQ(a:ast) - let ret = [] - for e in ObjValue(a:ast) - call add(ret, EVAL(e, a:env)) - endfor - return VectorNew(ret) - elseif HashQ(a:ast) - let ret = {} - for [k,v] in items(ObjValue(a:ast)) - let keyobj = HashParseKey(k) - let newkey = EVAL(keyobj, a:env) - let newval = EVAL(v, a:env) - let keystring = HashMakeKey(newkey) - let ret[keystring] = newval - endfor - return HashNew(ret) - else - return a:ast - end -endfunction - -function EVAL(ast, env) - let ast = a:ast - let env = a:env - - while 1 - if !ListQ(ast) - return EvalAst(ast, env) - end - - let ast = MacroExpand(ast, env) - if !ListQ(ast) - return EvalAst(ast, env) - end - if EmptyQ(ast) - return ast - endif - - let first = ListFirst(ast) - let first_symbol = SymbolQ(first) ? ObjValue(first) : "" - if first_symbol == "def!" - let a1 = ObjValue(ast)[1] - let a2 = ObjValue(ast)[2] - return env.set(ObjValue(a1), EVAL(a2, env)) - elseif first_symbol == "let*" - let a1 = ObjValue(ast)[1] - let a2 = ObjValue(ast)[2] - let env = NewEnv(env) - let let_binds = ObjValue(a1) - let i = 0 - while i < len(let_binds) - call env.set(ObjValue(let_binds[i]), 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(ObjValue(a1), macro) - elseif first_symbol == "macroexpand" - return MacroExpand(ListNth(ast, 1), env) - elseif first_symbol == "if" - let condvalue = EVAL(ObjValue(ast)[1], env) - if FalseQ(condvalue) || NilQ(condvalue) - if len(ObjValue(ast)) < 4 - return g:MalNil - else - let ast = ObjValue(ast)[3] - endif - else - let ast = ObjValue(ast)[2] - endif - " TCO - elseif first_symbol == "do" - let astlist = ObjValue(ast) - call EvalAst(ListNew(astlist[1:-2]), env) - 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 = EvalAst(ast, env) - let funcobj = ListFirst(el) - let args = ListRest(el) - if NativeFunctionQ(funcobj) - return NativeFuncInvoke(funcobj, args) - elseif FunctionQ(funcobj) - let fn = ObjValue(funcobj) - 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() - let args = argv() - let list = [] - for arg in args[1:] - call add(list, StringNew(arg)) - endfor - return ListNew(list) -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) \")\")))))", 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) -call 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))))))))", 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/vimscript/step9_try.vim b/vimscript/step9_try.vim deleted file mode 100644 index d74bda1447..0000000000 --- a/vimscript/step9_try.vim +++ /dev/null @@ -1,266 +0,0 @@ -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 PairQ(obj) - return SequentialQ(a:obj) && !EmptyQ(a:obj) -endfunction - -function Quasiquote(ast) - if !PairQ(a:ast) - return ListNew([SymbolNew("quote"), a:ast]) - endif - let a0 = ListFirst(a:ast) - if SymbolQ(a0) && ObjValue(a0) == "unquote" - return ListNth(a:ast, 1) - elseif PairQ(a0) && SymbolQ(ListFirst(a0)) && ObjValue(ListFirst(a0)) == "splice-unquote" - return ListNew([SymbolNew("concat"), ListNth(a0, 1), Quasiquote(ListRest(a:ast))]) - else - return ListNew([SymbolNew("cons"), Quasiquote(a0), Quasiquote(ListRest(a:ast))]) - end -endfunction - -function IsMacroCall(ast, env) - if !ListQ(a:ast) - return 0 - endif - let a0 = ListFirst(a:ast) - if !SymbolQ(a0) - return 0 - endif - let macroname = ObjValue(a0) - if empty(a:env.find(macroname)) - return 0 - endif - return MacroQ(a:env.get(macroname)) -endfunction - -function MacroExpand(ast, env) - let ast = a:ast - while IsMacroCall(ast, a:env) - let macroobj = a:env.get(ObjValue(ListFirst(ast))) - let macroargs = ListRest(ast) - let ast = FuncInvoke(macroobj, macroargs) - endwhile - return ast -endfunction - -function EvalAst(ast, env) - if SymbolQ(a:ast) - let varname = ObjValue(a:ast) - return a:env.get(varname) - elseif ListQ(a:ast) - let ret = [] - for e in ObjValue(a:ast) - call add(ret, EVAL(e, a:env)) - endfor - return ListNew(ret) - elseif VectorQ(a:ast) - let ret = [] - for e in ObjValue(a:ast) - call add(ret, EVAL(e, a:env)) - endfor - return VectorNew(ret) - elseif HashQ(a:ast) - let ret = {} - for [k,v] in items(ObjValue(a:ast)) - let keyobj = HashParseKey(k) - let newkey = EVAL(keyobj, a:env) - let newval = EVAL(v, a:env) - let keystring = HashMakeKey(newkey) - let ret[keystring] = newval - endfor - return HashNew(ret) - else - return a:ast - end -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 - if !ListQ(ast) - return EvalAst(ast, env) - end - - let ast = MacroExpand(ast, env) - if !ListQ(ast) - return EvalAst(ast, env) - end - if EmptyQ(ast) - return ast - endif - - let first = ListFirst(ast) - let first_symbol = SymbolQ(first) ? ObjValue(first) : "" - if first_symbol == "def!" - let a1 = ObjValue(ast)[1] - let a2 = ObjValue(ast)[2] - return env.set(ObjValue(a1), EVAL(a2, env)) - elseif first_symbol == "let*" - let a1 = ObjValue(ast)[1] - let a2 = ObjValue(ast)[2] - let env = NewEnv(env) - let let_binds = ObjValue(a1) - let i = 0 - while i < len(let_binds) - call env.set(ObjValue(let_binds[i]), 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(ObjValue(a1), macro) - elseif first_symbol == "macroexpand" - return MacroExpand(ListNth(ast, 1), env) - elseif first_symbol == "if" - let condvalue = EVAL(ObjValue(ast)[1], env) - if FalseQ(condvalue) || NilQ(condvalue) - if len(ObjValue(ast)) < 4 - return g:MalNil - else - let ast = ObjValue(ast)[3] - endif - else - let ast = ObjValue(ast)[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 = ObjValue(ListNth(catch_clause, 1)) - 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 = ObjValue(ast) - call EvalAst(ListNew(astlist[1:-2]), env) - 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 = EvalAst(ast, env) - let funcobj = ListFirst(el) - let args = ListRest(el) - if NativeFunctionQ(funcobj) - return NativeFuncInvoke(funcobj, args) - elseif FunctionQ(funcobj) - let fn = ObjValue(funcobj) - 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() - let args = argv() - let list = [] - for arg in args[1:] - call add(list, StringNew(arg)) - endfor - return ListNew(list) -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) \")\")))))", 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) -call 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))))))))", 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 - call PrintLn("Error: " . v:exception) - endtry -endwhile -qall! diff --git a/vimscript/stepA_mal.vim b/vimscript/stepA_mal.vim deleted file mode 100644 index 15c919d3cb..0000000000 --- a/vimscript/stepA_mal.vim +++ /dev/null @@ -1,271 +0,0 @@ -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 PairQ(obj) - return SequentialQ(a:obj) && !EmptyQ(a:obj) -endfunction - -function Quasiquote(ast) - if !PairQ(a:ast) - return ListNew([SymbolNew("quote"), a:ast]) - endif - let a0 = ListFirst(a:ast) - if SymbolQ(a0) && ObjValue(a0) == "unquote" - return ListNth(a:ast, 1) - elseif PairQ(a0) && SymbolQ(ListFirst(a0)) && ObjValue(ListFirst(a0)) == "splice-unquote" - return ListNew([SymbolNew("concat"), ListNth(a0, 1), Quasiquote(ListRest(a:ast))]) - else - return ListNew([SymbolNew("cons"), Quasiquote(a0), Quasiquote(ListRest(a:ast))]) - end -endfunction - -function IsMacroCall(ast, env) - if !ListQ(a:ast) - return 0 - endif - let a0 = ListFirst(a:ast) - if !SymbolQ(a0) - return 0 - endif - let macroname = ObjValue(a0) - if empty(a:env.find(macroname)) - return 0 - endif - return MacroQ(a:env.get(macroname)) -endfunction - -function MacroExpand(ast, env) - let ast = a:ast - while IsMacroCall(ast, a:env) - let macroobj = a:env.get(ObjValue(ListFirst(ast))) - let macroargs = ListRest(ast) - let ast = FuncInvoke(macroobj, macroargs) - endwhile - return ast -endfunction - -function EvalAst(ast, env) - if SymbolQ(a:ast) - let varname = ObjValue(a:ast) - return a:env.get(varname) - elseif ListQ(a:ast) - let ret = [] - for e in ObjValue(a:ast) - call add(ret, EVAL(e, a:env)) - endfor - return ListNew(ret) - elseif VectorQ(a:ast) - let ret = [] - for e in ObjValue(a:ast) - call add(ret, EVAL(e, a:env)) - endfor - return VectorNew(ret) - elseif HashQ(a:ast) - let ret = {} - for [k,v] in items(ObjValue(a:ast)) - let keyobj = HashParseKey(k) - let newkey = EVAL(keyobj, a:env) - let newval = EVAL(v, a:env) - let keystring = HashMakeKey(newkey) - let ret[keystring] = newval - endfor - return HashNew(ret) - else - return a:ast - end -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 - if !ListQ(ast) - return EvalAst(ast, env) - end - - let ast = MacroExpand(ast, env) - if !ListQ(ast) - return EvalAst(ast, env) - end - if EmptyQ(ast) - return ast - endif - - let first = ListFirst(ast) - let first_symbol = SymbolQ(first) ? ObjValue(first) : "" - if first_symbol == "def!" - let a1 = ObjValue(ast)[1] - let a2 = ObjValue(ast)[2] - return env.set(ObjValue(a1), EVAL(a2, env)) - elseif first_symbol == "let*" - let a1 = ObjValue(ast)[1] - let a2 = ObjValue(ast)[2] - let env = NewEnv(env) - let let_binds = ObjValue(a1) - let i = 0 - while i < len(let_binds) - call env.set(ObjValue(let_binds[i]), 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(ObjValue(a1), macro) - elseif first_symbol == "macroexpand" - return MacroExpand(ListNth(ast, 1), env) - elseif first_symbol == "if" - let condvalue = EVAL(ObjValue(ast)[1], env) - if FalseQ(condvalue) || NilQ(condvalue) - if len(ObjValue(ast)) < 4 - return g:MalNil - else - let ast = ObjValue(ast)[3] - endif - else - let ast = ObjValue(ast)[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 = ObjValue(ListNth(catch_clause, 1)) - 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 = ObjValue(ast) - call EvalAst(ListNew(astlist[1:-2]), env) - 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 = EvalAst(ast, env) - let funcobj = ListFirst(el) - let args = ListRest(el) - if NativeFunctionQ(funcobj) - return NativeFuncInvoke(funcobj, args) - elseif FunctionQ(funcobj) - let fn = ObjValue(funcobj) - 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() - let args = argv() - let list = [] - for arg in args[1:] - call add(list, StringNew(arg)) - endfor - return ListNew(list) -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) \")\")))))", 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) -call RE("(def! *gensym-counter* (atom 0))", repl_env) -call RE("(def! gensym (fn* [] (symbol (str \"G__\" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))", repl_env) -call RE("(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)))))))))", 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 - call PrintLn("Error: " . v:exception) - endtry -endwhile -qall! diff --git a/vimscript/tests/stepA_mal.mal b/vimscript/tests/stepA_mal.mal deleted file mode 100644 index 4cc645a303..0000000000 --- a/vimscript/tests/stepA_mal.mal +++ /dev/null @@ -1,41 +0,0 @@ -;; 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 704 for Vim 7.4 -(> (vim* "v:version") 700) -;=>true diff --git a/vimscript/types.vim b/vimscript/types.vim deleted file mode 100644 index b2480a8946..0000000000 --- a/vimscript/types.vim +++ /dev/null @@ -1,286 +0,0 @@ -" 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 ObjType(obj) - return a:obj["type"] -endfunction - -function ObjValue(obj) - return a:obj["val"] -endfunction - -function ObjHasMeta(obj) - return ObjQ(a:obj) && 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 ObjQ(obj) - return type(a:obj) == type({}) -endfunction - -function SymbolQ(obj) - return ObjQ(a:obj) && ObjType(a:obj) == "symbol" -endfunction - -function StringQ(obj) - return ObjQ(a:obj) && ObjType(a:obj) == "string" -endfunction - -function KeywordQ(obj) - return ObjQ(a:obj) && ObjType(a:obj) == "keyword" -endfunction - -function AtomQ(obj) - return ObjQ(a:obj) && ObjType(a:obj) == "atom" -endfunction - -function NilQ(obj) - return ObjQ(a:obj) && ObjType(a:obj) == "nil" -endfunction - -function TrueQ(obj) - return ObjQ(a:obj) && ObjType(a:obj) == "true" -endfunction - -function FalseQ(obj) - return ObjQ(a:obj) && ObjType(a:obj) == "false" -endfunction - -function IntegerQ(obj) - return ObjQ(a:obj) && ObjType(a:obj) == "integer" -endfunction - -function FloatQ(obj) - return ObjQ(a:obj) && ObjType(a:obj) == "float" -endfunction - -function ListQ(obj) - return ObjQ(a:obj) && ObjType(a:obj) == "list" -endfunction - -function VectorQ(obj) - return ObjQ(a:obj) && ObjType(a:obj) == "vector" -endfunction - -function SequentialQ(obj) - return ObjQ(a:obj) && ListQ(a:obj) || VectorQ(a:obj) -endfunction - -function HashQ(obj) - return ObjQ(a:obj) && ObjType(a:obj) == "hash" -endfunction - -function FunctionQ(obj) - return ObjQ(a:obj) && ObjType(a:obj) == "function" && !ObjValue(a:obj).is_macro -endfunction - -function MacroQ(obj) - return ObjQ(a:obj) && ObjType(a:obj) == "function" && ObjValue(a:obj).is_macro -endfunction - -function NativeFunctionQ(obj) - return ObjQ(a:obj) && ObjType(a:obj) == "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: " . ObjType(a:obj)); - endif - return ObjType(a:obj) . "#" . ObjValue(a:obj) -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(ObjValue(a:x)) != len(ObjValue(a:y)) - return 0 - endif - for k in keys(ObjValue(a:x)) - let vx = ObjValue(a:x)[k] - let vy = ObjValue(a:y)[k] - if empty(vy) || !EqualQ(vx, vy) - return 0 - endif - endfor - return 1 -endfunction - -function SequentialEqualQ(x, y) - if len(ObjValue(a:x)) != len(ObjValue(a:y)) - return 0 - endif - let i = 0 - while i < len(ObjValue(a:x)) - let ex = ObjValue(a:x)[i] - let ey = ObjValue(a:y)[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 ObjType(a:x) != ObjType(a:y) - return 0 - else - return ObjValue(a:x) == ObjValue(a:y) - endif -endfunction - -function EmptyQ(list) - return empty(ObjValue(a:list)) -endfunction - -function ListCount(list) - return len(ObjValue(a:list)) -endfunction - -function ListNth(list, index) - if a:index >= len(ObjValue(a:list)) - throw "nth: index out of range" - endif - return ObjValue(a:list)[a:index] -endfunction - -function ListFirst(list) - return get(ObjValue(a:list), 0, g:MalNil) -endfunction - -function ListDrop(list, drop_elements) - return ListNew(ObjValue(a:list)[a:drop_elements :]) -endfunction - -function ListRest(list) - return ListDrop(a:list, 1) -endfunction - -function FuncInvoke(funcobj, args) - let fn = ObjValue(a:funcobj) - let funcenv = NewEnvWithBinds(fn.env, fn.params, a:args) - return EVAL(fn.ast, funcenv) -endfunction - -function NativeFuncInvoke(funcobj, argslist) - let fn = ObjValue(a:funcobj) - return fn.Func(ObjValue(a:argslist)) -endfunction - -function MarkAsMacro(funcobj) - let fn = ObjValue(a:funcobj) - let fn.is_macro = 1 - return a:funcobj -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 - -let g:MalNil = NilNew() -let g:MalTrue = TrueNew() -let g:MalFalse = FalseNew() 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)
-

Mal

- -

Mal Web REPL

- - - -
-
-
-
- -

 

-
- - -
- -
-

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...)
-
-
- -
- - - -