From 96e6d9c81a0a85b38b72a3772803b47751e11adb Mon Sep 17 00:00:00 2001 From: Joel Martin Date: Tue, 30 Jul 2024 14:08:50 -0500 Subject: [PATCH 01/32] Don't pass MAKE into dockerized calls. The outer and inner MAKE path may be unrelated. --- Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 7d47ad44fb..7cfd86809d 100644 --- a/Makefile +++ b/Makefile @@ -143,7 +143,7 @@ get_build_command = $(strip $(foreach mode,$(1)_MODE, \ $(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)),) \ ,\ $(MAKE) $(if $(strip $($(mode))),$(mode)=$($(mode)),) -C impls/$(impl)))) From 78d6dabcaf9327d4492ce79032a0226642fd61eb Mon Sep 17 00:00:00 2001 From: Joel Martin Date: Wed, 31 Jul 2024 13:22:46 -0500 Subject: [PATCH 02/32] Makefile,ci.sh: use versioned images Get a voom style git hash of the impl Dockerfile and use that as the testing docker image version (rather than blank which implies "latest"). --- .github/workflows/main.yml | 2 ++ Makefile | 2 +- ci.sh | 3 ++- voom-like-version.sh | 3 +++ 4 files changed, 8 insertions(+), 2 deletions(-) create mode 100755 voom-like-version.sh diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 1bd6ad7bf4..5eaaf1dfe9 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -38,6 +38,8 @@ jobs: matrix: ${{ fromJson(needs.get-matrix.outputs.matrix-linux) }} steps: - uses: actions/checkout@v2 + with: + fetch-depth: 0 # Need full history for voom like versions - name: Build run: | export ${{ matrix.IMPL }} diff --git a/Makefile b/Makefile index 7cfd86809d..acad2220d6 100644 --- a/Makefile +++ b/Makefile @@ -126,7 +126,7 @@ STEP_TEST_FILES = $(strip $(wildcard \ # 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 = kanaka/mal-test-$(call lc,$(1)):$(shell ./voom-like-version.sh impls/$(1)/Dockerfile) actual_impl = $(if $(filter mal,$(1)),$(patsubst %-mal,%,$(MAL_IMPL)),$(1)) diff --git a/ci.sh b/ci.sh index 400045fbeb..5885ae6772 100755 --- a/ci.sh +++ b/ci.sh @@ -52,9 +52,10 @@ echo "TEST_OPTS: ${TEST_OPTS}" # the Travis/Github Actions image/tools directly. if [ -z "${NO_DOCKER}" ]; then img_impl=$(echo "${MAL_IMPL:-${IMPL}}" | tr '[:upper:]' '[:lower:]') + img_ver=$(./voom-like-version.sh impls/${img_impl}/Dockerfile) # 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 kanaka/mal-test-${img_impl%%-mal} ${MAKE}" + MAKE="docker run -i -u $(id -u) -v `pwd`:/mal kanaka/mal-test-${img_impl%%-mal}:${img_ver} ${MAKE}" fi case "${ACTION}" in 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) From 8f8608a989440ddeb9f555cc9b2108a486f669e0 Mon Sep 17 00:00:00 2001 From: Joel Martin Date: Wed, 31 Jul 2024 13:24:34 -0500 Subject: [PATCH 03/32] ci.sh/GHA: Add docker-build-push step/action A major maintainability issue for years has been that the CI assumes that a docker image for the implementation exists in Docker's registry (named kanaka/mal-test-IMPL). This means the upstream maintainers have to be involved in the PR loop to build the implementation Dockerfile, push to the docker registry and then have the PR submitter re-run CI. To address this, in ci.sh, the docker-build-push action will try to pull the image and then continue as normal. If the pull fails then it will build the image and push it (if the build is running in the context of the upstream repo's main branch) and then continue. Also, this switches to using ghcr.io as the default repo for images which will make image transfer more local (during CI) and hopefully a fair bit faster (and avoid potential docker pull limits). Add a steps to the GHA main workflow that do a docker login to ghcr.io and then call `ci.sh docker-build-push ${IMPL}`. --- .github/workflows/main.yml | 10 ++++++++++ Makefile | 2 +- ci.sh | 38 +++++++++++++++++++++++++------------- 3 files changed, 36 insertions(+), 14 deletions(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 5eaaf1dfe9..2f02826622 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -40,6 +40,16 @@ jobs: - uses: actions/checkout@v2 with: fetch-depth: 0 # Need full history for voom like versions + - name: Log in to GitHub Container Registry + uses: docker/login-action@v2 + 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 }} diff --git a/Makefile b/Makefile index acad2220d6..ff1cd7a643 100644 --- a/Makefile +++ b/Makefile @@ -126,7 +126,7 @@ STEP_TEST_FILES = $(strip $(wildcard \ # 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)):$(shell ./voom-like-version.sh impls/$(1)/Dockerfile) +impl_to_image = ghcr.io/kanaka/mal-test-$(call lc,$(1)):$(shell ./voom-like-version.sh impls/$(1)/Dockerfile) actual_impl = $(if $(filter mal,$(1)),$(patsubst %-mal,%,$(MAL_IMPL)),$(1)) diff --git a/ci.sh b/ci.sh index 5885ae6772..ff096ed0b0 100755 --- a/ci.sh +++ b/ci.sh @@ -1,4 +1,4 @@ -#!/bin/bash +#!/usr/bin/env bash set -ex @@ -24,11 +24,23 @@ mode_var=${raw_mode_var/-/__} mode_var=${mode_var/./__} mode_val=${!mode_var} -MAKE="make ${mode_val:+${mode_var}=${mode_val}}" - log_prefix="${ACTION}${REGRESS:+-regress}-${IMPL}${mode_val:+-${mode_val}}${MAL_IMPL:+-${MAL_IMPL}}" TEST_OPTS="${TEST_OPTS} --debug-file ../../${log_prefix}.debug" +img_base="${MAL_IMPL:-${IMPL}}" +img_impl="${img_base%%-mal}" +img_name="mal-test-${img_impl,,}" +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) @@ -47,18 +59,18 @@ echo "IMPL: ${IMPL}" echo "BUILD_IMPL: ${BUILD_IMPL}" echo "MAL_IMPL: ${MAL_IMPL}" echo "TEST_OPTS: ${TEST_OPTS}" - -# If NO_DOCKER is blank then launch use a docker image, otherwise use -# the Travis/Github Actions image/tools directly. -if [ -z "${NO_DOCKER}" ]; then - img_impl=$(echo "${MAL_IMPL:-${IMPL}}" | tr '[:upper:]' '[:lower:]') - img_ver=$(./voom-like-version.sh impls/${img_impl}/Dockerfile) - # 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 kanaka/mal-test-${img_impl%%-mal}:${img_ver} ${MAKE}" -fi +echo "IMAGE: ${IMAGE}" +echo "MAKE: ${MAKE}" case "${ACTION}" in +docker-build-push) + if ! docker pull ${IMAGE}; then + make "docker-build^${MAL_IMPL:-${IMPL}}" + if [ "${GITHUB_REF}" = "refs/heads/main" ]; then + docker push ${IMAGE} + fi + fi + ;; build) # rpython often fails on step9 in compute_vars_longevity # so build step9, then continue with the full build From eef959fb82f57f6899a149aa1f5f70caa5324d9e Mon Sep 17 00:00:00 2001 From: Joel Martin Date: Wed, 31 Jul 2024 14:04:04 -0500 Subject: [PATCH 04/32] Update get-changed-files action to v2. --- .github/workflows/main.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 2f02826622..7fee4ef20a 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -22,7 +22,7 @@ jobs: - uses: actions/checkout@v2 - id: files if: ${{ github.event_name != 'workflow_dispatch' }} - uses: kanaka/get-changed-files@v1 + uses: kanaka/get-changed-files@v2 - id: get-matrix-step run: | export OVERRIDE_IMPLS="${{ github.event.inputs.impls }}" # " From 0a3496869584c4108b3b5abacc1a3c09bdd12027 Mon Sep 17 00:00:00 2001 From: Joel Martin Date: Wed, 31 Jul 2024 14:24:37 -0500 Subject: [PATCH 05/32] GHA: Update macos image version from 10.15 to 12 10.15 has been removed since Aug 2022 and 11 has also been removed. --- .github/workflows/main.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 7fee4ef20a..08689b304e 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -77,7 +77,7 @@ jobs: macos: needs: get-matrix if: ${{ needs.get-matrix.outputs.do-macos == 'true' }} - runs-on: macos-10.15 + runs-on: macos-12 strategy: fail-fast: false matrix: ${{ fromJson(needs.get-matrix.outputs.matrix-macos) }} From 7a2bc6f066edeb7bd29e2cb73ad2dc562b04ed5d Mon Sep 17 00:00:00 2001 From: Joel Martin Date: Wed, 31 Jul 2024 16:31:24 -0500 Subject: [PATCH 06/32] Update Dockerfiles using ubuntu:vivid to xenial. vivid packages are no longer available. There are still implementations that use vivid because updating to xenial was not sufficient to get them working again. --- impls/ada/Dockerfile | 2 +- impls/awk/Dockerfile | 2 +- impls/bash/Dockerfile | 2 +- impls/common-lisp/Dockerfile | 2 +- impls/forth/Dockerfile | 2 +- impls/io/Dockerfile | 2 +- impls/make/Dockerfile | 2 +- impls/objpascal/Dockerfile | 2 +- impls/ocaml/Dockerfile | 2 +- impls/perl/Dockerfile | 2 +- impls/ps/Dockerfile | 2 +- impls/python/Dockerfile | 2 +- impls/r/Dockerfile | 2 +- impls/racket/Dockerfile | 2 +- impls/tcl/Dockerfile | 2 +- 15 files changed, 15 insertions(+), 15 deletions(-) diff --git a/impls/ada/Dockerfile b/impls/ada/Dockerfile index 5eb272abe0..fc1be57bca 100755 --- a/impls/ada/Dockerfile +++ b/impls/ada/Dockerfile @@ -1,4 +1,4 @@ -FROM ubuntu:vivid +FROM ubuntu:xenial MAINTAINER Joel Martin ########################################################## diff --git a/impls/awk/Dockerfile b/impls/awk/Dockerfile index 9d0e12cee1..46b05567a9 100644 --- a/impls/awk/Dockerfile +++ b/impls/awk/Dockerfile @@ -1,4 +1,4 @@ -FROM ubuntu:vivid +FROM ubuntu:xenial MAINTAINER Joel Martin ########################################################## diff --git a/impls/bash/Dockerfile b/impls/bash/Dockerfile index 71720eb5e5..81eba8836a 100644 --- a/impls/bash/Dockerfile +++ b/impls/bash/Dockerfile @@ -1,4 +1,4 @@ -FROM ubuntu:vivid +FROM ubuntu:xenial MAINTAINER Joel Martin ########################################################## diff --git a/impls/common-lisp/Dockerfile b/impls/common-lisp/Dockerfile index 447f413bbb..7b43e47f02 100644 --- a/impls/common-lisp/Dockerfile +++ b/impls/common-lisp/Dockerfile @@ -1,4 +1,4 @@ -FROM ubuntu:vivid +FROM ubuntu:xenial MAINTAINER Joel Martin ########################################################## diff --git a/impls/forth/Dockerfile b/impls/forth/Dockerfile index c84caec2c4..4a0be33d86 100644 --- a/impls/forth/Dockerfile +++ b/impls/forth/Dockerfile @@ -1,4 +1,4 @@ -FROM ubuntu:vivid +FROM ubuntu:xenial MAINTAINER Joel Martin ########################################################## diff --git a/impls/io/Dockerfile b/impls/io/Dockerfile index e93a326434..beeb46b03c 100644 --- a/impls/io/Dockerfile +++ b/impls/io/Dockerfile @@ -1,4 +1,4 @@ -FROM ubuntu:vivid +FROM ubuntu:xenial MAINTAINER Joel Martin ########################################################## diff --git a/impls/make/Dockerfile b/impls/make/Dockerfile index 5f61062ee3..457f951968 100644 --- a/impls/make/Dockerfile +++ b/impls/make/Dockerfile @@ -1,4 +1,4 @@ -FROM ubuntu:vivid +FROM ubuntu:xenial MAINTAINER Joel Martin ########################################################## diff --git a/impls/objpascal/Dockerfile b/impls/objpascal/Dockerfile index 31bb193b10..7173442f3d 100644 --- a/impls/objpascal/Dockerfile +++ b/impls/objpascal/Dockerfile @@ -1,4 +1,4 @@ -FROM ubuntu:vivid +FROM ubuntu:xenial MAINTAINER Joel Martin ########################################################## diff --git a/impls/ocaml/Dockerfile b/impls/ocaml/Dockerfile index 399553dbc3..2d8a83da24 100644 --- a/impls/ocaml/Dockerfile +++ b/impls/ocaml/Dockerfile @@ -1,4 +1,4 @@ -[FROM ubuntu:vivid +FROM ubuntu:xenial MAINTAINER Joel Martin ########################################################## diff --git a/impls/perl/Dockerfile b/impls/perl/Dockerfile index b36833e072..24fd51c4c1 100644 --- a/impls/perl/Dockerfile +++ b/impls/perl/Dockerfile @@ -1,4 +1,4 @@ -FROM ubuntu:vivid +FROM ubuntu:xenial MAINTAINER Joel Martin ########################################################## diff --git a/impls/ps/Dockerfile b/impls/ps/Dockerfile index d91f68e1ea..a57b968803 100644 --- a/impls/ps/Dockerfile +++ b/impls/ps/Dockerfile @@ -1,4 +1,4 @@ -FROM ubuntu:vivid +FROM ubuntu:xenial MAINTAINER Joel Martin ########################################################## diff --git a/impls/python/Dockerfile b/impls/python/Dockerfile index 3e64cc116c..623eb4c9cb 100644 --- a/impls/python/Dockerfile +++ b/impls/python/Dockerfile @@ -1,4 +1,4 @@ -FROM ubuntu:vivid +FROM ubuntu:xenial MAINTAINER Joel Martin ########################################################## diff --git a/impls/r/Dockerfile b/impls/r/Dockerfile index 42611aeca2..0d19cecbe8 100644 --- a/impls/r/Dockerfile +++ b/impls/r/Dockerfile @@ -1,4 +1,4 @@ -FROM ubuntu:vivid +FROM ubuntu:xenial MAINTAINER Joel Martin ########################################################## diff --git a/impls/racket/Dockerfile b/impls/racket/Dockerfile index 1b05ee258b..cb97d4656b 100644 --- a/impls/racket/Dockerfile +++ b/impls/racket/Dockerfile @@ -1,4 +1,4 @@ -FROM ubuntu:vivid +FROM ubuntu:xenial MAINTAINER Joel Martin ########################################################## diff --git a/impls/tcl/Dockerfile b/impls/tcl/Dockerfile index 2ad3f330c3..337d63c7c5 100644 --- a/impls/tcl/Dockerfile +++ b/impls/tcl/Dockerfile @@ -1,4 +1,4 @@ -FROM ubuntu:vivid +FROM ubuntu:xenial MAINTAINER Joel Martin ########################################################## From 3e90e42e94ef609e1164e0734e60b4dd068b170d Mon Sep 17 00:00:00 2001 From: Joel Martin Date: Thu, 1 Aug 2024 12:40:45 -0500 Subject: [PATCH 07/32] GHA: Update to ubuntu-24.04 runner/image. --- .github/workflows/main.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 08689b304e..dae7881987 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -12,7 +12,7 @@ on: jobs: get-matrix: - runs-on: ubuntu-20.04 + runs-on: ubuntu-24.04 outputs: do-linux: ${{ steps.get-matrix-step.outputs.do-linux }} matrix-linux: ${{ steps.get-matrix-step.outputs.linux }} @@ -32,7 +32,7 @@ jobs: linux: needs: get-matrix if: ${{ needs.get-matrix.outputs.do-linux == 'true' }} - runs-on: ubuntu-20.04 + runs-on: ubuntu-24.04 strategy: fail-fast: false matrix: ${{ fromJson(needs.get-matrix.outputs.matrix-linux) }} From 7d497976978634f610c7023893f869f1cbd4b741 Mon Sep 17 00:00:00 2001 From: Joel Martin Date: Thu, 1 Aug 2024 13:20:58 -0500 Subject: [PATCH 08/32] ada: Dockerfile labels for repo linkage/visibility --- impls/ada/Dockerfile | 2 ++ 1 file changed, 2 insertions(+) diff --git a/impls/ada/Dockerfile b/impls/ada/Dockerfile index fc1be57bca..392e20fd83 100755 --- a/impls/ada/Dockerfile +++ b/impls/ada/Dockerfile @@ -1,5 +1,7 @@ FROM ubuntu:xenial 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 From 5c979b5a19de8e5e72358f0f5f87e48c58caaa3c Mon Sep 17 00:00:00 2001 From: Joel Martin Date: Thu, 1 Aug 2024 13:32:33 -0500 Subject: [PATCH 09/32] GHA: add packages write permission. --- .github/workflows/main.yml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index dae7881987..e2500eb8bb 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -1,5 +1,9 @@ name: Build and Test +permissions: + contents: read + packages: write + on: push: {} pull_request: {} From 69e570aeca0b7b2d3c1497d8120555920ad64a52 Mon Sep 17 00:00:00 2001 From: Joel Martin Date: Thu, 1 Aug 2024 14:21:45 -0500 Subject: [PATCH 10/32] GHA: Update versions of checkout/artifact/login actions --- .github/workflows/main.yml | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index e2500eb8bb..dc4189047f 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -23,7 +23,7 @@ jobs: do-macos: ${{ steps.get-matrix-step.outputs.do-macos }} matrix-macos: ${{ steps.get-matrix-step.outputs.macos }} steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v4 - id: files if: ${{ github.event_name != 'workflow_dispatch' }} uses: kanaka/get-changed-files@v2 @@ -41,11 +41,11 @@ jobs: fail-fast: false matrix: ${{ fromJson(needs.get-matrix.outputs.matrix-linux) }} steps: - - uses: actions/checkout@v2 + - 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@v2 + uses: docker/login-action@v3 with: registry: ghcr.io username: ${{ github.actor }} @@ -71,9 +71,9 @@ jobs: export ${{ matrix.IMPL }} ./ci.sh perf ${IMPL} - name: Archive logs and debug output - uses: actions/upload-artifact@v2 + uses: actions/upload-artifact@v4 with: - name: logs + name: logs.${{ matrix.IMPL }} path: | *.log *.debug @@ -86,7 +86,7 @@ jobs: fail-fast: false matrix: ${{ fromJson(needs.get-matrix.outputs.matrix-macos) }} steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v4 - name: Build run: | export ${{ matrix.IMPL }} @@ -104,9 +104,9 @@ jobs: export ${{ matrix.IMPL }} ./ci.sh perf ${IMPL} - name: Archive logs and debug output - uses: actions/upload-artifact@v2 + uses: actions/upload-artifact@v4 with: - name: logs + name: logs.${{ matrix.IMPL }} path: | *.log *.debug From 3f7b28652b2b63ddf5c612216d87f248846c5798 Mon Sep 17 00:00:00 2001 From: Joel Martin Date: Thu, 1 Aug 2024 14:33:01 -0500 Subject: [PATCH 11/32] GHA: switch from set-output to env file. The set-output mechanism is deprecated for security reasons so set environment variable outputs in GITHUB_OUTPUT instead. Change get-ci-matrix.py to output the env file settings to stdout and move all debug output to stderr. --- .github/workflows/main.yml | 6 +++--- get-ci-matrix.py | 21 ++++++++++++--------- 2 files changed, 15 insertions(+), 12 deletions(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index dc4189047f..077cf3fd55 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -18,9 +18,9 @@ jobs: get-matrix: runs-on: ubuntu-24.04 outputs: - do-linux: ${{ steps.get-matrix-step.outputs.do-linux }} + 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 }} + do-macos: ${{ steps.get-matrix-step.outputs.do_macos }} matrix-macos: ${{ steps.get-matrix-step.outputs.macos }} steps: - uses: actions/checkout@v4 @@ -31,7 +31,7 @@ jobs: run: | export OVERRIDE_IMPLS="${{ github.event.inputs.impls }}" # " echo "OVERRIDE_IMPLS: ${OVERRIDE_IMPLS}" - ./get-ci-matrix.py ${{ steps.files.outputs.all }} + ./get-ci-matrix.py ${{ steps.files.outputs.all }} > "${GITHUB_OUTPUT}" linux: needs: get-matrix diff --git a/get-ci-matrix.py b/get-ci-matrix.py index debcb172f3..1840df0c42 100755 --- a/get-ci-matrix.py +++ b/get-ci-matrix.py @@ -12,6 +12,9 @@ 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(): @@ -37,11 +40,11 @@ def impl_text(impl): do_full = True -print("OVERRIDE_IMPLS: %s" % OVERRIDE_IMPLS) -print("code_changes: %s (%d)" % (code_changes, len(code_changes))) -print("impl_changes: %s (%d)" % (impl_changes, len(impl_changes))) -print("run_impls: %s (%d)" % (run_impls, len(run_impls))) -print("do_full: %s" % do_full) +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)) @@ -60,7 +63,7 @@ def impl_text(impl): elif do_full: targ.append(impl_text(impl)) -print("::set-output name=do-linux::%s" % json.dumps(len(linux_impls)>0)) -print("::set-output name=do-macos::%s" % json.dumps(len(macos_impls)>0)) -print("::set-output name=linux::{\"IMPL\":%s}" % json.dumps(linux_impls)) -print("::set-output name=macos::{\"IMPL\":%s}" % json.dumps(macos_impls)) +print("do_linux=%s" % json.dumps(len(linux_impls)>0)) +print("do_macos=%s" % json.dumps(len(macos_impls)>0)) +print("linux={\"IMPL\":%s}" % json.dumps(linux_impls)) +print("macos={\"IMPL\":%s}" % json.dumps(macos_impls)) From fe218df3d2f4b672f695deddadbae5dcfc720bdf Mon Sep 17 00:00:00 2001 From: Joel Martin Date: Thu, 1 Aug 2024 15:01:17 -0500 Subject: [PATCH 12/32] GHA,ci.sh: add step summaries for docker actions. Add docker build-push summary statements for the workflow if the GITHUB_STEP_SUMMARY variable is set. --- ci.sh | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/ci.sh b/ci.sh index ff096ed0b0..abfc9cc43f 100755 --- a/ci.sh +++ b/ci.sh @@ -27,6 +27,13 @@ mode_val=${!mode_var} log_prefix="${ACTION}${REGRESS:+-regress}-${IMPL}${mode_val:+-${mode_val}}${MAL_IMPL:+-${MAL_IMPL}}" TEST_OPTS="${TEST_OPTS} --debug-file ../../${log_prefix}.debug" +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-${img_impl,,}" @@ -64,10 +71,14 @@ echo "MAKE: ${MAKE}" case "${ACTION}" in docker-build-push) - if ! docker pull ${IMAGE}; then + if docker pull ${IMAGE}; then + step_summary "${MAL_IMPL:-${IMPL}} - pulled ${IMAGE}" + else make "docker-build^${MAL_IMPL:-${IMPL}}" + step_summary "${MAL_IMPL:-${IMPL}} - built ${IMAGE}" if [ "${GITHUB_REF}" = "refs/heads/main" ]; then docker push ${IMAGE} + step_summary "${MAL_IMPL:-${IMPL}} - pushed ${IMAGE}" fi fi ;; From 714b718bd084e5cad1e5089a54d1703062b5193f Mon Sep 17 00:00:00 2001 From: Joel Martin Date: Thu, 1 Aug 2024 17:24:40 -0500 Subject: [PATCH 13/32] Update VB/c#/f# from vivid to xenial and add tzdata. --- impls/cs/Dockerfile | 4 ++-- impls/fsharp/Dockerfile | 4 ++-- impls/vb/Dockerfile | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/impls/cs/Dockerfile b/impls/cs/Dockerfile index f5f133484d..a95c31ce18 100644 --- a/impls/cs/Dockerfile +++ b/impls/cs/Dockerfile @@ -1,4 +1,4 @@ -FROM ubuntu:vivid +FROM ubuntu:xenial MAINTAINER Joel Martin ########################################################## @@ -22,4 +22,4 @@ WORKDIR /mal ########################################################## # 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 tzdata mono-runtime mono-mcs mono-vbnc mono-devel diff --git a/impls/fsharp/Dockerfile b/impls/fsharp/Dockerfile index 01cf8044c7..67ca2243b1 100644 --- a/impls/fsharp/Dockerfile +++ b/impls/fsharp/Dockerfile @@ -1,4 +1,4 @@ -FROM ubuntu:vivid +FROM ubuntu:xenial MAINTAINER Joel Martin ########################################################## @@ -22,6 +22,6 @@ WORKDIR /mal ########################################################## # 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 tzdata mono-runtime mono-mcs mono-vbnc mono-devel RUN apt-get -y install fsharp diff --git a/impls/vb/Dockerfile b/impls/vb/Dockerfile index f5f133484d..a95c31ce18 100644 --- a/impls/vb/Dockerfile +++ b/impls/vb/Dockerfile @@ -1,4 +1,4 @@ -FROM ubuntu:vivid +FROM ubuntu:xenial MAINTAINER Joel Martin ########################################################## @@ -22,4 +22,4 @@ WORKDIR /mal ########################################################## # 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 tzdata mono-runtime mono-mcs mono-vbnc mono-devel From a1a784c5725dcd3ee919dba25409e85fbbba4ec0 Mon Sep 17 00:00:00 2001 From: Joel Martin Date: Thu, 1 Aug 2024 17:37:45 -0500 Subject: [PATCH 14/32] groovy,kotlin: vivid->xenial and jdk-7->jdk-8 --- impls/groovy/Dockerfile | 4 ++-- impls/kotlin/Dockerfile | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/impls/groovy/Dockerfile b/impls/groovy/Dockerfile index 196698ab78..938f5aa0c0 100644 --- a/impls/groovy/Dockerfile +++ b/impls/groovy/Dockerfile @@ -1,4 +1,4 @@ -FROM ubuntu:vivid +FROM ubuntu:xenial MAINTAINER Joel Martin ########################################################## @@ -22,7 +22,7 @@ WORKDIR /mal ########################################################## # Java and Groovy -RUN apt-get -y install openjdk-7-jdk +RUN apt-get -y install openjdk-8-jdk #RUN apt-get -y install maven2 #ENV MAVEN_OPTS -Duser.home=/mal RUN apt-get -y install ant diff --git a/impls/kotlin/Dockerfile b/impls/kotlin/Dockerfile index dfb83bb887..86857b2ce1 100644 --- a/impls/kotlin/Dockerfile +++ b/impls/kotlin/Dockerfile @@ -1,4 +1,4 @@ -FROM ubuntu:vivid +FROM ubuntu:xenial MAINTAINER Joel Martin ########################################################## @@ -22,7 +22,7 @@ WORKDIR /mal ########################################################## # Java and Zip -RUN apt-get -y install openjdk-7-jdk +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 From b3759ab63b2daa33d1c2b2ab65f86d96229bd14c Mon Sep 17 00:00:00 2001 From: Joel Martin Date: Thu, 1 Aug 2024 17:47:53 -0500 Subject: [PATCH 15/32] php: update vivid->xenial and php5 -> php7.0 --- impls/php/Dockerfile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/impls/php/Dockerfile b/impls/php/Dockerfile index 87709d4d9a..140e560177 100644 --- a/impls/php/Dockerfile +++ b/impls/php/Dockerfile @@ -1,4 +1,4 @@ -FROM ubuntu:vivid +FROM ubuntu:xenial MAINTAINER Joel Martin ########################################################## @@ -21,4 +21,4 @@ WORKDIR /mal # Specific implementation requirements ########################################################## -RUN apt-get -y install php5-cli +RUN apt-get -y install php7.0-cli From f63d2e46724251d429f3fc6373aff5a2aa49c534 Mon Sep 17 00:00:00 2001 From: Joel Martin Date: Thu, 1 Aug 2024 17:50:31 -0500 Subject: [PATCH 16/32] ruby: update vivid->xenial --- impls/ruby/Dockerfile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/impls/ruby/Dockerfile b/impls/ruby/Dockerfile index 3bda3bf706..a50818b687 100644 --- a/impls/ruby/Dockerfile +++ b/impls/ruby/Dockerfile @@ -1,4 +1,4 @@ -FROM ubuntu:vivid +FROM ubuntu:xenial MAINTAINER Joel Martin ########################################################## From e6ec37a468574eba5dafd7a581cc159ad7546269 Mon Sep 17 00:00:00 2001 From: Joel Martin Date: Thu, 1 Aug 2024 18:07:35 -0500 Subject: [PATCH 17/32] ruby: fix stackoverflow printing in steps 6-A --- impls/ruby/step6_file.rb | 2 +- impls/ruby/step7_quote.rb | 2 +- impls/ruby/step8_macros.rb | 2 +- impls/ruby/step9_try.rb | 2 +- impls/ruby/stepA_mal.rb | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/impls/ruby/step6_file.rb b/impls/ruby/step6_file.rb index 0a1b060cd4..ab2b825229 100644 --- a/impls/ruby/step6_file.rb +++ b/impls/ruby/step6_file.rb @@ -111,6 +111,6 @@ def PRINT(exp) puts REP[line] rescue Exception => e puts "Error: #{e}" - puts "\t#{e.backtrace.join("\n\t")}" + 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 index de33426a85..c942fcf74e 100644 --- a/impls/ruby/step7_quote.rb +++ b/impls/ruby/step7_quote.rb @@ -148,6 +148,6 @@ def PRINT(exp) puts REP[line] rescue Exception => e puts "Error: #{e}" - puts "\t#{e.backtrace.join("\n\t")}" + 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 index 04ebaa0be7..c1d2db3ebc 100644 --- a/impls/ruby/step8_macros.rb +++ b/impls/ruby/step8_macros.rb @@ -180,6 +180,6 @@ def PRINT(exp) puts REP[line] rescue Exception => e puts "Error: #{e}" - puts "\t#{e.backtrace.join("\n\t")}" + 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 index d4b2bde72d..207ec6cdf4 100644 --- a/impls/ruby/step9_try.rb +++ b/impls/ruby/step9_try.rb @@ -199,6 +199,6 @@ def PRINT(exp) else puts "Error: #{e}" end - puts "\t#{e.backtrace.join("\n\t")}" + 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 index 4f1b0d4453..a43588e0e9 100644 --- a/impls/ruby/stepA_mal.rb +++ b/impls/ruby/stepA_mal.rb @@ -207,6 +207,6 @@ def PRINT(exp) else puts "Error: #{e}" end - puts "\t#{e.backtrace.join("\n\t")}" + puts "\t#{e.backtrace[0..100].join("\n\t")}" end end From 6bf89ea1185eaf7386eda99c84696d03703c2fa1 Mon Sep 17 00:00:00 2001 From: Joel Martin Date: Fri, 2 Aug 2024 17:47:24 -0500 Subject: [PATCH 18/32] miniMAL: update to miniMAL-1.2.2 - Update to ubuntu 24.04 Dockerfile and add labels. - update to working version of ffi-napi - Remove from miniMAL-core.json the things that overlap with the builtin core functionality that miniMAL now provides in 1.2.2. - Update ARGS variable to argv to align with how 1.2.2 now does command line parameters. --- impls/miniMAL/Dockerfile | 16 ++--- impls/miniMAL/core.json | 10 ++- impls/miniMAL/miniMAL-core.json | 119 -------------------------------- impls/miniMAL/package.json | 2 +- impls/miniMAL/step6_file.json | 6 +- impls/miniMAL/step7_quote.json | 6 +- impls/miniMAL/step8_macros.json | 6 +- impls/miniMAL/step9_try.json | 6 +- impls/miniMAL/stepA_mal.json | 6 +- 9 files changed, 31 insertions(+), 146 deletions(-) diff --git a/impls/miniMAL/Dockerfile b/impls/miniMAL/Dockerfile index fa54933ccb..87a5dcfb3f 100644 --- a/impls/miniMAL/Dockerfile +++ b/impls/miniMAL/Dockerfile @@ -1,5 +1,7 @@ -FROM ubuntu:18.04 +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 @@ -9,7 +11,8 @@ MAINTAINER Joel Martin RUN apt-get -y update # Required for running tests -RUN apt-get -y install make python +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 @@ -24,14 +27,9 @@ WORKDIR /mal # 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 +RUN apt-get -y install nodejs npm ENV NPM_CONFIG_CACHE /mal/.npm # install miniMAL -RUN npm install -g minimal-lisp +RUN npm install -g minimal-lisp@1.2.2 diff --git a/impls/miniMAL/core.json b/impls/miniMAL/core.json index d80efad732..3ad9bd0926 100644 --- a/impls/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", [], @@ -121,9 +127,9 @@ ["`", "symbol?"], "symbol?", ["`", "keyword"], "keyword", ["`", "keyword?"], "keyword?", - ["`", "number?"], "number?", + ["`", "number?"], "_number?", ["`", "fn?"], ["fn", ["a"], - ["or", ["function?", "a"], + ["or", ["_function?", "a"], ["and", ["malfunc?", "a"], ["not", ["get", "a", ["`", "macro?"]]]]]], ["`", "macro?"], ["fn", ["a"], diff --git a/impls/miniMAL/miniMAL-core.json b/impls/miniMAL/miniMAL-core.json index cc3379f0e7..d430c1fdae 100644 --- a/impls/miniMAL/miniMAL-core.json +++ b/impls/miniMAL/miniMAL-core.json @@ -1,124 +1,5 @@ ["do", -["def", "new", ["fn", ["a", "&", "b"], - [".", "Reflect", ["`", "construct"], "a", "b"]]], -["def", "del", ["fn", ["a", "b"], - [".", "Reflect", ["`", "deleteProperty"], "a", "b"]]], -["def", "map", ["fn", ["a", "b"], - [".", "b", ["`", "map"], ["fn", ["x"], ["a", "x"]]]]], -["def", "list", ["fn", ["&", "a"], "a"]], -["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", "classOf", ["fn", ["a"], - [".", [".-", [".-", "Object", ["`", "prototype"]], ["`", "toString"]], - ["`", "call"], "a"]]], - -["def", "not", ["fn", ["a"], ["if", "a", false, true]]], - -["def", "null?", ["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", "number?", ["fn", ["a"], - ["=", ["`", "[object Number]"], ["classOf", "a"]]]], -["def", "function?", ["fn", ["a"], - ["isa", "a", "Function"]]], - -["def", "pr-list*", ["fn", ["a", "b", "c"], - [".", ["map", ["fn", ["x"], - ["if", "c", - [".", "JSON", ["`", "stringify"], "x"], - ["if", ["string?", "x"], - "x", - [".", "JSON", ["`", "stringify"], "x"]]]], - "a"], - ["`", "join"], "b"]]], -["def", "pr-str", ["fn", ["&", "a"], - ["pr-list*", "a", ["`", " "], true]]], -["def", "str", ["fn", ["&", "a"], - ["pr-list*", "a", ["`", ""], false]]], -["def", "prn", ["fn", ["&", "a"], - ["do", [".", "console", ["`", "log"], - ["pr-list*", "a", ["`", " "], true]], null]]], -["def", "println", ["fn", ["&", "a"], - ["do", [".", "console", ["`", "log"], - ["pr-list*", "a", ["`", " "], false]], null]]], - -["def", "list?", ["fn", ["a"], - [".", "Array", ["`", "isArray"], "a"]]], -["def", "contains?", ["fn", ["a", "b"], - [".", "a", ["`", "hasOwnProperty"], "b"]]], -["def", "get", ["fn", ["a", "b"], - ["if", ["contains?", "a", "b"], [".-", "a", "b"], null]]], -["def", "set", ["fn", ["a", "b", "c"], - ["do", [".-", "a", "b", "c"], "a"]]], -["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"], - ["if", [">", [".-", "a", ["`", "length"]], 0], - ["nth", "a", 0], - null]]], -["def", "last", ["fn", ["a"], - ["nth", "a", ["-", [".-", "a", ["`", "length"]], 1]]]], -["def", "count", ["fn", ["a"], - [".-", "a", ["`", "length"]]]], -["def", "empty?", ["fn", ["a"], - ["if", ["list?", "a"], - ["if", ["=", 0, [".-", "a", ["`", "length"]]], true, false], - ["=", "a", null]]]], -["def", "slice", ["fn", ["a", "b", "&", "end"], - [".", "a", ["`", "slice"], "b", - ["if", [">", ["count", "end"], 0], - ["get", "end", 0], - [".-", "a", ["`", "length"]]]]]], -["def", "rest", ["fn", ["a"], ["slice", "a", 1]]], - -["def", "apply", ["fn", ["f", "&", "b"], - [".", "f", ["`", "apply"], "f", - ["concat", ["slice", "b", 0, -1], ["last", "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", "repl", ["fn",["prompt", "rep"], ["let", ["readline", ["require", ["`", "readline"]], "opts", ["new", "Object"], diff --git a/impls/miniMAL/package.json b/impls/miniMAL/package.json index bd9e2cf659..99f902b20e 100644 --- a/impls/miniMAL/package.json +++ b/impls/miniMAL/package.json @@ -4,6 +4,6 @@ "description": "Make a Lisp (mal) language implemented in miniMAL", "dependencies": { "minimal-lisp": "1.0.2", - "ffi-napi": "2.4.x" + "ffi-napi": "4.0.3" } } diff --git a/impls/miniMAL/step6_file.json b/impls/miniMAL/step6_file.json index 71091b65a8..59d4b84573 100644 --- a/impls/miniMAL/step6_file.json +++ b/impls/miniMAL/step6_file.json @@ -97,14 +97,14 @@ ["env-set", "repl-env", ["symbol", ["`", "eval"]], ["fn", ["ast"], ["EVAL", "ast", "repl-env"]]], ["env-set", "repl-env", ["symbol", ["`", "*ARGV*"]], - ["slice", "ARGS", 1]], + ["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?", "ARGS"]], - ["rep", ["str", ["`", "(load-file \""], ["get", "ARGS", 0], ["`", "\")"]]], +["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 index eeac76ce29..b6b18cf6fd 100644 --- a/impls/miniMAL/step7_quote.json +++ b/impls/miniMAL/step7_quote.json @@ -130,14 +130,14 @@ ["env-set", "repl-env", ["symbol", ["`", "eval"]], ["fn", ["ast"], ["EVAL", "ast", "repl-env"]]], ["env-set", "repl-env", ["symbol", ["`", "*ARGV*"]], - ["slice", "ARGS", 1]], + ["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?", "ARGS"]], - ["rep", ["str", ["`", "(load-file \""], ["get", "ARGS", 0], ["`", "\")"]]], +["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 index 2a362d7963..88ad3b2db9 100644 --- a/impls/miniMAL/step8_macros.json +++ b/impls/miniMAL/step8_macros.json @@ -154,15 +154,15 @@ ["env-set", "repl-env", ["symbol", ["`", "eval"]], ["fn", ["ast"], ["EVAL", "ast", "repl-env"]]], ["env-set", "repl-env", ["symbol", ["`", "*ARGV*"]], - ["slice", "ARGS", 1]], + ["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?", "ARGS"]], - ["rep", ["str", ["`", "(load-file \""], ["get", "ARGS", 0], ["`", "\")"]]], +["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 index a66146c39c..26c8fa385c 100644 --- a/impls/miniMAL/step9_try.json +++ b/impls/miniMAL/step9_try.json @@ -167,15 +167,15 @@ ["env-set", "repl-env", ["symbol", ["`", "eval"]], ["fn", ["ast"], ["EVAL", "ast", "repl-env"]]], ["env-set", "repl-env", ["symbol", ["`", "*ARGV*"]], - ["slice", "ARGS", 1]], + ["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?", "ARGS"]], - ["rep", ["str", ["`", "(load-file \""], ["get", "ARGS", 0], ["`", "\")"]]], +["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 index e5b64ed92f..18e88b47c4 100644 --- a/impls/miniMAL/stepA_mal.json +++ b/impls/miniMAL/stepA_mal.json @@ -167,7 +167,7 @@ ["env-set", "repl-env", ["symbol", ["`", "eval"]], ["fn", ["ast"], ["EVAL", "ast", "repl-env"]]], ["env-set", "repl-env", ["symbol", ["`", "*ARGV*"]], - ["slice", "ARGS", 1]], + ["slice", "argv", 1]], ["`", "core.mal: defined using mal itself"], ["rep", ["`", "(def! *host-language* \"miniMAL\")"]], @@ -175,8 +175,8 @@ ["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?", "ARGS"]], - ["rep", ["str", ["`", "(load-file \""], ["get", "ARGS", 0], ["`", "\")"]]], +["if", ["not", ["empty?", "argv"]], + ["rep", ["str", ["`", "(load-file \""], ["get", "argv", 0], ["`", "\")"]]], ["do", ["rep", ["`", "(println (str \"Mal [\" *host-language* \"]\"))"]], ["repl", ["`", "user> "], "rep"]]], From f3903a7141a9e3fb3840e2ab1200308f7f8d6740 Mon Sep 17 00:00:00 2001 From: Joel Martin Date: Sat, 3 Aug 2024 11:04:48 -0500 Subject: [PATCH 19/32] docs: docker image/CI info. Replace IRC with Discord links. --- README.md | 7 +++--- docs/FAQ.md | 59 ++++++++++++++++++++++++++++++++++++++++++++---- process/guide.md | 4 +--- 3 files changed, 58 insertions(+), 12 deletions(-) diff --git a/README.md b/README.md index 3fa1c13df2..e58e828921 100644 --- a/README.md +++ b/README.md @@ -35,9 +35,8 @@ Here is the final diagram for [step A](process/guide.md#stepA): ![stepA_mal architecture](process/stepA_mal.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) or join #mal on -[libera.chat](https://libera.chat/). In addition to the [make-a-lisp +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. @@ -1452,7 +1451,7 @@ 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 this command once manually first `make DOCKERIZE=1 "repl^IMPL"` before you can run tests because diff --git a/docs/FAQ.md b/docs/FAQ.md index 49af1d7eee..b045de0867 100644 --- a/docs/FAQ.md +++ b/docs/FAQ.md @@ -154,11 +154,57 @@ into the main repository: `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. Refer to other - implementations for examples of what the Dockerfile should contain. - Build your docker image and tag it `kanaka/mal-test-[IMPL_NAME]`. - The top-level Makefile has support for building/testing within - docker with the `DOCKERIZE` flag: + 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" @@ -170,6 +216,9 @@ into the main repository: ./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 diff --git a/process/guide.md b/process/guide.md index e0f18b1208..3f0ee86c81 100644 --- a/process/guide.md +++ b/process/guide.md @@ -1716,9 +1716,7 @@ implementation. ### Next Steps -* Join the #mal IRC channel. It's fairly quiet but there are bursts of - interesting conversation related to mal, Lisps, esoteric programming - languages, etc. +* 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 From dd16a7d023db50ec747c1a86c08288fa341320bd Mon Sep 17 00:00:00 2001 From: Joel Martin Date: Sat, 3 Aug 2024 11:07:36 -0500 Subject: [PATCH 20/32] ci.sh: remove pulled step summary. This should be the default if things are working correctly so logging this now is just noise that causes the summaries that are relevant to get folded in the UI. --- ci.sh | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/ci.sh b/ci.sh index abfc9cc43f..cf30169d84 100755 --- a/ci.sh +++ b/ci.sh @@ -71,9 +71,8 @@ echo "MAKE: ${MAKE}" case "${ACTION}" in docker-build-push) - if docker pull ${IMAGE}; then - step_summary "${MAL_IMPL:-${IMPL}} - pulled ${IMAGE}" - else + if ! docker pull ${IMAGE}; then + step_summary "${MAL_IMPL:-${IMPL}} - building ${IMAGE}" make "docker-build^${MAL_IMPL:-${IMPL}}" step_summary "${MAL_IMPL:-${IMPL}} - built ${IMAGE}" if [ "${GITHUB_REF}" = "refs/heads/main" ]; then From d4f6b1e6dd2b6f76cfdc3589bfa96f282b49bf88 Mon Sep 17 00:00:00 2001 From: Joel Martin Date: Sat, 3 Aug 2024 11:15:28 -0500 Subject: [PATCH 21/32] ci.sh: restore tr lower-casing to fix macos. --- ci.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ci.sh b/ci.sh index cf30169d84..f8c98135f9 100755 --- a/ci.sh +++ b/ci.sh @@ -36,7 +36,7 @@ step_summary() { img_base="${MAL_IMPL:-${IMPL}}" img_impl="${img_base%%-mal}" -img_name="mal-test-${img_impl,,}" +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}" From ee6c11da3bf097f5789545e57363a154669c2ad8 Mon Sep 17 00:00:00 2001 From: Joel Martin Date: Sat, 3 Aug 2024 11:31:52 -0500 Subject: [PATCH 22/32] GHA: use default_base for get-changed-files This is needed for new branches. --- .github/workflows/main.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 077cf3fd55..59957f02db 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -27,6 +27,8 @@ jobs: - id: files if: ${{ github.event_name != 'workflow_dispatch' }} uses: kanaka/get-changed-files@v2 + with: + default_base: master - id: get-matrix-step run: | export OVERRIDE_IMPLS="${{ github.event.inputs.impls }}" # " From b4843b602cd017601525c0400453cc3f6832b649 Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Tue, 18 Jan 2022 18:08:45 +0100 Subject: [PATCH 23/32] make: allow keyword argument to keyword functions --- impls/make/core.mk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/impls/make/core.mk b/impls/make/core.mk index 1823cb2e28..5e88f7b44f 100644 --- a/impls/make/core.mk +++ b/impls/make/core.mk @@ -36,7 +36,7 @@ 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 $(_keyword?),$(1),$(call _keyword,$(call str_decode,$($(1)_value)))) keyword? = $(if $(call _keyword?,$(1)),$(__true),$(__false)) From 3bd752c979346faa21a7f150b7b4892f850b4856 Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Tue, 18 Jan 2022 18:09:24 +0100 Subject: [PATCH 24/32] make: prevent defmacro! from mutating functions --- impls/make/step8_macros.mk | 2 +- impls/make/step9_try.mk | 2 +- impls/make/stepA_mal.mk | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/impls/make/step8_macros.mk b/impls/make/step8_macros.mk index 10d4046a1a..36a3d6afb3 100644 --- a/impls/make/step8_macros.mk +++ b/impls/make/step8_macros.mk @@ -102,7 +102,7 @@ $(if $(__ERROR),,\ $(if $(call _EQ,defmacro!,$($(a0)_value)),\ $(foreach a1,$(call _nth,$(1),1),\ $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call EVAL,$(a2),$(2)),\ + $(foreach res,$(call _clone_obj,$(call EVAL,$(a2),$(2))),\ $(eval _macro_$(res) = true)\ $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),)))),\ $(if $(call _EQ,macroexpand,$($(a0)_value)),\ diff --git a/impls/make/step9_try.mk b/impls/make/step9_try.mk index fd49e82dd1..1fea14424d 100644 --- a/impls/make/step9_try.mk +++ b/impls/make/step9_try.mk @@ -102,7 +102,7 @@ $(if $(__ERROR),,\ $(if $(call _EQ,defmacro!,$($(a0)_value)),\ $(foreach a1,$(call _nth,$(1),1),\ $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call EVAL,$(a2),$(2)),\ + $(foreach res,$(call _clone_obj,$(call EVAL,$(a2),$(2))),\ $(eval _macro_$(res) = true)\ $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),)))),\ $(if $(call _EQ,macroexpand,$($(a0)_value)),\ diff --git a/impls/make/stepA_mal.mk b/impls/make/stepA_mal.mk index fb5c4648b6..ab52629d9e 100644 --- a/impls/make/stepA_mal.mk +++ b/impls/make/stepA_mal.mk @@ -102,7 +102,7 @@ $(if $(__ERROR),,\ $(if $(call _EQ,defmacro!,$($(a0)_value)),\ $(foreach a1,$(call _nth,$(1),1),\ $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call EVAL,$(a2),$(2)),\ + $(foreach res,$(call _clone_obj,$(call EVAL,$(a2),$(2))),\ $(eval _macro_$(res) = true)\ $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),)))),\ $(if $(call _EQ,macroexpand,$($(a0)_value)),\ From 3233e7821acf2646f0dc92221bc8ec2da9c00c73 Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Tue, 18 Jan 2022 18:12:39 +0100 Subject: [PATCH 25/32] make: fix enconding of hash and dollar signs Some tests were failing with Make 4.3. --- impls/make/printer.mk | 2 +- impls/make/readline.mk | 4 ++-- impls/make/step2_eval.mk | 2 +- impls/make/util.mk | 9 +++++---- 4 files changed, 9 insertions(+), 8 deletions(-) diff --git a/impls/make/printer.mk b/impls/make/printer.mk index dda5ee63b0..adf859cac7 100644 --- a/impls/make/printer.mk +++ b/impls/make/printer.mk @@ -34,7 +34,7 @@ keyword_pr_str = $(COLON)$(patsubst $(__keyword)%,%,$(call str_decode,$($(1)_val 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))> +function_pr_str = list_pr_str = ($(foreach v,$(call __get_obj_values,$(1)),$(call _pr_str,$(v),$(2)))) diff --git a/impls/make/readline.mk b/impls/make/readline.mk index 39918c52ad..3d08ab199b 100644 --- a/impls/make/readline.mk +++ b/impls/make/readline.mk @@ -10,7 +10,7 @@ __mal_readline_included := true # have readline history. READLINE_EOF := READLINE_HISTORY_FILE := $${HOME}/.mal-history -READLINE = $(eval __readline_temp := $(shell \ +READLINE = $(eval __readline_temp := $(subst #,\#,$(subst $$,$$$$,$(shell \ history -r $(READLINE_HISTORY_FILE); \ read -u 0 -r -e -p $(if $(1),$(1),"user> ") line && \ history -s -- "$${line}" && \ @@ -18,6 +18,6 @@ READLINE = $(eval __readline_temp := $(shell \ echo "__||EOF||__"; \ history -a $(READLINE_HISTORY_FILE) 2>/dev/null || \ true \ -))$(if $(filter __||EOF||__,$(__readline_temp)),$(eval READLINE_EOF := yes),$(__readline_temp)) +))))$(if $(filter __||EOF||__,$(__readline_temp)),$(eval READLINE_EOF := yes),$(__readline_temp))$(if $(DEBUG_READLINE),$(warning readline/$(__readline_temp)/)) endif diff --git a/impls/make/step2_eval.mk b/impls/make/step2_eval.mk index 0fed27c7d3..f02c97532c 100644 --- a/impls/make/step2_eval.mk +++ b/impls/make/step2_eval.mk @@ -24,7 +24,7 @@ $(strip \ $(foreach key,$($(1)_value),\ $(if $(call _contains?,$(2),$(key)),\ $(call _get,$(2),$(key)),\ - $(call _error,'$(key)' not found in REPL_ENV ($(2))))),\ + $(call _error,'$(key)' not found in REPL_ENV))),\ $(if $(call _list?,$(1)),\ $(call _smap,EVAL,$(1),$(2)),\ $(if $(call _vector?,$(1)),\ diff --git a/impls/make/util.mk b/impls/make/util.mk index bee3e319fa..887798542b 100644 --- a/impls/make/util.mk +++ b/impls/make/util.mk @@ -23,8 +23,7 @@ ESC_DQUOTE := $(SLASH)$(DQUOTE) ESC_N := $(SLASH)n SQUOTE := '# ' QQUOTE := `# ` -SPACE := -SPACE += +SPACE := $(hopefully_undefined) $(hopefully_undefined) MINUS := - NUMBERS := 0 1 2 3 4 5 6 7 8 9 UNQUOTE := ~ @@ -35,7 +34,9 @@ define NEWLINE endef CARET := ^ ATSIGN := @ +HASH := \# +_HASH := © # \u00ab _LP := « # \u00bb @@ -86,12 +87,12 @@ _reverse = $(if $(1),$(call _reverse,$(wordlist 2,$(words $(1)),$(1)))) $(firstw # 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_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 $$(HASH),$(_HASH) ,$$(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))))))))))) +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),$$,$(subst $(_HASH),$(HASH),$(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")) From d0375ec9f8c4c3376e422bdbfea9cec27169a705 Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Tue, 18 Jan 2022 18:18:41 +0100 Subject: [PATCH 26/32] vb: allow keyword argument to keyword function --- impls/vb/core.vb | 3 +++ 1 file changed, 3 insertions(+) diff --git a/impls/vb/core.vb b/impls/vb/core.vb index 08d3caf308..77ba29cc73 100644 --- a/impls/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 From 10e8854c04ece4f166a46f148302ce3afdad65b8 Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Tue, 18 Jan 2022 18:21:33 +0100 Subject: [PATCH 27/32] python.2: add with-meta reader macro --- impls/python.2/reader.py | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/impls/python.2/reader.py b/impls/python.2/reader.py index 98336d14bb..bdc12fdbe2 100644 --- a/impls/python.2/reader.py +++ b/impls/python.2/reader.py @@ -23,6 +23,7 @@ # Arpeggio grammar def mExpression(): return [ + mWithMetaExpression, mQuotedExpression, mQuasiQuotedExpression, mSpliceUnquotedExpression, @@ -40,6 +41,10 @@ def mExpression(): ] +def mWithMetaExpression(): + return "^", mExpression, mExpression + + def mQuotedExpression(): return "'", mExpression @@ -168,6 +173,9 @@ def visit_mBoolean(self, node, children) -> MalBoolean: def visit_mNil(self, node, children) -> MalNil: return MalNil() + def visit_mWithMetaExpression(self, node, children) -> MalList: + return MalList([MalSymbol("with-meta"), children[1], children[0]]) + def visit_mQuotedExpression(self, node, children) -> MalList: return MalList([MalSymbol("quote"), children[0]]) From 6a6bc8cb732e8babc5b6c05a042a248b339ad68e Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Tue, 18 Jan 2022 18:23:02 +0100 Subject: [PATCH 28/32] python.2: fix argv in step9 --- impls/python.2/step9_try.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/impls/python.2/step9_try.py b/impls/python.2/step9_try.py index c8ecac23f4..2e6f8327da 100644 --- a/impls/python.2/step9_try.py +++ b/impls/python.2/step9_try.py @@ -267,7 +267,7 @@ def rep_handling_exceptions(line: str, repl_env: Env) -> str: if len(sys.argv) >= 2: file_str = sys.argv[1] - print(rep_handling_exceptions('(load-file "' + file_str + '")', repl_env)) + rep_handling_exceptions('(load-file "' + file_str + '")', repl_env) exit(0) while not eof: From cb333f13879e4503425202ed270d5cbf6d976fe3 Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Tue, 18 Jan 2022 18:33:37 +0100 Subject: [PATCH 29/32] ruby.2: backport a fix for step6 tests from stepA source to step9 source --- impls/ruby.2/step9_try.rb | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/impls/ruby.2/step9_try.rb b/impls/ruby.2/step9_try.rb index 9cfa409c89..68e93c0180 100644 --- a/impls/ruby.2/step9_try.rb +++ b/impls/ruby.2/step9_try.rb @@ -20,7 +20,7 @@ def boot_repl! Types::Symbol.for("eval"), Types::Builtin.new("eval") do |mal| - Mal.EVAL(mal.first, @repl_env) + Mal.EVAL(mal, @repl_env) end ) From 033892777a1ab7008532f68d8c496ffcb459cc0c Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Mon, 10 Jan 2022 00:15:40 +0100 Subject: [PATCH 30/32] Merge eval-ast and macro expansion into EVAL, add DEBUG-EVAL See issue #587. * Merge eval-ast and eval into a single conditional. * Expand macros during the apply phase, removing lots of duplicate tests, and increasing the overall consistency by allowing the macro to be computed instead of referenced by name (`((defmacro! cond (...)))` is currently illegal for example). * Print "EVAL: $ast" at the top of EVAL if DEBUG-EVAL exists in the MAL environment. * Remove macroexpand and quasiquoteexpand special forms. * Use pattern-matching style in process/step*.txt. Unresolved issues: c.2: unable to reproduce with gcc 11.12.0. elm: the directory is unchanged. groovy: sometimes fail, but not on each rebuild. nasm: fails some new soft tests, but the issue is unreproducible when running the interpreter manually. objpascal: unreproducible with fpc 3.2.2. ocaml: unreproducible with 4.11.1. perl6: unreproducible with rakudo 2021.09. Unrelated changes: Reduce diff betweens steps. Prevent defmacro! from mutating functions: c forth logo miniMAL vb. dart: fix recent errors and warnings ocaml: remove metadata from symbols. Improve the logo implementation. Encapsulate all representation in types.lg and env.lg, unwrap numbers. Replace some manual iterations with logo control structures. Reduce the diff between steps. Use native iteration in env_get and env_map Rewrite the reader with less temporary strings. Reduce the number of temporary lists (for example, reverse iteration with butlast requires O(n^2) allocations). It seems possible to remove a few exceptions: GC settings (Dockerfile), NO_SELF_HOSTING (IMPLS.yml) and step5_EXCLUDES (Makefile.impls) . --- IMPLS.yml | 2 +- Makefile.impls | 1 - impls/ada.2/envs.adb | 19 + impls/ada.2/envs.ads | 3 + impls/ada.2/step2_eval.adb | 11 +- impls/ada.2/step3_env.adb | 7 +- impls/ada.2/step4_if_fn_do.adb | 25 +- impls/ada.2/step5_tco.adb | 29 +- impls/ada.2/step6_file.adb | 29 +- impls/ada.2/step7_quote.adb | 32 +- impls/ada.2/step8_macros.adb | 66 +-- impls/ada.2/step9_try.adb | 66 +-- impls/ada.2/stepa_mal.adb | 66 +-- impls/ada.2/types.adb | 6 + impls/ada.2/types.ads | 2 + impls/ada/step2_eval.adb | 48 +-- impls/ada/step3_env.adb | 68 ++- impls/ada/step4_if_fn_do.adb | 52 ++- impls/ada/step5_tco.adb | 68 ++- impls/ada/step6_file.adb | 70 ++-- impls/ada/step7_quote.adb | 76 ++-- impls/ada/step8_macros.adb | 155 ++----- impls/ada/step9_try.adb | 155 ++----- impls/ada/stepa_mal.adb | 156 ++----- impls/ada/types.adb | 69 --- impls/ada/types.ads | 4 - impls/awk/step2_eval.awk | 52 ++- impls/awk/step3_env.awk | 71 +++- impls/awk/step4_if_fn_do.awk | 64 ++- impls/awk/step5_tco.awk | 71 +++- impls/awk/step6_file.awk | 71 +++- impls/awk/step7_quote.awk | 80 ++-- impls/awk/step8_macros.awk | 169 ++++---- impls/awk/step9_try.awk | 167 ++++---- impls/awk/stepA_mal.awk | 168 ++++---- impls/bash/step2_eval.sh | 30 +- impls/bash/step3_env.sh | 38 +- impls/bash/step4_if_fn_do.sh | 40 +- impls/bash/step5_tco.sh | 43 +- impls/bash/step6_file.sh | 43 +- impls/bash/step7_quote.sh | 45 +- impls/bash/step8_macros.sh | 97 ++--- impls/bash/step9_try.sh | 97 ++--- impls/bash/stepA_mal.sh | 97 ++--- impls/bbc-basic/env.bas | 23 +- impls/bbc-basic/step2_eval.bas | 48 +-- impls/bbc-basic/step3_env.bas | 84 ++-- impls/bbc-basic/step4_if_fn_do.bas | 108 ++--- impls/bbc-basic/step5_tco.bas | 92 ++-- impls/bbc-basic/step6_file.bas | 96 +++-- impls/bbc-basic/step7_quote.bas | 100 +++-- impls/bbc-basic/step8_macros.bas | 132 +++--- impls/bbc-basic/step9_try.bas | 132 +++--- impls/bbc-basic/stepA_mal.bas | 132 +++--- impls/c.2/env.c | 35 +- impls/c.2/env.h | 6 +- impls/c.2/step2_eval.c | 90 ++-- impls/c.2/step3_env.c | 104 ++--- impls/c.2/step4_if_fn_do.c | 98 ++--- impls/c.2/step5_tco.c | 96 ++--- impls/c.2/step6_file.c | 102 ++--- impls/c.2/step7_quote.c | 109 ++--- impls/c.2/step8_macros.c | 204 +++------ impls/c.2/step9_try.c | 213 +++------- impls/c.2/stepA_mal.c | 216 +++------- impls/c/env.c | 24 +- impls/c/step2_eval.c | 20 +- impls/c/step3_env.c | 39 +- impls/c/step4_if_fn_do.c | 36 +- impls/c/step5_tco.c | 40 +- impls/c/step6_file.c | 45 +- impls/c/step7_quote.c | 48 +-- impls/c/step8_macros.c | 90 ++-- impls/c/step9_try.c | 90 ++-- impls/c/stepA_mal.c | 93 ++--- impls/c/types.h | 6 +- impls/clojure/src/mal/step2_eval.cljc | 30 +- impls/clojure/src/mal/step3_env.cljc | 35 +- impls/clojure/src/mal/step4_if_fn_do.cljc | 37 +- impls/clojure/src/mal/step5_tco.cljc | 41 +- impls/clojure/src/mal/step6_file.cljc | 41 +- impls/clojure/src/mal/step7_quote.cljc | 51 ++- impls/clojure/src/mal/step8_macros.cljc | 75 ++-- impls/clojure/src/mal/step9_try.cljc | 75 ++-- impls/clojure/src/mal/stepA_mal.cljc | 75 ++-- impls/coffee/env.coffee | 10 +- impls/coffee/step2_eval.coffee | 20 +- impls/coffee/step3_env.coffee | 23 +- impls/coffee/step4_if_fn_do.coffee | 25 +- impls/coffee/step5_tco.coffee | 27 +- impls/coffee/step6_file.coffee | 27 +- impls/coffee/step7_quote.coffee | 29 +- impls/coffee/step8_macros.coffee | 49 +-- impls/coffee/step9_try.coffee | 49 +-- impls/coffee/stepA_mal.coffee | 51 +-- impls/common-lisp/src/env.lisp | 15 +- impls/common-lisp/src/step2_eval.lisp | 41 +- impls/common-lisp/src/step3_env.lisp | 31 +- impls/common-lisp/src/step4_if_fn_do.lisp | 33 +- impls/common-lisp/src/step5_tco.lisp | 43 +- impls/common-lisp/src/step6_file.lisp | 43 +- impls/common-lisp/src/step7_quote.lisp | 47 ++- impls/common-lisp/src/step8_macros.lisp | 83 ++-- impls/common-lisp/src/step9_try.lisp | 83 ++-- impls/common-lisp/src/stepA_mal.lisp | 85 ++-- impls/cpp/step2_eval.cpp | 2 + impls/cpp/step3_env.cpp | 6 + impls/cpp/step4_if_fn_do.cpp | 6 + impls/cpp/step5_tco.cpp | 6 + impls/cpp/step6_file.cpp | 6 + impls/cpp/step7_quote.cpp | 11 +- impls/cpp/step8_macros.cpp | 61 +-- impls/cpp/step9_try.cpp | 61 +-- impls/cpp/stepA_mal.cpp | 61 +-- impls/cs/env.cs | 18 +- impls/cs/step2_eval.cs | 45 +- impls/cs/step3_env.cs | 52 +-- impls/cs/step4_if_fn_do.cs | 61 +-- impls/cs/step5_tco.cs | 62 +-- impls/cs/step6_file.cs | 62 +-- impls/cs/step7_quote.cs | 64 +-- impls/cs/step8_macros.cs | 98 ++--- impls/cs/step9_try.cs | 98 ++--- impls/cs/stepA_mal.cs | 98 ++--- impls/d/env.d | 23 +- impls/d/step2_eval.d | 39 +- impls/d/step3_env.d | 54 ++- impls/d/step4_if_fn_do.d | 60 ++- impls/d/step5_tco.d | 59 ++- impls/d/step6_file.d | 63 ++- impls/d/step7_quote.d | 68 ++- impls/d/step8_macros.d | 115 ++--- impls/d/step9_try.d | 115 ++--- impls/d/stepA_mal.d | 115 ++--- impls/dart/core.dart | 126 +++--- impls/dart/env.dart | 27 +- impls/dart/step2_eval.dart | 54 ++- impls/dart/step3_env.dart | 39 +- impls/dart/step4_if_fn_do.dart | 32 +- impls/dart/step5_tco.dart | 38 +- impls/dart/step6_file.dart | 40 +- impls/dart/step7_quote.dart | 42 +- impls/dart/step8_macros.dart | 91 ++-- impls/dart/step9_try.dart | 91 ++-- impls/dart/stepA_mal.dart | 93 ++--- impls/elisp/mal/env.el | 16 +- impls/elisp/step2_eval.el | 28 +- impls/elisp/step3_env.el | 46 +- impls/elisp/step4_if_fn_do.el | 42 +- impls/elisp/step5_tco.el | 44 +- impls/elisp/step6_file.el | 43 +- impls/elisp/step7_quote.el | 45 +- impls/elisp/step8_macros.el | 75 ++-- impls/elisp/step9_try.el | 75 ++-- impls/elisp/stepA_mal.el | 75 ++-- impls/elixir/lib/mix/tasks/step2_eval.ex | 16 +- impls/elixir/lib/mix/tasks/step3_env.ex | 21 +- impls/elixir/lib/mix/tasks/step4_if_fn_do.ex | 24 +- impls/elixir/lib/mix/tasks/step5_tco.ex | 24 +- impls/elixir/lib/mix/tasks/step6_file.ex | 24 +- impls/elixir/lib/mix/tasks/step7_quote.ex | 28 +- impls/elixir/lib/mix/tasks/step8_macros.ex | 57 +-- impls/elixir/lib/mix/tasks/step9_try.ex | 57 +-- impls/elixir/lib/mix/tasks/stepA_mal.ex | 57 +-- impls/erlang/src/step2_eval.erl | 38 +- impls/erlang/src/step3_env.erl | 43 +- impls/erlang/src/step4_if_fn_do.erl | 64 +-- impls/erlang/src/step5_tco.erl | 62 +-- impls/erlang/src/step6_file.erl | 67 +-- impls/erlang/src/step7_quote.erl | 79 ++-- impls/erlang/src/step8_macros.erl | 76 ++-- impls/erlang/src/step9_try.erl | 76 ++-- impls/erlang/src/stepA_mal.erl | 76 ++-- impls/es6/step2_eval.mjs | 15 +- impls/es6/step3_env.mjs | 23 +- impls/es6/step4_if_fn_do.mjs | 25 +- impls/es6/step5_tco.mjs | 27 +- impls/es6/step6_file.mjs | 27 +- impls/es6/step7_quote.mjs | 28 +- impls/es6/step8_macros.mjs | 43 +- impls/es6/step9_try.mjs | 43 +- impls/es6/stepA_mal.mjs | 43 +- impls/factor/step2_eval/step2_eval.factor | 33 +- impls/factor/step3_env/step3_env.factor | 49 ++- .../step4_if_fn_do/step4_if_fn_do.factor | 42 +- impls/factor/step5_tco/step5_tco.factor | 34 +- impls/factor/step6_file/step6_file.factor | 30 +- impls/factor/step7_quote/step7_quote.factor | 33 +- impls/factor/step8_macros/step8_macros.factor | 59 +-- impls/factor/step9_try/step9_try.factor | 59 +-- impls/factor/stepA_mal/stepA_mal.factor | 59 +-- impls/fennel/env.fnl | 30 +- impls/fennel/step2_eval.fnl | 28 +- impls/fennel/step3_env.fnl | 32 +- impls/fennel/step4_if_fn_do.fnl | 37 +- impls/fennel/step5_tco.fnl | 64 ++- impls/fennel/step6_file.fnl | 64 ++- impls/fennel/step7_quote.fnl | 68 ++- impls/fennel/step8_macros.fnl | 102 ++--- impls/fennel/step9_try.fnl | 102 ++--- impls/fennel/stepA_mal.fnl | 102 ++--- impls/forth/step2_eval.fs | 4 +- impls/forth/step3_env.fs | 9 +- impls/forth/step4_if_fn_do.fs | 9 +- impls/forth/step5_tco.fs | 7 +- impls/forth/step6_file.fs | 7 +- impls/forth/step7_quote.fs | 10 +- impls/forth/step8_macros.fs | 22 +- impls/forth/step9_try.fs | 22 +- impls/forth/stepA_mal.fs | 22 +- impls/forth/types.fs | 9 + impls/fsharp/env.fs | 17 +- impls/fsharp/step2_eval.fs | 22 +- impls/fsharp/step3_env.fs | 30 +- impls/fsharp/step4_if_fn_do.fs | 35 +- impls/fsharp/step5_tco.fs | 35 +- impls/fsharp/step6_file.fs | 35 +- impls/fsharp/step7_quote.fs | 37 +- impls/fsharp/step8_macros.fs | 50 +-- impls/fsharp/step9_try.fs | 50 +-- impls/fsharp/stepA_mal.fs | 50 +-- impls/gnu-smalltalk/env.st | 19 +- impls/gnu-smalltalk/step2_eval.st | 35 +- impls/gnu-smalltalk/step3_env.st | 47 ++- impls/gnu-smalltalk/step4_if_fn_do.st | 49 +-- impls/gnu-smalltalk/step5_tco.st | 51 +-- impls/gnu-smalltalk/step6_file.st | 51 +-- impls/gnu-smalltalk/step7_quote.st | 56 ++- impls/gnu-smalltalk/step8_macros.st | 110 ++--- impls/gnu-smalltalk/step9_try.st | 110 ++--- impls/gnu-smalltalk/stepA_mal.st | 110 ++--- impls/go/src/stepA_mal/stepA_mal.go | 117 ++---- impls/groovy/env.groovy | 10 +- impls/groovy/step2_eval.groovy | 17 +- impls/groovy/step3_env.groovy | 25 +- impls/groovy/step4_if_fn_do.groovy | 27 +- impls/groovy/step5_tco.groovy | 29 +- impls/groovy/step6_file.groovy | 29 +- impls/groovy/step7_quote.groovy | 31 +- impls/groovy/step8_macros.groovy | 63 +-- impls/groovy/step9_try.groovy | 63 +-- impls/groovy/stepA_mal.groovy | 63 +-- impls/guile/step2_eval.scm | 23 +- impls/guile/step3_env.scm | 26 +- impls/guile/step4_if_fn_do.scm | 23 +- impls/guile/step5_tco.scm | 23 +- impls/guile/step6_file.scm | 23 +- impls/guile/step7_quote.scm | 24 +- impls/guile/step8_macros.scm | 47 +-- impls/guile/step9_try.scm | 51 +-- impls/guile/stepA_mal.scm | 48 +-- impls/haskell/step3_env.hs | 13 +- impls/haskell/step4_if_fn_do.hs | 13 +- impls/haskell/step5_tco.hs | 13 +- impls/haskell/step6_file.hs | 13 +- impls/haskell/step7_quote.hs | 16 +- impls/haskell/step8_macros.hs | 27 +- impls/haskell/step9_try.hs | 27 +- impls/haskell/stepA_mal.hs | 27 +- impls/haxe/Step2_eval.hx | 32 +- impls/haxe/Step3_env.hx | 36 +- impls/haxe/Step4_if_fn_do.hx | 40 +- impls/haxe/Step5_tco.hx | 41 +- impls/haxe/Step6_file.hx | 41 +- impls/haxe/Step7_quote.hx | 43 +- impls/haxe/Step8_macros.hx | 77 ++-- impls/haxe/Step9_try.hx | 77 ++-- impls/haxe/StepA_mal.hx | 77 ++-- impls/haxe/env/Env.hx | 22 +- impls/haxe/tests/step5_tco.mal | 2 +- impls/java/src/main/java/mal/env.java | 19 +- impls/java/src/main/java/mal/step2_eval.java | 71 ++-- impls/java/src/main/java/mal/step3_env.java | 55 ++- .../src/main/java/mal/step4_if_fn_do.java | 63 ++- impls/java/src/main/java/mal/step5_tco.java | 68 ++- impls/java/src/main/java/mal/step6_file.java | 68 ++- impls/java/src/main/java/mal/step7_quote.java | 70 ++-- .../java/src/main/java/mal/step8_macros.java | 106 ++--- impls/java/src/main/java/mal/step9_try.java | 103 ++--- impls/java/src/main/java/mal/stepA_mal.java | 103 ++--- impls/js/env.js | 17 +- impls/js/step2_eval.js | 21 +- impls/js/step3_env.js | 43 +- impls/js/step4_if_fn_do.js | 43 +- impls/js/step5_tco.js | 46 +- impls/js/step6_file.js | 50 ++- impls/js/step7_quote.js | 52 ++- impls/js/step8_macros.js | 82 ++-- impls/js/step9_try.js | 82 ++-- impls/js/stepA_mal.js | 84 ++-- impls/julia/step2_eval.jl | 21 +- impls/julia/step3_env.jl | 27 +- impls/julia/step4_if_fn_do.jl | 29 +- impls/julia/step5_tco.jl | 33 +- impls/julia/step6_file.jl | 33 +- impls/julia/step7_quote.jl | 35 +- impls/julia/step8_macros.jl | 58 +-- impls/julia/step9_try.jl | 58 +-- impls/julia/stepA_mal.jl | 58 +-- impls/kotlin/src/mal/env.kt | 4 +- impls/kotlin/src/mal/step2_eval.kt | 26 +- impls/kotlin/src/mal/step3_env.kt | 35 +- impls/kotlin/src/mal/step4_if_fn_do.kt | 55 ++- impls/kotlin/src/mal/step5_tco.kt | 31 +- impls/kotlin/src/mal/step6_file.kt | 31 +- impls/kotlin/src/mal/step7_quote.kt | 32 +- impls/kotlin/src/mal/step8_macros.kt | 63 ++- impls/kotlin/src/mal/step9_try.kt | 63 ++- impls/kotlin/src/mal/stepA_mal.kt | 66 ++- impls/logo/core.lg | 392 +++++++----------- impls/logo/env.lg | 51 +-- impls/logo/printer.lg | 60 ++- impls/logo/reader.lg | 288 +++++-------- impls/logo/readline.lg | 6 +- impls/logo/step0_repl.lg | 21 +- impls/logo/step1_read_print.lg | 29 +- impls/logo/step2_eval.lg | 85 ++-- impls/logo/step3_env.lg | 114 ++--- impls/logo/step4_if_fn_do.lg | 166 ++++---- impls/logo/step5_tco.lg | 136 +++--- impls/logo/step6_file.lg | 140 ++++--- impls/logo/step7_quote.lg | 194 ++++----- impls/logo/step8_macros.lg | 234 +++++------ impls/logo/step9_try.lg | 257 ++++++------ impls/logo/stepA_mal.lg | 261 ++++++------ impls/logo/tests/stepA_mal.mal | 2 +- impls/logo/types.lg | 234 ++++++----- impls/make/env.mk | 10 +- impls/make/step2_eval.mk | 28 +- impls/make/step3_env.mk | 40 +- impls/make/step4_if_fn_do.mk | 40 +- impls/make/step6_file.mk | 40 +- impls/make/step7_quote.mk | 44 +- impls/make/step8_macros.mk | 73 ++-- impls/make/step9_try.mk | 73 ++-- impls/make/stepA_mal.mk | 73 ++-- impls/mal/env.mal | 12 +- impls/mal/step2_eval.mal | 46 +- impls/mal/step3_env.mal | 71 ++-- impls/mal/step4_if_fn_do.mal | 95 ++--- impls/mal/step6_file.mal | 95 ++--- impls/mal/step7_quote.mal | 110 +++-- impls/mal/step8_macros.mal | 132 +++--- impls/mal/step9_try.mal | 136 +++--- impls/mal/stepA_mal.mal | 136 +++--- impls/miniMAL/step2_eval.json | 13 +- impls/miniMAL/step3_env.json | 35 +- impls/miniMAL/step4_if_fn_do.json | 37 +- impls/miniMAL/step5_tco.json | 37 +- impls/miniMAL/step6_file.json | 37 +- impls/miniMAL/step7_quote.json | 39 +- impls/miniMAL/step8_macros.json | 67 ++- impls/miniMAL/step9_try.json | 67 ++- impls/miniMAL/stepA_mal.json | 69 ++- impls/nasm/stepA_mal.asm | 374 +++++++---------- impls/nim/env.nim | 12 +- impls/nim/step2_eval.nim | 18 +- impls/nim/step3_env.nim | 22 +- impls/nim/step4_if_fn_do.nim | 46 +- impls/nim/step5_tco.nim | 81 ++-- impls/nim/step6_file.nim | 81 ++-- impls/nim/step7_quote.nim | 85 ++-- impls/nim/step8_macros.nim | 104 ++--- impls/nim/step9_try.nim | 128 +++--- impls/nim/stepA_mal.nim | 128 +++--- impls/objpascal/mal_env.pas | 29 +- impls/objpascal/step2_eval.pas | 67 ++- impls/objpascal/step3_env.pas | 78 ++-- impls/objpascal/step4_if_fn_do.pas | 93 ++--- impls/objpascal/step5_tco.pas | 92 ++-- impls/objpascal/step6_file.pas | 92 ++-- impls/objpascal/step7_quote.pas | 96 ++--- impls/objpascal/step8_macros.pas | 149 +++---- impls/objpascal/step9_try.pas | 149 +++---- impls/objpascal/stepA_mal.pas | 149 +++---- impls/ocaml/core.ml | 128 +++--- impls/ocaml/env.ml | 30 +- impls/ocaml/printer.ml | 3 +- impls/ocaml/reader.ml | 20 +- impls/ocaml/step2_eval.ml | 18 +- impls/ocaml/step3_env.ml | 45 +- impls/ocaml/step4_if_fn_do.ml | 51 +-- impls/ocaml/step6_file.ml | 55 +-- impls/ocaml/step7_quote.ml | 73 ++-- impls/ocaml/step8_macros.ml | 100 ++--- impls/ocaml/step9_try.ml | 108 ++--- impls/ocaml/stepA_mal.ml | 108 ++--- impls/ocaml/types.ml | 3 +- impls/perl/env.pm | 18 +- impls/perl/step2_eval.pl | 24 +- impls/perl/step3_env.pl | 48 ++- impls/perl/step4_if_fn_do.pl | 42 +- impls/perl/step5_tco.pl | 39 +- impls/perl/step6_file.pl | 43 +- impls/perl/step7_quote.pl | 46 +- impls/perl/step8_macros.pl | 79 ++-- impls/perl/step9_try.pl | 80 ++-- impls/perl/stepA_mal.pl | 79 ++-- impls/perl6/env.pm | 9 +- impls/perl6/step2_eval.pl | 20 +- impls/perl6/step3_env.pl | 22 +- impls/perl6/step4_if_fn_do.pl | 23 +- impls/perl6/step5_tco.pl | 26 +- impls/perl6/step6_file.pl | 26 +- impls/perl6/step7_quote.pl | 27 +- impls/perl6/step8_macros.pl | 49 +-- impls/perl6/step9_try.pl | 49 +-- impls/perl6/stepA_mal.pl | 49 +-- impls/php/env.php | 6 +- impls/php/step2_eval.php | 23 +- impls/php/step3_env.php | 32 +- impls/php/step4_if_fn_do.php | 37 +- impls/php/step5_tco.php | 37 +- impls/php/step6_file.php | 37 +- impls/php/step7_quote.php | 39 +- impls/php/step8_macros.php | 63 +-- impls/php/step9_try.php | 63 +-- impls/php/stepA_mal.php | 63 +-- impls/picolisp/env.l | 8 +- impls/picolisp/step2_eval.l | 15 +- impls/picolisp/step3_env.l | 30 +- impls/picolisp/step4_if_fn_do.l | 30 +- impls/picolisp/step5_tco.l | 34 +- impls/picolisp/step6_file.l | 34 +- impls/picolisp/step7_quote.l | 36 +- impls/picolisp/step8_macros.l | 59 +-- impls/picolisp/step9_try.l | 59 +-- impls/picolisp/stepA_mal.l | 59 +-- impls/pike/Env.pmod | 14 +- impls/pike/step2_eval.pike | 19 +- impls/pike/step3_env.pike | 27 +- impls/pike/step4_if_fn_do.pike | 27 +- impls/pike/step5_tco.pike | 34 +- impls/pike/step6_file.pike | 34 +- impls/pike/step7_quote.pike | 36 +- impls/pike/step8_macros.pike | 61 +-- impls/pike/step9_try.pike | 61 +-- impls/pike/stepA_mal.pike | 61 +-- impls/prolog/step3_env.pl | 12 +- impls/prolog/step4_if_fn_do.pl | 12 +- impls/prolog/step6_file.pl | 12 +- impls/prolog/step7_quote.pl | 16 +- impls/prolog/step8_macros.pl | 32 +- impls/prolog/step9_try.pl | 32 +- impls/prolog/stepA_mal.pl | 32 +- impls/ps/env.ps | Bin 1437 -> 912 bytes impls/ps/step2_eval.ps | Bin 2120 -> 1910 bytes impls/ps/step3_env.ps | Bin 2699 -> 2692 bytes impls/ps/step4_if_fn_do.ps | Bin 3842 -> 4115 bytes impls/ps/step5_tco.ps | Bin 4163 -> 4265 bytes impls/ps/step6_file.ps | Bin 4672 -> 4834 bytes impls/ps/step7_quote.ps | Bin 5996 -> 6070 bytes impls/ps/step8_macros.ps | Bin 7362 -> 6768 bytes impls/ps/step9_try.ps | Bin 9215 -> 8640 bytes impls/ps/stepA_mal.ps | Bin 9655 -> 9099 bytes impls/python.2/env.py | 18 +- impls/python.2/step2_eval.py | 15 +- impls/python.2/step3_env.py | 27 +- impls/python.2/step4_if_fn_do.py | 25 +- impls/python.2/step5_tco.py | 40 +- impls/python.2/step6_file.py | 40 +- impls/python.2/step7_quote.py | 41 +- impls/python.2/step8_macros.py | 82 ++-- impls/python.2/step9_try.py | 76 ++-- impls/python.2/stepA_mal.py | 85 ++-- impls/python/env.py | 4 + impls/python/step2_eval.py | 22 +- impls/python/step3_env.py | 22 +- impls/python/step4_if_fn_do.py | 27 +- impls/python/step5_tco.py | 30 +- impls/python/step6_file.py | 30 +- impls/python/step7_quote.py | 32 +- impls/python/step8_macros.py | 48 +-- impls/python/step9_try.py | 53 +-- impls/python/stepA_mal.py | 50 +-- impls/r/step2_eval.r | 28 +- impls/r/step3_env.r | 33 +- impls/r/step4_if_fn_do.r | 39 +- impls/r/step5_tco.r | 43 +- impls/r/step6_file.r | 43 +- impls/r/step7_quote.r | 45 +- impls/r/step8_macros.r | 63 ++- impls/r/step9_try.r | 63 ++- impls/r/stepA_mal.r | 63 ++- impls/racket/env.rkt | 18 +- impls/racket/step2_eval.rkt | 20 +- impls/racket/step3_env.rkt | 31 +- impls/racket/step4_if_fn_do.rkt | 33 +- impls/racket/step5_tco.rkt | 33 +- impls/racket/step6_file.rkt | 33 +- impls/racket/step7_quote.rkt | 35 +- impls/racket/step8_macros.rkt | 56 +-- impls/racket/step9_try.rkt | 57 +-- impls/racket/stepA_mal.rkt | 57 +-- impls/rpython/stepA_mal.py | 61 +-- impls/ruby.2/env.rb | 23 +- impls/ruby.2/step2_eval.rb | 55 ++- impls/ruby.2/step3_env.rb | 53 +-- impls/ruby.2/step4_if_fn_do.rb | 53 +-- impls/ruby.2/step5_tco.rb | 68 +-- impls/ruby.2/step6_file.rb | 68 +-- impls/ruby.2/step7_quote.rb | 72 ++-- impls/ruby.2/step8_macros.rb | 113 +++-- impls/ruby.2/step9_try.rb | 119 +++--- impls/ruby.2/stepA_mal.rb | 113 ++--- impls/ruby/env.rb | 6 + impls/ruby/step2_eval.rb | 30 +- impls/ruby/step3_env.rb | 32 +- impls/ruby/step4_if_fn_do.rb | 36 +- impls/ruby/step5_tco.rb | 41 +- impls/ruby/step6_file.rb | 41 +- impls/ruby/step7_quote.rb | 43 +- impls/ruby/step8_macros.rb | 70 +--- impls/ruby/step9_try.rb | 70 +--- impls/ruby/stepA_mal.rb | 70 +--- impls/rust/env.rs | 27 +- impls/rust/step2_eval.rs | 48 +-- impls/rust/step3_env.rs | 50 +-- impls/rust/step4_if_fn_do.rs | 58 +-- impls/rust/step5_tco.rs | 62 +-- impls/rust/step6_file.rs | 62 +-- impls/rust/step7_quote.rs | 63 +-- impls/rust/step8_macros.rs | 148 +++---- impls/rust/step9_try.rs | 148 +++---- impls/rust/stepA_mal.rs | 148 +++---- impls/scheme/lib/env.sld | 12 +- impls/scheme/step2_eval.scm | 34 +- impls/scheme/step3_env.scm | 36 +- impls/scheme/step4_if_fn_do.scm | 36 +- impls/scheme/step5_tco.scm | 36 +- impls/scheme/step6_file.scm | 36 +- impls/scheme/step7_quote.scm | 37 +- impls/scheme/step8_macros.scm | 74 ++-- impls/scheme/step9_try.scm | 93 ++--- impls/scheme/stepA_mal.scm | 93 ++--- impls/skew/env.sk | 12 +- impls/skew/step2_eval.sk | 13 +- impls/skew/step3_env.sk | 21 +- impls/skew/step4_if_fn_do.sk | 27 +- impls/skew/step5_tco.sk | 31 +- impls/skew/step6_file.sk | 31 +- impls/skew/step7_quote.sk | 33 +- impls/skew/step8_macros.sk | 59 +-- impls/skew/step9_try.sk | 59 +-- impls/skew/stepA_mal.sk | 59 +-- impls/sml/step2_eval.sml | 1 + impls/sml/step3_env.sml | 18 +- impls/sml/step4_if_fn_do.sml | 18 +- impls/sml/step6_file.sml | 18 +- impls/sml/step7_quote.sml | 19 +- impls/sml/step8_macros.sml | 15 +- impls/sml/step9_try.sml | 15 +- impls/sml/stepA_mal.sml | 15 +- impls/tcl/step2_eval.tcl | 20 +- impls/tcl/step3_env.tcl | 29 +- impls/tcl/step4_if_fn_do.tcl | 34 +- impls/tcl/step5_tco.tcl | 37 +- impls/tcl/step6_file.tcl | 37 +- impls/tcl/step7_quote.tcl | 40 +- impls/tcl/step8_macros.tcl | 87 ++-- impls/tcl/step9_try.tcl | 87 ++-- impls/tcl/stepA_mal.tcl | 87 ++-- impls/tests/step3_env.mal | 20 + impls/tests/step7_quote.mal | 89 +--- impls/tests/step8_macros.mal | 25 +- impls/ts/core.ts | 6 +- impls/ts/env.ts | 40 +- impls/ts/step2_eval.ts | 25 +- impls/ts/step3_env.ts | 48 +-- impls/ts/step4_if_fn_do.ts | 45 +- impls/ts/step5_tco.ts | 42 +- impls/ts/step6_file.ts | 49 +-- impls/ts/step7_quote.ts | 49 +-- impls/ts/step8_macros.ts | 107 ++--- impls/ts/step9_try.ts | 107 ++--- impls/ts/stepA_mal.ts | 107 ++--- impls/vb/env.vb | 18 +- impls/vb/step2_eval.vb | 40 +- impls/vb/step3_env.vb | 47 ++- impls/vb/step4_if_fn_do.vb | 74 ++-- impls/vb/step5_tco.vb | 71 ++-- impls/vb/step6_file.vb | 71 ++-- impls/vb/step7_quote.vb | 75 ++-- impls/vb/step8_macros.vb | 117 ++---- impls/vb/step9_try.vb | 117 ++---- impls/vb/stepA_mal.vb | 117 ++---- impls/vb/types.vb | 8 +- impls/vhdl/env.vhdl | 42 +- impls/vhdl/pkg_readline.vhdl | 1 + impls/vhdl/step2_eval.vhdl | 49 ++- impls/vhdl/step3_env.vhdl | 63 +-- impls/vhdl/step4_if_fn_do.vhdl | 62 +-- impls/vhdl/step5_tco.vhdl | 69 +-- impls/vhdl/step6_file.vhdl | 83 ++-- impls/vhdl/step7_quote.vhdl | 87 ++-- impls/vhdl/step8_macros.vhdl | 142 +++---- impls/vhdl/step9_try.vhdl | 142 +++---- impls/vhdl/stepA_mal.vhdl | 142 +++---- impls/vimscript/env.vim | 23 +- impls/vimscript/step2_eval.vim | 17 +- impls/vimscript/step3_env.vim | 26 +- impls/vimscript/step4_if_fn_do.vim | 33 +- impls/vimscript/step5_tco.vim | 51 ++- impls/vimscript/step6_file.vim | 51 ++- impls/vimscript/step7_quote.vim | 53 +-- impls/vimscript/step8_macros.vim | 92 ++-- impls/vimscript/step9_try.vim | 92 ++-- impls/vimscript/stepA_mal.vim | 92 ++-- impls/wren/step2_eval.wren | 14 +- impls/wren/step3_env.wren | 17 +- impls/wren/step4_if_fn_do.wren | 21 +- impls/wren/step5_tco.wren | 22 +- impls/wren/step6_file.wren | 22 +- impls/wren/step7_quote.wren | 24 +- impls/wren/step8_macros.wren | 53 +-- impls/wren/step9_try.wren | 53 +-- impls/wren/stepA_mal.wren | 53 +-- impls/yorick/step2_eval.i | 26 +- impls/yorick/step3_env.i | 25 +- impls/yorick/step4_if_fn_do.i | 25 +- impls/yorick/step5_tco.i | 27 +- impls/yorick/step6_file.i | 27 +- impls/yorick/step7_quote.i | 29 +- impls/yorick/step8_macros.i | 95 ++--- impls/yorick/step9_try.i | 95 ++--- impls/yorick/stepA_mal.i | 95 ++--- process/guide.md | 144 ++++--- process/step2_eval.txt | 22 +- process/step3_env.txt | 34 +- process/step4_if_fn_do.txt | 49 ++- process/step5_tco.txt | 52 ++- process/step6_file.txt | 52 ++- process/step7_quote.txt | 56 +-- process/step8_macros.txt | 68 +-- process/step9_try.txt | 75 ++-- process/stepA_mal.txt | 75 ++-- 636 files changed, 15016 insertions(+), 19721 deletions(-) diff --git a/IMPLS.yml b/IMPLS.yml index f89b099b56..db69bcbfb6 100644 --- a/IMPLS.yml +++ b/IMPLS.yml @@ -49,7 +49,7 @@ IMPL: - {IMPL: julia} - {IMPL: kotlin} - {IMPL: livescript} - - {IMPL: logo, NO_SELF_HOST: 1} # step4 timeout + - {IMPL: logo} - {IMPL: lua} - {IMPL: make, NO_SELF_HOST: 1} # step4 timeout - {IMPL: mal, MAL_IMPL: js, BUILD_IMPL: js, NO_SELF_HOST: 1} diff --git a/Makefile.impls b/Makefile.impls index 6ac35b23e5..831bbcc7d2 100644 --- a/Makefile.impls +++ b/Makefile.impls @@ -43,7 +43,6 @@ IMPLS = ada ada.2 awk bash basic bbc-basic c c.2 chuck clojure coffee common-lis step5_EXCLUDES += bash # never completes at 10,000 step5_EXCLUDES += basic # too slow, and limited to ints of 2^16 -step5_EXCLUDES += logo # too slow for 10,000 step5_EXCLUDES += make # no TCO capability (iteration or recursion) step5_EXCLUDES += mal # host impl dependent step5_EXCLUDES += matlab # never completes at 10,000 diff --git a/impls/ada.2/envs.adb b/impls/ada.2/envs.adb index 8638b92513..3383b9c0ab 100644 --- a/impls/ada.2/envs.adb +++ b/impls/ada.2/envs.adb @@ -53,6 +53,25 @@ package body Envs is 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 diff --git a/impls/ada.2/envs.ads b/impls/ada.2/envs.ads index e6652dbcab..e9870e2eb0 100644 --- a/impls/ada.2/envs.ads +++ b/impls/ada.2/envs.ads @@ -27,6 +27,9 @@ package Envs is 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; diff --git a/impls/ada.2/step2_eval.adb b/impls/ada.2/step2_eval.adb index 7eadeb6990..7d5ab79dd4 100644 --- a/impls/ada.2/step2_eval.adb +++ b/impls/ada.2/step2_eval.adb @@ -1,4 +1,3 @@ -with Ada.Environment_Variables; with Ada.Containers.Indefinite_Hashed_Maps; with Ada.Strings.Hash; with Ada.Text_IO.Unbounded_IO; @@ -14,8 +13,6 @@ with Types.Strings; procedure Step2_Eval is - Dbgeval : constant Boolean := Ada.Environment_Variables.Exists ("dbgeval"); - use type Types.T; use all type Types.Kind_Type; @@ -52,12 +49,8 @@ procedure Step2_Eval is is First : Types.T; begin - if Dbgeval then - Ada.Text_IO.New_Line; - Ada.Text_IO.Put ("EVAL: "); - Print (Ast); - end if; - + -- 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 => diff --git a/impls/ada.2/step3_env.adb b/impls/ada.2/step3_env.adb index cee5987d7a..b428ab2300 100644 --- a/impls/ada.2/step3_env.adb +++ b/impls/ada.2/step3_env.adb @@ -1,4 +1,3 @@ -with Ada.Environment_Variables; with Ada.Text_IO.Unbounded_IO; with Envs; @@ -13,7 +12,7 @@ with Types.Strings; procedure Step3_Env is - Dbgeval : constant Boolean := Ada.Environment_Variables.Exists ("dbgeval"); + Dbgeval : constant Types.String_Ptr := Types.Strings.Alloc ("DEBUG-EVAL"); use type Types.T; use all type Types.Kind_Type; @@ -45,8 +44,7 @@ procedure Step3_Env is is First : Types.T; begin - if Dbgeval then - Ada.Text_IO.New_Line; + if Types.To_Boolean (Env.all.Get_Or_Nil (Dbgeval)) then Ada.Text_IO.Put ("EVAL: "); Print (Ast); Envs.Dump_Stack (Env.all); @@ -209,6 +207,7 @@ begin -- Collect garbage. Err.Data := Types.Nil; Repl.all.Keep; + Dbgeval.Keep; Garbage_Collected.Clean; end loop; Ada.Text_IO.New_Line; diff --git a/impls/ada.2/step4_if_fn_do.adb b/impls/ada.2/step4_if_fn_do.adb index 687e1c2e27..3de6c7cc27 100644 --- a/impls/ada.2/step4_if_fn_do.adb +++ b/impls/ada.2/step4_if_fn_do.adb @@ -1,4 +1,3 @@ -with Ada.Environment_Variables; with Ada.Text_IO.Unbounded_IO; with Core; @@ -15,7 +14,7 @@ with Types.Strings; procedure Step4_If_Fn_Do is - Dbgeval : constant Boolean := Ada.Environment_Variables.Exists ("dbgeval"); + Dbgeval : constant Types.String_Ptr := Types.Strings.Alloc ("DEBUG-EVAL"); use type Types.T; use all type Types.Kind_Type; @@ -47,8 +46,7 @@ procedure Step4_If_Fn_Do is is First : Types.T; begin - if Dbgeval then - Ada.Text_IO.New_Line; + if Types.To_Boolean (Env.all.Get_Or_Nil (Dbgeval)) then Ada.Text_IO.Put ("EVAL: "); Print (Ast); Envs.Dump_Stack (Env.all); @@ -81,17 +79,13 @@ procedure Step4_If_Fn_Do is if First.Str.all = "if" then Err.Check (Ast.Sequence.all.Length in 3 .. 4, "expected 2 or 3 parameters"); - declare - Tst : constant Types.T := Eval (Ast.Sequence.all.Data (2), Env); - begin - if Tst /= Types.Nil and Tst /= (Kind_Boolean, False) 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; - end; + 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, @@ -251,6 +245,7 @@ begin -- Collect garbage. Err.Data := Types.Nil; Repl.all.Keep; + Dbgeval.Keep; Garbage_Collected.Clean; end loop; Ada.Text_IO.New_Line; diff --git a/impls/ada.2/step5_tco.adb b/impls/ada.2/step5_tco.adb index b69dbe3853..18754079b8 100644 --- a/impls/ada.2/step5_tco.adb +++ b/impls/ada.2/step5_tco.adb @@ -1,4 +1,3 @@ -with Ada.Environment_Variables; with Ada.Text_IO.Unbounded_IO; with Core; @@ -15,7 +14,7 @@ with Types.Strings; procedure Step5_Tco is - Dbgeval : constant Boolean := Ada.Environment_Variables.Exists ("dbgeval"); + Dbgeval : constant Types.String_Ptr := Types.Strings.Alloc ("DEBUG-EVAL"); use type Types.T; use all type Types.Kind_Type; @@ -56,8 +55,7 @@ procedure Step5_Tco is First : Types.T; begin <> - if Dbgeval then - Ada.Text_IO.New_Line; + if Types.To_Boolean (Env.all.Get_Or_Nil (Dbgeval)) then Ada.Text_IO.Put ("EVAL: "); Print (Ast); Envs.Dump_Stack (Env.all); @@ -90,19 +88,15 @@ procedure Step5_Tco is if First.Str.all = "if" then Err.Check (Ast.Sequence.all.Length in 3 .. 4, "expected 2 or 3 parameters"); - declare - Tst : constant Types.T := Eval (Ast.Sequence.all.Data (2), Env); - begin - if Tst /= Types.Nil and Tst /= (Kind_Boolean, False) 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; - end; + 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, @@ -284,6 +278,7 @@ begin -- Collect garbage. Err.Data := Types.Nil; Repl.all.Keep; + Dbgeval.Keep; Garbage_Collected.Clean; end loop; Ada.Text_IO.New_Line; diff --git a/impls/ada.2/step6_file.adb b/impls/ada.2/step6_file.adb index 18cc6a92e8..45cce5d679 100644 --- a/impls/ada.2/step6_file.adb +++ b/impls/ada.2/step6_file.adb @@ -1,5 +1,4 @@ with Ada.Command_Line; -with Ada.Environment_Variables; with Ada.Text_IO.Unbounded_IO; with Core; @@ -16,7 +15,7 @@ with Types.Strings; procedure Step6_File is - Dbgeval : constant Boolean := Ada.Environment_Variables.Exists ("dbgeval"); + Dbgeval : constant Types.String_Ptr := Types.Strings.Alloc ("DEBUG-EVAL"); use type Types.T; use all type Types.Kind_Type; @@ -60,8 +59,7 @@ procedure Step6_File is First : Types.T; begin <> - if Dbgeval then - Ada.Text_IO.New_Line; + if Types.To_Boolean (Env.all.Get_Or_Nil (Dbgeval)) then Ada.Text_IO.Put ("EVAL: "); Print (Ast); Envs.Dump_Stack (Env.all); @@ -94,19 +92,15 @@ procedure Step6_File is if First.Str.all = "if" then Err.Check (Ast.Sequence.all.Length in 3 .. 4, "expected 2 or 3 parameters"); - declare - Tst : constant Types.T := Eval (Ast.Sequence.all.Data (2), Env); - begin - if Tst /= Types.Nil and Tst /= (Kind_Boolean, False) 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; - end; + 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, @@ -310,6 +304,7 @@ begin -- Collect garbage. Err.Data := Types.Nil; Repl.all.Keep; + Dbgeval.Keep; Garbage_Collected.Clean; end loop; Ada.Text_IO.New_Line; diff --git a/impls/ada.2/step7_quote.adb b/impls/ada.2/step7_quote.adb index 94182fb1b7..dc134f13fc 100644 --- a/impls/ada.2/step7_quote.adb +++ b/impls/ada.2/step7_quote.adb @@ -1,5 +1,4 @@ with Ada.Command_Line; -with Ada.Environment_Variables; with Ada.Text_IO.Unbounded_IO; with Core; @@ -16,7 +15,7 @@ with Types.Strings; procedure Step7_Quote is - Dbgeval : constant Boolean := Ada.Environment_Variables.Exists ("dbgeval"); + Dbgeval : constant Types.String_Ptr := Types.Strings.Alloc ("DEBUG-EVAL"); use type Types.T; use all type Types.Kind_Type; @@ -62,8 +61,7 @@ procedure Step7_Quote is First : Types.T; begin <> - if Dbgeval then - Ada.Text_IO.New_Line; + if Types.To_Boolean (Env.all.Get_Or_Nil (Dbgeval)) then Ada.Text_IO.Put ("EVAL: "); Print (Ast); Envs.Dump_Stack (Env.all); @@ -96,19 +94,15 @@ procedure Step7_Quote is if First.Str.all = "if" then Err.Check (Ast.Sequence.all.Length in 3 .. 4, "expected 2 or 3 parameters"); - declare - Tst : constant Types.T := Eval (Ast.Sequence.all.Data (2), Env); - begin - if Tst /= Types.Nil and Tst /= (Kind_Boolean, False) 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; - end; + 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, @@ -167,9 +161,6 @@ procedure Step7_Quote is Ast => Ast.Sequence.all.Data (3), Env => Env)); end; - elsif First.Str.all = "quasiquoteexpand" then - Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); - return Quasiquote (Ast.Sequence.all.Data (2)); elsif First.Str.all = "quasiquote" then Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); Ast := Quasiquote (Ast.Sequence.all.Data (2)); @@ -379,6 +370,7 @@ begin -- Collect garbage. Err.Data := Types.Nil; Repl.all.Keep; + Dbgeval.Keep; Garbage_Collected.Clean; end loop; Ada.Text_IO.New_Line; diff --git a/impls/ada.2/step8_macros.adb b/impls/ada.2/step8_macros.adb index 1f7951b2d4..98c7e7022a 100644 --- a/impls/ada.2/step8_macros.adb +++ b/impls/ada.2/step8_macros.adb @@ -1,5 +1,4 @@ with Ada.Command_Line; -with Ada.Environment_Variables; with Ada.Text_IO.Unbounded_IO; with Core; @@ -16,7 +15,7 @@ with Types.Strings; procedure Step8_Macros is - Dbgeval : constant Boolean := Ada.Environment_Variables.Exists ("dbgeval"); + Dbgeval : constant Types.String_Ptr := Types.Strings.Alloc ("DEBUG-EVAL"); use type Types.T; use all type Types.Kind_Type; @@ -59,12 +58,10 @@ procedure Step8_Macros is -- True when the environment has been created in this recursion -- level, and has not yet been referenced by a closure. If so, -- we can reuse it instead of creating a subenvironment. - Macroexpanding : Boolean := False; First : Types.T; begin <> - if Dbgeval then - Ada.Text_IO.New_Line; + if Types.To_Boolean (Env.all.Get_Or_Nil (Dbgeval)) then Ada.Text_IO.Put ("EVAL: "); Print (Ast); Envs.Dump_Stack (Env.all); @@ -97,19 +94,15 @@ procedure Step8_Macros is if First.Str.all = "if" then Err.Check (Ast.Sequence.all.Length in 3 .. 4, "expected 2 or 3 parameters"); - declare - Tst : constant Types.T := Eval (Ast.Sequence.all.Data (2), Env); - begin - if Tst /= Types.Nil and Tst /= (Kind_Boolean, False) 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; - end; + 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, @@ -183,14 +176,6 @@ procedure Step8_Macros is Ast => Ast.Sequence.all.Data (3), Env => Env)); end; - elsif First.Str.all = "macroexpand" then - Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); - Macroexpanding := True; - Ast := Ast.Sequence.all.Data (2); - goto Restart; - elsif First.Str.all = "quasiquoteexpand" then - Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); - return Quasiquote (Ast.Sequence.all.Data (2)); elsif First.Str.all = "quasiquote" then Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); Ast := Quasiquote (Ast.Sequence.all.Data (2)); @@ -217,24 +202,10 @@ procedure Step8_Macros is case First.Kind is when Kind_Macro => -- Use the unevaluated arguments. - if Macroexpanding then - -- Evaluate the macro with tail call optimization. - if not Env_Reusable then - Env := Envs.New_Env (Outer => First.Fn.all.Env); - Env_Reusable := True; - end if; - Env.all.Set_Binds - (Binds => First.Fn.all.Params.all.Data, - Exprs => Ast.Sequence.all.Data (2 .. Ast.Sequence.all.Length)); - Ast := First.Fn.all.Ast; - goto Restart; - else - -- Evaluate the macro normally. - Ast := First.Fn.all.Apply - (Ast.Sequence.all.Data (2 .. Ast.Sequence.all.Length)); - -- Then evaluate the result with TCO. - goto Restart; - end if; + 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 => @@ -260,11 +231,7 @@ procedure Step8_Macros is end; exception when Err.Error => - if Macroexpanding then - Err.Add_Trace_Line ("macroexpand", Ast); - else - Err.Add_Trace_Line ("eval", Ast); - end if; + Err.Add_Trace_Line ("eval", Ast); raise; end Eval; @@ -434,6 +401,7 @@ begin -- Collect garbage. Err.Data := Types.Nil; Repl.all.Keep; + Dbgeval.Keep; Garbage_Collected.Clean; end loop; Ada.Text_IO.New_Line; diff --git a/impls/ada.2/step9_try.adb b/impls/ada.2/step9_try.adb index 333c7adf12..7ae8b4afcc 100644 --- a/impls/ada.2/step9_try.adb +++ b/impls/ada.2/step9_try.adb @@ -1,5 +1,4 @@ with Ada.Command_Line; -with Ada.Environment_Variables; with Ada.Text_IO.Unbounded_IO; with Core; @@ -16,7 +15,7 @@ with Types.Strings; procedure Step9_Try is - Dbgeval : constant Boolean := Ada.Environment_Variables.Exists ("dbgeval"); + Dbgeval : constant Types.String_Ptr := Types.Strings.Alloc ("DEBUG-EVAL"); use type Types.T; use all type Types.Kind_Type; @@ -59,12 +58,10 @@ procedure Step9_Try is -- True when the environment has been created in this recursion -- level, and has not yet been referenced by a closure. If so, -- we can reuse it instead of creating a subenvironment. - Macroexpanding : Boolean := False; First : Types.T; begin <> - if Dbgeval then - Ada.Text_IO.New_Line; + if Types.To_Boolean (Env.all.Get_Or_Nil (Dbgeval)) then Ada.Text_IO.Put ("EVAL: "); Print (Ast); Envs.Dump_Stack (Env.all); @@ -97,19 +94,15 @@ procedure Step9_Try is if First.Str.all = "if" then Err.Check (Ast.Sequence.all.Length in 3 .. 4, "expected 2 or 3 parameters"); - declare - Tst : constant Types.T := Eval (Ast.Sequence.all.Data (2), Env); - begin - if Tst /= Types.Nil and Tst /= (Kind_Boolean, False) 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; - end; + 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, @@ -183,14 +176,6 @@ procedure Step9_Try is Ast => Ast.Sequence.all.Data (3), Env => Env)); end; - elsif First.Str.all = "macroexpand" then - Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); - Macroexpanding := True; - Ast := Ast.Sequence.all.Data (2); - goto Restart; - elsif First.Str.all = "quasiquoteexpand" then - Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); - return Quasiquote (Ast.Sequence.all.Data (2)); elsif First.Str.all = "quasiquote" then Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); Ast := Quasiquote (Ast.Sequence.all.Data (2)); @@ -247,24 +232,10 @@ procedure Step9_Try is case First.Kind is when Kind_Macro => -- Use the unevaluated arguments. - if Macroexpanding then - -- Evaluate the macro with tail call optimization. - if not Env_Reusable then - Env := Envs.New_Env (Outer => First.Fn.all.Env); - Env_Reusable := True; - end if; - Env.all.Set_Binds - (Binds => First.Fn.all.Params.all.Data, - Exprs => Ast.Sequence.all.Data (2 .. Ast.Sequence.all.Length)); - Ast := First.Fn.all.Ast; - goto Restart; - else - -- Evaluate the macro normally. - Ast := First.Fn.all.Apply - (Ast.Sequence.all.Data (2 .. Ast.Sequence.all.Length)); - -- Then evaluate the result with TCO. - goto Restart; - end if; + 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 => @@ -290,11 +261,7 @@ procedure Step9_Try is end; exception when Err.Error => - if Macroexpanding then - Err.Add_Trace_Line ("macroexpand", Ast); - else - Err.Add_Trace_Line ("eval", Ast); - end if; + Err.Add_Trace_Line ("eval", Ast); raise; end Eval; @@ -464,6 +431,7 @@ begin -- Collect garbage. Err.Data := Types.Nil; Repl.all.Keep; + Dbgeval.Keep; Garbage_Collected.Clean; end loop; Ada.Text_IO.New_Line; diff --git a/impls/ada.2/stepa_mal.adb b/impls/ada.2/stepa_mal.adb index 59a1ad7fd1..e790871c0f 100644 --- a/impls/ada.2/stepa_mal.adb +++ b/impls/ada.2/stepa_mal.adb @@ -1,5 +1,4 @@ with Ada.Command_Line; -with Ada.Environment_Variables; with Ada.Text_IO.Unbounded_IO; with Core; @@ -17,7 +16,7 @@ with Types.Strings; procedure StepA_Mal is - Dbgeval : constant Boolean := Ada.Environment_Variables.Exists ("dbgeval"); + Dbgeval : constant Types.String_Ptr := Types.Strings.Alloc ("DEBUG-EVAL"); use type Types.T; use all type Types.Kind_Type; @@ -60,12 +59,10 @@ procedure StepA_Mal is -- True when the environment has been created in this recursion -- level, and has not yet been referenced by a closure. If so, -- we can reuse it instead of creating a subenvironment. - Macroexpanding : Boolean := False; First : Types.T; begin <> - if Dbgeval then - Ada.Text_IO.New_Line; + if Types.To_Boolean (Env.all.Get_Or_Nil (Dbgeval)) then Ada.Text_IO.Put ("EVAL: "); Print (Ast); Envs.Dump_Stack (Env.all); @@ -98,19 +95,15 @@ procedure StepA_Mal is if First.Str.all = "if" then Err.Check (Ast.Sequence.all.Length in 3 .. 4, "expected 2 or 3 parameters"); - declare - Tst : constant Types.T := Eval (Ast.Sequence.all.Data (2), Env); - begin - if Tst /= Types.Nil and Tst /= (Kind_Boolean, False) 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; - end; + 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, @@ -184,14 +177,6 @@ procedure StepA_Mal is Ast => Ast.Sequence.all.Data (3), Env => Env)); end; - elsif First.Str.all = "macroexpand" then - Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); - Macroexpanding := True; - Ast := Ast.Sequence.all.Data (2); - goto Restart; - elsif First.Str.all = "quasiquoteexpand" then - Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); - return Quasiquote (Ast.Sequence.all.Data (2)); elsif First.Str.all = "quasiquote" then Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); Ast := Quasiquote (Ast.Sequence.all.Data (2)); @@ -248,24 +233,10 @@ procedure StepA_Mal is case First.Kind is when Kind_Macro => -- Use the unevaluated arguments. - if Macroexpanding then - -- Evaluate the macro with tail call optimization. - if not Env_Reusable then - Env := Envs.New_Env (Outer => First.Fn.all.Env); - Env_Reusable := True; - end if; - Env.all.Set_Binds - (Binds => First.Fn.all.Params.all.Data, - Exprs => Ast.Sequence.all.Data (2 .. Ast.Sequence.all.Length)); - Ast := First.Fn.all.Ast; - goto Restart; - else - -- Evaluate the macro normally. - Ast := First.Fn.all.Apply - (Ast.Sequence.all.Data (2 .. Ast.Sequence.all.Length)); - -- Then evaluate the result with TCO. - goto Restart; - end if; + 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 => @@ -296,11 +267,7 @@ procedure StepA_Mal is end; exception when Err.Error => - if Macroexpanding then - Err.Add_Trace_Line ("macroexpand", Ast); - else - Err.Add_Trace_Line ("eval", Ast); - end if; + Err.Add_Trace_Line ("eval", Ast); raise; end Eval; @@ -472,6 +439,7 @@ begin -- Collect garbage. Err.Data := Types.Nil; Repl.all.Keep; + Dbgeval.Keep; Garbage_Collected.Clean; end loop; Ada.Text_IO.New_Line; diff --git a/impls/ada.2/types.adb b/impls/ada.2/types.adb index 6b0ebf0a53..1f6ddb9df9 100644 --- a/impls/ada.2/types.adb +++ b/impls/ada.2/types.adb @@ -55,4 +55,10 @@ package body Types is 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 index 011288b6cd..4a26248d00 100644 --- a/impls/ada.2/types.ads +++ b/impls/ada.2/types.ads @@ -83,6 +83,8 @@ package Types is 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; diff --git a/impls/ada/step2_eval.adb b/impls/ada/step2_eval.adb index 6f0e281d8a..5ef3304e4d 100644 --- a/impls/ada/step2_eval.adb +++ b/impls/ada/step2_eval.adb @@ -109,6 +109,19 @@ procedure Step2_Eval is 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 @@ -129,27 +142,10 @@ procedure Step2_Eval is 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 + 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; @@ -169,12 +165,10 @@ procedure Step2_Eval is 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 case; + when others => -- not a list, map, symbol or vector + return Param; + end case; end Eval; diff --git a/impls/ada/step3_env.adb b/impls/ada/step3_env.adb index cca59b36f9..d5469c046a 100644 --- a/impls/ada/step3_env.adb +++ b/impls/ada/step3_env.adb @@ -65,8 +65,6 @@ procedure Step3_Env is 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 @@ -112,6 +110,31 @@ procedure Step3_Env is 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 @@ -132,27 +155,10 @@ procedure Step3_Env is 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 + 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; @@ -184,12 +190,10 @@ procedure Step3_Env is end; - else -- Not a List_List - - return Eval_Ast (Param, Env); - - end if; - + end case; + when others => -- not a list, map, symbol or vector + return Param; + end case; end Eval; @@ -244,12 +248,6 @@ begin -- 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); diff --git a/impls/ada/step4_if_fn_do.adb b/impls/ada/step4_if_fn_do.adb index d41e9bc084..a86c6e7d8c 100644 --- a/impls/ada/step4_if_fn_do.adb +++ b/impls/ada/step4_if_fn_do.adb @@ -102,6 +102,23 @@ procedure Step4_If_Fn_Do is 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 @@ -122,27 +139,10 @@ procedure Step4_If_Fn_Do is 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 + 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; @@ -234,12 +234,10 @@ procedure Step4_If_Fn_Do is end if; - else -- Not a List_List - - return Eval_Ast (Param, Env); - - end if; - + end case; + when others => -- not a list, map, symbol or vector + return Param; + end case; end Eval; diff --git a/impls/ada/step5_tco.adb b/impls/ada/step5_tco.adb index 2234b21309..e0b2eb0299 100644 --- a/impls/ada/step5_tco.adb +++ b/impls/ada/step5_tco.adb @@ -71,6 +71,31 @@ procedure Step5_TCO is 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 @@ -91,35 +116,10 @@ procedure Step5_TCO is 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 + 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; @@ -278,12 +278,10 @@ procedure Step5_TCO is end if; - else -- Not a List_List - - return Eval_Ast (Param, Env); - - end if; - + end case; + when others => -- not a list, map, symbol or vector + return Param; + end case; end Eval; diff --git a/impls/ada/step6_file.adb b/impls/ada/step6_file.adb index a02969cc68..3d800856c1 100644 --- a/impls/ada/step6_file.adb +++ b/impls/ada/step6_file.adb @@ -74,6 +74,33 @@ procedure Step6_File is 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 @@ -94,35 +121,10 @@ procedure Step6_File is 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 + 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; @@ -281,12 +283,10 @@ procedure Step6_File is end if; - else -- not a List_List - - return Eval_Ast (Param, Env); - - end if; - + end case; + when others => -- not a list, map, symbol or vector + return Param; + end case; end Eval; diff --git a/impls/ada/step7_quote.adb b/impls/ada/step7_quote.adb index 52babdae9f..6250c5966f 100644 --- a/impls/ada/step7_quote.adb +++ b/impls/ada/step7_quote.adb @@ -71,33 +71,8 @@ procedure Step7_Quote is 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; - + 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 @@ -190,12 +165,34 @@ procedure Step7_Quote is <> - if Debug then - Ada.Text_IO.Put_Line ("Evaling " & Deref (Param).To_String); - end if; + 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; - if Deref (Param).Sym_Type = List and then - Deref_List (Param).Get_List_Type = List_List then + 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; @@ -305,11 +302,6 @@ procedure Step7_Quote is return Car (Rest_List); - elsif Deref (First_Param).Sym_Type = Sym and then - Deref_Sym (First_Param).Get_Sym = "quasiquoteexpand" then - - return Quasi_Quote_Processing (Car (Rest_List)); - elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "quasiquote" then @@ -370,12 +362,10 @@ procedure Step7_Quote is end if; - else -- not a List_List - - return Eval_Ast (Param, Env); - - end if; - + end case; + when others => -- not a list, map, symbol or vector + return Param; + end case; end Eval; diff --git a/impls/ada/step8_macros.adb b/impls/ada/step8_macros.adb index 5c6a0a1199..c25d4f62f2 100644 --- a/impls/ada/step8_macros.adb +++ b/impls/ada/step8_macros.adb @@ -59,52 +59,6 @@ procedure Step8_Macros is 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; - - 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, Env); - - 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 (LP.Get_Env); - - 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 @@ -137,33 +91,8 @@ procedure Step8_Macros is 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; - + 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 @@ -256,18 +185,34 @@ procedure Step8_Macros is <> - 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; + 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; - if Deref (Param).Sym_Type = List and then - Deref_List (Param).Get_List_Type = List_List then + 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; @@ -286,9 +231,6 @@ procedure Step8_Macros is 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 @@ -383,11 +325,6 @@ procedure Step8_Macros is return Car (Rest_List); - elsif Deref (First_Param).Sym_Type = Sym and then - Deref_Sym (First_Param).Get_Sym = "quasiquoteexpand" then - - return Quasi_Quote_Processing (Car (Rest_List)); - elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "quasiquote" then @@ -397,18 +334,10 @@ procedure Step8_Macros is 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; + 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 @@ -421,6 +350,16 @@ procedure Step8_Macros is 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; @@ -444,16 +383,12 @@ procedure Step8_Macros is raise Runtime_Exception with "Deref called on non-Func/Lambda"; end if; - end; - end if; - else -- not a List_List - - return Eval_Ast (Param, Env); - - end if; - + end case; + when others => -- not a list, map, symbol or vector + return Param; + end case; end Eval; diff --git a/impls/ada/step9_try.adb b/impls/ada/step9_try.adb index 2d52272ae5..f249276726 100644 --- a/impls/ada/step9_try.adb +++ b/impls/ada/step9_try.adb @@ -59,52 +59,6 @@ procedure Step9_Try is 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; - - 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, Env); - - 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 (LP.Get_Env); - - 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 @@ -137,33 +91,8 @@ procedure Step9_Try is 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; - + 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 @@ -282,18 +211,34 @@ procedure Step9_Try is <> - 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; + 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; - if Deref (Param).Sym_Type = List and then - Deref_List (Param).Get_List_Type = List_List then + 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; @@ -312,9 +257,6 @@ procedure Step9_Try is 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 @@ -409,11 +351,6 @@ procedure Step9_Try is return Car (Rest_List); - elsif Deref (First_Param).Sym_Type = Sym and then - Deref_Sym (First_Param).Get_Sym = "quasiquoteexpand" then - - return Quasi_Quote_Processing (Car (Rest_List)); - elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "quasiquote" then @@ -450,18 +387,10 @@ procedure Step9_Try is 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; + 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 @@ -474,6 +403,16 @@ procedure Step9_Try is 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; @@ -497,16 +436,12 @@ procedure Step9_Try is raise Runtime_Exception with "Deref called on non-Func/Lambda"; end if; - end; - end if; - else -- not a List_List - - return Eval_Ast (Param, Env); - - end if; - + end case; + when others => -- not a list, map, symbol or vector + return Param; + end case; end Eval; diff --git a/impls/ada/stepa_mal.adb b/impls/ada/stepa_mal.adb index 1d0b71fd60..ff5807bf2f 100644 --- a/impls/ada/stepa_mal.adb +++ b/impls/ada/stepa_mal.adb @@ -59,53 +59,6 @@ procedure StepA_Mal is 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; - - 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, Env); - - 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 (LP.Get_Env); - - 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 @@ -138,33 +91,8 @@ procedure StepA_Mal is 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; - + 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 @@ -283,18 +211,34 @@ procedure StepA_Mal is <> - 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; + 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; - if Deref (Param).Sym_Type = List and then - Deref_List (Param).Get_List_Type = List_List then + 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; @@ -313,9 +257,6 @@ procedure StepA_Mal is 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 @@ -410,11 +351,6 @@ procedure StepA_Mal is return Car (Rest_List); - elsif Deref (First_Param).Sym_Type = Sym and then - Deref_Sym (First_Param).Get_Sym = "quasiquoteexpand" then - - return Quasi_Quote_Processing (Car (Rest_List)); - elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "quasiquote" then @@ -451,18 +387,10 @@ procedure StepA_Mal is 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; + 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 @@ -475,6 +403,16 @@ procedure StepA_Mal is 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; @@ -498,16 +436,12 @@ procedure StepA_Mal is raise Runtime_Exception with "Deref called on non-Func/Lambda"; end if; - end; - end if; - else -- not a List_List - - return Eval_Ast (Param, Env); - - end if; - + end case; + when others => -- not a list, map, symbol or vector + return Param; + end case; end Eval; diff --git a/impls/ada/types.adb b/impls/ada/types.adb index 29b8d2b181..0107a8dddb 100644 --- a/impls/ada/types.adb +++ b/impls/ada/types.adb @@ -141,40 +141,6 @@ package body Types is 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 @@ -1072,41 +1038,6 @@ package body Types is 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 diff --git a/impls/ada/types.ads b/impls/ada/types.ads index 8329453bca..5084d28bcb 100644 --- a/impls/ada/types.ads +++ b/impls/ada/types.ads @@ -51,8 +51,6 @@ package Types is 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 @@ -297,8 +295,6 @@ package Types is 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 diff --git a/impls/awk/step2_eval.awk b/impls/awk/step2_eval.awk index 145a7cf44c..8b56497d46 100644 --- a/impls/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/impls/awk/step3_env.awk b/impls/awk/step3_env.awk index 203ef50a45..8c771e5513 100644 --- a/impls/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) "." } diff --git a/impls/awk/step4_if_fn_do.awk b/impls/awk/step4_if_fn_do.awk index f05112a415..c7a7808546 100644 --- a/impls/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 /^\$/: diff --git a/impls/awk/step5_tco.awk b/impls/awk/step5_tco.awk index 43810458bc..482d593d29 100644 --- a/impls/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 } } } diff --git a/impls/awk/step6_file.awk b/impls/awk/step6_file.awk index 369bd0557b..e42483df4e 100644 --- a/impls/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 } } } diff --git a/impls/awk/step7_quote.awk b/impls/awk/step7_quote.awk index c089c03fa1..e112e99889 100644 --- a/impls/awk/step7_quote.awk +++ b/impls/awk/step7_quote.awk @@ -89,19 +89,20 @@ function quasiquote(ast, new_idx, ret, ast_idx, elt_i, elt, previous) } 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 @@ -112,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]) { @@ -126,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) @@ -293,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"] @@ -329,15 +358,6 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_env) types_release(ast) env_release(env) return body - case "'quasiquoteexpand": - env_release(env) - if (len != 2) { - types_release(ast) - return "!\"Invalid argument length for 'quasiquoteexpand'. Expects exactly 1 argument, supplied " (len - 1) "." - } - types_addref(body = types_heap[idx][1]) - types_release(ast) - return quasiquote(body) case "'quasiquote": if (len != 2) { types_release(ast) @@ -368,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) @@ -375,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 /^\$/: @@ -385,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 /^&/: @@ -393,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 } } } diff --git a/impls/awk/step8_macros.awk b/impls/awk/step8_macros.awk index ca20cc123b..289cd68180 100644 --- a/impls/awk/step8_macros.awk +++ b/impls/awk/step8_macros.awk @@ -88,52 +88,21 @@ function quasiquote(ast, new_idx, ret, ast_idx, elt_i, elt, previous) return "(" new_idx } -function is_macro_call(ast, env, idx, len, sym, f) -{ - if (ast !~ /^\(/) return 0 - idx = substr(ast, 2) - len = types_heap[idx]["len"] - if (len == 0) return 0 - sym = types_heap[idx][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 @@ -144,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]) { @@ -158,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) @@ -368,33 +337,50 @@ 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 !~ /^\(/) { - 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) @@ -415,15 +401,6 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_env) types_release(ast) env_release(env) return body - case "'quasiquoteexpand": - env_release(env) - if (len != 2) { - types_release(ast) - return "!\"Invalid argument length for 'quasiquoteexpand'. Expects exactly 1 argument, supplied " (len - 1) "." - } - types_addref(body = types_heap[idx][1]) - types_release(ast) - return quasiquote(body) case "'quasiquote": if (len != 2) { types_release(ast) @@ -440,17 +417,6 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_env) 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 ~ /^!/) { @@ -467,32 +433,61 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_env) 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 } } } diff --git a/impls/awk/step9_try.awk b/impls/awk/step9_try.awk index d0c4a16d2b..336bbafb41 100644 --- a/impls/awk/step9_try.awk +++ b/impls/awk/step9_try.awk @@ -88,52 +88,21 @@ function quasiquote(ast, new_idx, ret, ast_idx, elt_i, elt, previous) return "(" new_idx } -function is_macro_call(ast, env, idx, len, sym, f) -{ - if (ast !~ /^\(/) return 0 - idx = substr(ast, 2) - len = types_heap[idx]["len"] - if (len == 0) return 0 - sym = types_heap[idx][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 @@ -144,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]) { @@ -158,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) @@ -426,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) @@ -469,15 +455,6 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret types_release(ast) env_release(env) return body - case "'quasiquoteexpand": - env_release(env) - if (len != 2) { - types_release(ast) - return "!\"Invalid argument length for 'quasiquoteexpand'. Expects exactly 1 argument, supplied " (len - 1) "." - } - types_addref(body = types_heap[idx][1]) - types_release(ast) - return quasiquote(body) case "'quasiquote": if (len != 2) { types_release(ast) @@ -494,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 != "") { @@ -529,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 } } } diff --git a/impls/awk/stepA_mal.awk b/impls/awk/stepA_mal.awk index 045d483a98..40ee32b677 100644 --- a/impls/awk/stepA_mal.awk +++ b/impls/awk/stepA_mal.awk @@ -88,52 +88,21 @@ function quasiquote(ast, new_idx, ret, ast_idx, elt_i, elt, previous) return "(" new_idx } -function is_macro_call(ast, env, idx, len, sym, f) -{ - if (ast !~ /^\(/) return 0 - idx = substr(ast, 2) - len = types_heap[idx]["len"] - if (len == 0) return 0 - sym = types_heap[idx][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 @@ -144,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]) { @@ -158,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) @@ -426,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) @@ -469,15 +455,6 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret types_release(ast) env_release(env) return body - case "'quasiquoteexpand": - env_release(env) - if (len != 2) { - types_release(ast) - return "!\"Invalid argument length for 'quasiquoteexpand'. Expects exactly 1 argument, supplied " (len - 1) "." - } - types_addref(body = types_heap[idx][1]) - types_release(ast) - return quasiquote(body) case "'quasiquote": if (len != 2) { types_release(ast) @@ -494,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 != "") { @@ -529,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 } } } diff --git a/impls/bash/step2_eval.sh b/impls/bash/step2_eval.sh index 15083b937e..54d75885c3 100755 --- a/impls/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,27 +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 - 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/impls/bash/step3_env.sh b/impls/bash/step3_env.sh index 2200c8362c..ba46e54306 100755 --- a/impls/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,22 +42,12 @@ 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 @@ -71,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/impls/bash/step4_if_fn_do.sh b/impls/bash/step4_if_fn_do.sh index e701e9fb25..24b45965fd 100755 --- a/impls/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,22 +43,12 @@ 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 @@ -73,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 ;; @@ -95,7 +95,7 @@ EVAL () { 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/impls/bash/step5_tco.sh b/impls/bash/step5_tco.sh index e7eda09a7b..5e30751000 100755 --- a/impls/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,23 +45,12 @@ 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 @@ -77,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}" @@ -104,7 +105,7 @@ EVAL () { 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/impls/bash/step6_file.sh b/impls/bash/step6_file.sh index 4d430883e8..b87cbc1986 100755 --- a/impls/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,23 +45,12 @@ 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 @@ -77,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}" @@ -104,7 +105,7 @@ EVAL () { 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/impls/bash/step7_quote.sh b/impls/bash/step7_quote.sh index f6076fc85a..dc046f9fc2 100755 --- a/impls/bash/step7_quote.sh +++ b/impls/bash/step7_quote.sh @@ -55,18 +55,30 @@ qqIter () { fi } -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}" @@ -76,22 +88,12 @@ 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}'" - if ! _list? "${ast}"; then - EVAL_AST "${ast}" "${env}" - return - fi # apply list _empty? "${ast}" && r="${ast}" && return @@ -120,9 +122,6 @@ EVAL () { quote) r="${a1}" return ;; - quasiquoteexpand) - QUASIQUOTE "${a1}" - return ;; quasiquote) QUASIQUOTE "${a1}" ast="${r}" @@ -130,7 +129,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}" @@ -157,7 +156,7 @@ EVAL () { 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/impls/bash/step8_macros.sh b/impls/bash/step8_macros.sh index 2a632c89b7..64710610e2 100755 --- a/impls/bash/step8_macros.sh +++ b/impls/bash/step8_macros.sh @@ -55,45 +55,30 @@ qqIter () { fi } -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 -} +_symbol DEBUG-EVAL; debug_eval="$r" -MACROEXPAND () { +EVAL () { 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}" -} + 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 -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}" ;; + _map_with_type _vector EVAL "${ast}" "${env}" + return ;; hash_map) local res="" key= val="" hm="${ANON["${ast}"]}" _hash_map; local new_hm="${r}" @@ -103,30 +88,14 @@ 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}'" - 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}" @@ -153,9 +122,6 @@ EVAL () { quote) r="${a1}" return ;; - quasiquoteexpand) - QUASIQUOTE "${a1}" - return ;; quasiquote) QUASIQUOTE "${a1}" ast="${r}" @@ -170,12 +136,9 @@ EVAL () { 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}" + _map_with_type _list EVAL "${r}" "${env}" [[ "${__ERROR}" ]] && r= && return 1 _last "${ast}" ast="${r}" @@ -202,11 +165,27 @@ EVAL () { EVAL \"${a2}\" \"\${r}\"" \ "${a2}" "${env}" "${a1}" return ;; - *) EVAL_AST "${ast}" "${env}" + *) 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 - local el="${r}" - _first "${el}"; local f="${ANON["${r}"]}" - _rest "${el}"; local args="${ANON["${r}"]}" + args="${ANON["${r}"]}" + #echo "invoke: [${f}] ${args}" if [[ "${f//@/ }" != "${f}" ]]; then set -- ${f//@/ } diff --git a/impls/bash/step9_try.sh b/impls/bash/step9_try.sh index 7b824e847c..bc6336ac34 100755 --- a/impls/bash/step9_try.sh +++ b/impls/bash/step9_try.sh @@ -55,45 +55,30 @@ qqIter () { fi } -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 -} +_symbol DEBUG-EVAL; debug_eval="$r" -MACROEXPAND () { +EVAL () { 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}" -} + 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 -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}" ;; + _map_with_type _vector EVAL "${ast}" "${env}" + return ;; hash_map) local res="" key= val="" hm="${ANON["${ast}"]}" _hash_map; local new_hm="${r}" @@ -103,30 +88,14 @@ 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}'" - 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}" @@ -153,9 +122,6 @@ EVAL () { quote) r="${a1}" return ;; - quasiquoteexpand) - QUASIQUOTE "${a1}" - return ;; quasiquote) QUASIQUOTE "${a1}" ast="${r}" @@ -170,9 +136,6 @@ EVAL () { ANON["${r}_ismacro_"]="yes" ENV_SET "${env}" "${a1}" "${r}" return ;; - macroexpand) - MACROEXPAND "${a1}" "${env}" - return ;; try__STAR__) EVAL "${a1}" "${env}" [[ -z "${__ERROR}" ]] && return _nth "${a2}" 0; local a20="${r}" @@ -188,7 +151,7 @@ EVAL () { return ;; 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}" @@ -215,11 +178,27 @@ EVAL () { EVAL \"${a2}\" \"\${r}\"" \ "${a2}" "${env}" "${a1}" return ;; - *) EVAL_AST "${ast}" "${env}" + *) 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 - local el="${r}" - _first "${el}"; local f="${ANON["${r}"]}" - _rest "${el}"; local args="${ANON["${r}"]}" + args="${ANON["${r}"]}" + #echo "invoke: [${f}] ${args}" if [[ "${f//@/ }" != "${f}" ]]; then set -- ${f//@/ } diff --git a/impls/bash/stepA_mal.sh b/impls/bash/stepA_mal.sh index df1543cfa5..f65b4b1db2 100755 --- a/impls/bash/stepA_mal.sh +++ b/impls/bash/stepA_mal.sh @@ -55,45 +55,30 @@ qqIter () { fi } -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 -} +_symbol DEBUG-EVAL; debug_eval="$r" -MACROEXPAND () { +EVAL () { 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}" -} + 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 -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}" ;; + _map_with_type _vector EVAL "${ast}" "${env}" + return ;; hash_map) local res="" key= val="" hm="${ANON["${ast}"]}" _hash_map; local new_hm="${r}" @@ -103,30 +88,14 @@ 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}'" - 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}" @@ -153,9 +122,6 @@ EVAL () { quote) r="${a1}" return ;; - quasiquoteexpand) - QUASIQUOTE "${a1}" - return ;; quasiquote) QUASIQUOTE "${a1}" ast="${r}" @@ -170,9 +136,6 @@ EVAL () { ANON["${r}_ismacro_"]="yes" ENV_SET "${env}" "${a1}" "${r}" return ;; - macroexpand) - MACROEXPAND "${a1}" "${env}" - return ;; sh__STAR__) EVAL "${a1}" "${env}" local output="" local line="" @@ -198,7 +161,7 @@ EVAL () { return ;; 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}" @@ -225,11 +188,27 @@ EVAL () { EVAL \"${a2}\" \"\${r}\"" \ "${a2}" "${env}" "${a1}" return ;; - *) EVAL_AST "${ast}" "${env}" + *) 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 - local el="${r}" - _first "${el}"; local f="${ANON["${r}"]}" - _rest "${el}"; local args="${ANON["${r}"]}" + args="${ANON["${r}"]}" + #echo "invoke: [${f}] ${args}" if [[ "${f//@/ }" != "${f}" ]]; then set -- ${f//@/ } diff --git a/impls/bbc-basic/env.bas b/impls/bbc-basic/env.bas index c588a2f491..43fc219b27 100644 --- a/impls/bbc-basic/env.bas +++ b/impls/bbc-basic/env.bas @@ -1,39 +1,36 @@ REM > env library for mal in BBC BASIC DEF FNnew_env(outer%, binds%, exprs%) - LOCAL env% + LOCAL env%, key$ env% = FNalloc_environment(outer%) WHILE NOT FNis_empty(binds%) - IF FNunbox_symbol(FNfirst(binds%)) = "&" THEN - PROCenv_set(env%, FNnth(binds%, 1), FNas_list(exprs%)) + 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%, FNfirst(binds%), FNfirst(exprs%)) + PROCenv_set(env%, key$, FNfirst(exprs%)) binds% = FNrest(binds%) : exprs% = FNrest(exprs%) ENDIF ENDWHILE =env% -DEF PROCenv_set(env%, keysym%, val%) +DEF PROCenv_set(env%, key$, val%) LOCAL data% data% = FNenvironment_data(env%) - data% = FNhashmap_set(data%, FNunbox_symbol(keysym%), val%) + data% = FNhashmap_set(data%, key$, val%) PROCenvironment_set_data(env%, data%) ENDPROC -DEF FNenv_find(env%, keysym%) - LOCAL val%, outer%, key$ - key$ = FNunbox_symbol(keysym%) +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%, keysym%) - LOCAL key$ - env% = FNenv_find(env%, keysym%) - key$ = FNunbox_symbol(keysym%) +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$) diff --git a/impls/bbc-basic/step2_eval.bas b/impls/bbc-basic/step2_eval.bas index 837b632c8b..1e76d3927b 100644 --- a/impls/bbc-basic/step2_eval.bas +++ b/impls/bbc-basic/step2_eval.bas @@ -30,10 +30,28 @@ DEF FNREAD(a$) =FNread_str(FNalloc_string(a$)) DEF FNEVAL(ast%, env%) - IF NOT FNis_list(ast%) THEN =FNeval_ast(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% - ast% = FNeval_ast(ast%, env%) -=FNcore_call(FNunbox_corefn(FNfirst(ast%)), FNrest(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)) @@ -42,30 +60,8 @@ DEF FNrep(a$) =FNPRINT(FNEVAL(FNREAD(a$), repl_env%)) DEF FNeval_ast(ast%, env%) - LOCAL val%, car%, cdr%, map%, keys%, key$ - 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_seq(ast%) THEN IF FNis_empty(ast%) THEN =ast% - car% = FNEVAL(FNfirst(ast%), env%) - cdr% = FNeval_ast(FNrest(ast%), env%) - IF FNis_vector(ast%) THEN =FNalloc_vector_pair(car%, cdr%) - =FNalloc_pair(car%, cdr%) - ENDIF - IF FNis_hashmap(ast%) THEN - map% = FNempty_hashmap - keys% = FNhashmap_keys(ast%) - WHILE NOT FNis_empty(keys%) - key$ = FNunbox_string(FNfirst(keys%)) - map% = FNhashmap_set(map%, key$, FNEVAL(FNhashmap_get(ast%, key$), env%)) - keys% = FNrest(keys%) - ENDWHILE - =map% - ENDIF -=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. diff --git a/impls/bbc-basic/step3_env.bas b/impls/bbc-basic/step3_env.bas index 864f17b5ba..0892117ba3 100644 --- a/impls/bbc-basic/step3_env.bas +++ b/impls/bbc-basic/step3_env.bas @@ -9,10 +9,10 @@ PROCtypes_init REM These correspond with the CASE statement in FNcore_call repl_env% = FNalloc_environment(FNnil) -PROCenv_set(repl_env%, FNalloc_symbol("+"), FNalloc_corefn(0)) -PROCenv_set(repl_env%, FNalloc_symbol("-"), FNalloc_corefn(1)) -PROCenv_set(repl_env%, FNalloc_symbol("*"), FNalloc_corefn(2)) -PROCenv_set(repl_env%, FNalloc_symbol("/"), FNalloc_corefn(3)) +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 @@ -31,31 +31,53 @@ DEF FNREAD(a$) =FNread_str(FNalloc_string(a$)) DEF FNEVAL(ast%, env%) - LOCAL car% - IF NOT FNis_list(ast%) THEN =FNeval_ast(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 - CASE FNunbox_symbol(car%) OF + key$ = FNunbox_symbol(car%) + CASE key$ OF REM Special forms WHEN "def!" - LOCAL val% - val% = FNEVAL(FNnth(ast%, 2), env%) - PROCenv_set(env%, FNnth(ast%, 1), val%) - =val% + val% = FNEVAL(FNnth(ast%, 2), env%) + PROCenv_set(env%, FNunbox_symbol(FNnth(ast%, 1)), val%) + =val% WHEN "let*" - LOCAL bindings% - env% = FNalloc_environment(env%) - bindings% = FNnth(ast%, 1) - WHILE NOT FNis_empty(bindings%) - PROCenv_set(env%, FNfirst(bindings%), FNEVAL(FNnth(bindings%, 1), env%)) - bindings% = FNrest(FNrest(bindings%)) - ENDWHILE - =FNEVAL(FNnth(ast%, 2), env%) + 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 - ast% = FNeval_ast(ast%, env%) -=FNcore_call(FNunbox_corefn(FNfirst(ast%)), FNrest(ast%)) + 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)) @@ -64,26 +86,8 @@ DEF FNrep(a$) =FNPRINT(FNEVAL(FNREAD(a$), repl_env%)) DEF FNeval_ast(ast%, env%) - LOCAL val%, car%, cdr%, map%, keys%, key$ - IF FNis_symbol(ast%) THEN =FNenv_get(env%, ast%) - IF FNis_seq(ast%) THEN IF FNis_empty(ast%) THEN =ast% - car% = FNEVAL(FNfirst(ast%), env%) - cdr% = FNeval_ast(FNrest(ast%), env%) - IF FNis_vector(ast%) THEN =FNalloc_vector_pair(car%, cdr%) - =FNalloc_pair(car%, cdr%) - ENDIF - IF FNis_hashmap(ast%) THEN - map% = FNempty_hashmap - keys% = FNhashmap_keys(ast%) - WHILE NOT FNis_empty(keys%) - key$ = FNunbox_string(FNfirst(keys%)) - map% = FNhashmap_set(map%, key$, FNEVAL(FNhashmap_get(ast%, key$), env%)) - keys% = FNrest(keys%) - ENDWHILE - =map% - ENDIF -=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. diff --git a/impls/bbc-basic/step4_if_fn_do.bas b/impls/bbc-basic/step4_if_fn_do.bas index 0e22c5b043..8ed4898840 100644 --- a/impls/bbc-basic/step4_if_fn_do.bas +++ b/impls/bbc-basic/step4_if_fn_do.bas @@ -13,7 +13,7 @@ PROCcore_ns : REM This sets the data pointer REPEAT READ sym$, i% IF sym$ <> "" THEN - PROCenv_set(repl_env%, FNalloc_symbol(sym$), FNalloc_corefn(i%)) + PROCenv_set(repl_env%, sym$, FNalloc_corefn(i%)) ENDIF UNTIL sym$ = "" @@ -41,54 +41,72 @@ DEF FNEVAL(ast%, env%) =FNgc_exit(FNEVAL_(ast%, env%)) DEF FNEVAL_(ast%, env%) - LOCAL car% - IF NOT FNis_list(ast%) THEN =FNeval_ast(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 - CASE FNunbox_symbol(car%) OF + key$ = FNunbox_symbol(car%) + CASE key$ OF REM Special forms WHEN "def!" - LOCAL val% - val% = FNEVAL(FNnth(ast%, 2), env%) - PROCenv_set(env%, FNnth(ast%, 1), val%) - =val% + val% = FNEVAL(FNnth(ast%, 2), env%) + PROCenv_set(env%, FNunbox_symbol(FNnth(ast%, 1)), val%) + =val% WHEN "let*" - LOCAL bindings% - env% = FNalloc_environment(env%) - bindings% = FNnth(ast%, 1) - WHILE NOT FNis_empty(bindings%) - PROCenv_set(env%, FNfirst(bindings%), FNEVAL(FNnth(bindings%, 1), env%)) - bindings% = FNrest(FNrest(bindings%)) - ENDWHILE - =FNEVAL(FNnth(ast%, 2), env%) + 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" - LOCAL val% - ast% = FNeval_ast(FNrest(ast%), env%) - REPEAT - val% = FNfirst(ast%) - ast% = FNrest(ast%) - UNTIL FNis_empty(ast%) - =val% + 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%) - ENDIF - IF FNcount(ast%) = 3 THEN =FNnil - =FNEVAL(FNnth(ast%, 3), env%) + 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%) + =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 - ast% = FNeval_ast(ast%, env%) - car% = FNfirst(ast%) IF FNis_fn(car%) THEN - env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), FNrest(ast%)) + env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), ast%) =FNEVAL(FNfn_ast(car%), env%) ENDIF - IF FNis_corefn(car%) THEN - =FNcore_call(FNunbox_corefn(car%), FNrest(ast%)) - ENDIF ERROR &40E80918, "Not a function" DEF FNPRINT(a%) @@ -98,26 +116,8 @@ DEF FNrep(a$) =FNPRINT(FNEVAL(FNREAD(a$), repl_env%)) DEF FNeval_ast(ast%, env%) - LOCAL val%, car%, cdr%, map%, keys%, key$ - IF FNis_symbol(ast%) THEN =FNenv_get(env%, ast%) - IF FNis_seq(ast%) THEN IF FNis_empty(ast%) THEN =ast% - car% = FNEVAL(FNfirst(ast%), env%) - cdr% = FNeval_ast(FNrest(ast%), env%) - IF FNis_vector(ast%) THEN =FNalloc_vector_pair(car%, cdr%) - =FNalloc_pair(car%, cdr%) - ENDIF - IF FNis_hashmap(ast%) THEN - map% = FNempty_hashmap - keys% = FNhashmap_keys(ast%) - WHILE NOT FNis_empty(keys%) - key$ = FNunbox_string(FNfirst(keys%)) - map% = FNhashmap_set(map%, key$, FNEVAL(FNhashmap_get(ast%, key$), env%)) - keys% = FNrest(keys%) - ENDWHILE - =map% - ENDIF -=ast% + =FNalloc_pair(FNEVAL(FNfirst(ast%), env%), FNeval_ast(FNrest(ast%), env%)) REM Local Variables: REM indent-tabs-mode: nil diff --git a/impls/bbc-basic/step5_tco.bas b/impls/bbc-basic/step5_tco.bas index 746c4cd0a3..2a3674e536 100644 --- a/impls/bbc-basic/step5_tco.bas +++ b/impls/bbc-basic/step5_tco.bas @@ -13,7 +13,7 @@ PROCcore_ns : REM This sets the data pointer REPEAT READ sym$, i% IF sym$ <> "" THEN - PROCenv_set(repl_env%, FNalloc_symbol(sym$), FNalloc_corefn(i%)) + PROCenv_set(repl_env%, sym$, FNalloc_corefn(i%)) ENDIF UNTIL sym$ = "" @@ -40,30 +40,47 @@ DEF FNEVAL(ast%, env%) =FNgc_exit(FNEVAL_(ast%, env%)) DEF FNEVAL_(ast%, env%) - LOCAL car%, specialform%, val%, bindings% - REPEAT + LOCAL car%, val%, bindings%, key$ +31416 REM tail call optimization loop PROCgc_keep_only2(ast%, env%) - IF NOT FNis_list(ast%) THEN =FNeval_ast(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%) - specialform% = FALSE + IF FNis_vector(ast%) THEN =FNalloc_vector_pair(FNEVAL(car%, env%), FNeval_ast(FNrest(ast%), env%)) IF FNis_symbol(car%) THEN - specialform% = TRUE - CASE FNunbox_symbol(car%) OF + key$ = FNunbox_symbol(car%) + CASE key$ OF REM Special forms WHEN "def!" val% = FNEVAL(FNnth(ast%, 2), env%) - PROCenv_set(env%, FNnth(ast%, 1), 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%, FNfirst(bindings%), FNEVAL(FNnth(bindings%, 1), env%)) + PROCenv_set(env%, FNunbox_symbol(FNfirst(bindings%)), FNEVAL(FNnth(bindings%, 1), env%)) bindings% = FNrest(FNrest(bindings%)) ENDWHILE ast% = FNnth(ast%, 2) - REM Loop round for tail-call optimisation. + 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 @@ -75,35 +92,34 @@ DEF FNEVAL_(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 ELSE ast% = FNnth(ast%, 3) + IF FNcount(ast%) = 3 THEN =FNnil + ast% = FNnth(ast%, 3) ENDIF - REM Loop round for tail-call optimisation. + GOTO 31416 WHEN "fn*" =FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%) OTHERWISE - specialform% = FALSE + car% = FNenv_get(env%, key$) ENDCASE + ELSE + car% = FNEVAL(car%, env%) ENDIF - IF NOT specialform% THEN - REM This is the "apply" part. - ast% = FNeval_ast(ast%, env%) - car% = FNfirst(ast%) - IF FNis_corefn(car%) THEN - =FNcore_call(FNunbox_corefn(car%), FNrest(ast%)) - ENDIF - IF FNis_fn(car%) THEN - env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), FNrest(ast%)) - ast% = FNfn_ast(car%) - REM Loop round for tail-call optimisation. - ELSE - ERROR &40E80918, "Not a function" - 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 - UNTIL FALSE + ERROR &40E80918, "Not a function" DEF FNPRINT(a%) =FNunbox_string(FNpr_str(a%, TRUE)) @@ -112,26 +128,8 @@ DEF FNrep(a$) =FNPRINT(FNEVAL(FNREAD(a$), repl_env%)) DEF FNeval_ast(ast%, env%) - LOCAL val%, car%, cdr%, map%, keys%, key$ - IF FNis_symbol(ast%) THEN =FNenv_get(env%, ast%) - IF FNis_seq(ast%) THEN IF FNis_empty(ast%) THEN =ast% - car% = FNEVAL(FNfirst(ast%), env%) - cdr% = FNeval_ast(FNrest(ast%), env%) - IF FNis_vector(ast%) THEN =FNalloc_vector_pair(car%, cdr%) - =FNalloc_pair(car%, cdr%) - ENDIF - IF FNis_hashmap(ast%) THEN - map% = FNempty_hashmap - keys% = FNhashmap_keys(ast%) - WHILE NOT FNis_empty(keys%) - key$ = FNunbox_string(FNfirst(keys%)) - map% = FNhashmap_set(map%, key$, FNEVAL(FNhashmap_get(ast%, key$), env%)) - keys% = FNrest(keys%) - ENDWHILE - =map% - ENDIF -=ast% + =FNalloc_pair(FNEVAL(FNfirst(ast%), env%), FNeval_ast(FNrest(ast%), env%)) REM Local Variables: REM indent-tabs-mode: nil diff --git a/impls/bbc-basic/step6_file.bas b/impls/bbc-basic/step6_file.bas index 6c682b2178..15d6788f59 100644 --- a/impls/bbc-basic/step6_file.bas +++ b/impls/bbc-basic/step6_file.bas @@ -13,7 +13,7 @@ PROCcore_ns : REM This sets the data pointer REPEAT READ sym$, i% IF sym$ <> "" THEN - PROCenv_set(repl_env%, FNalloc_symbol(sym$), FNalloc_corefn(i%)) + PROCenv_set(repl_env%, sym$, FNalloc_corefn(i%)) ENDIF UNTIL sym$ = "" @@ -30,9 +30,9 @@ UNTIL form$ = "" argv% = FNget_argv IF FNis_empty(argv%) THEN - PROCenv_set(repl_env%, FNalloc_symbol("*ARGV*"), FNempty) + PROCenv_set(repl_env%, "*ARGV*", FNempty) ELSE - PROCenv_set(repl_env%, FNalloc_symbol("*ARGV*"), FNrest(argv%)) + PROCenv_set(repl_env%, "*ARGV*", FNrest(argv%)) val$ = FNrep("(load-file " + FNunbox_string(FNpr_str(FNfirst(argv%), TRUE)) + ")") END ENDIF @@ -58,30 +58,47 @@ DEF FNEVAL(ast%, env%) =FNgc_exit(FNEVAL_(ast%, env%)) DEF FNEVAL_(ast%, env%) - LOCAL car%, specialform%, val%, bindings% - REPEAT + LOCAL car%, val%, bindings%, key$ +31416 REM tail call optimization loop PROCgc_keep_only2(ast%, env%) - IF NOT FNis_list(ast%) THEN =FNeval_ast(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%) - specialform% = FALSE + IF FNis_vector(ast%) THEN =FNalloc_vector_pair(FNEVAL(car%, env%), FNeval_ast(FNrest(ast%), env%)) IF FNis_symbol(car%) THEN - specialform% = TRUE - CASE FNunbox_symbol(car%) OF + key$ = FNunbox_symbol(car%) + CASE key$ OF REM Special forms WHEN "def!" val% = FNEVAL(FNnth(ast%, 2), env%) - PROCenv_set(env%, FNnth(ast%, 1), 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%, FNfirst(bindings%), FNEVAL(FNnth(bindings%, 1), env%)) + PROCenv_set(env%, FNunbox_symbol(FNfirst(bindings%)), FNEVAL(FNnth(bindings%, 1), env%)) bindings% = FNrest(FNrest(bindings%)) ENDWHILE ast% = FNnth(ast%, 2) - REM Loop round for tail-call optimisation. + 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 @@ -93,35 +110,34 @@ DEF FNEVAL_(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 ELSE ast% = FNnth(ast%, 3) + IF FNcount(ast%) = 3 THEN =FNnil + ast% = FNnth(ast%, 3) ENDIF - REM Loop round for tail-call optimisation. + GOTO 31416 WHEN "fn*" =FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%) OTHERWISE - specialform% = FALSE + car% = FNenv_get(env%, key$) ENDCASE + ELSE + car% = FNEVAL(car%, env%) ENDIF - IF NOT specialform% THEN - REM This is the "apply" part. - ast% = FNeval_ast(ast%, env%) - car% = FNfirst(ast%) - IF FNis_corefn(car%) THEN - =FNcore_call(FNunbox_corefn(car%), FNrest(ast%)) - ENDIF - IF FNis_fn(car%) THEN - env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), FNrest(ast%)) - ast% = FNfn_ast(car%) - REM Loop round for tail-call optimisation. - ELSE - ERROR &40E80918, "Not a function" - 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 - UNTIL FALSE + ERROR &40E80918, "Not a function" DEF FNPRINT(a%) =FNunbox_string(FNpr_str(a%, TRUE)) @@ -130,26 +146,8 @@ DEF FNrep(a$) =FNPRINT(FNEVAL(FNREAD(a$), repl_env%)) DEF FNeval_ast(ast%, env%) - LOCAL val%, car%, cdr%, map%, keys%, key$ - IF FNis_symbol(ast%) THEN =FNenv_get(env%, ast%) - IF FNis_seq(ast%) THEN IF FNis_empty(ast%) THEN =ast% - car% = FNEVAL(FNfirst(ast%), env%) - cdr% = FNeval_ast(FNrest(ast%), env%) - IF FNis_vector(ast%) THEN =FNalloc_vector_pair(car%, cdr%) - =FNalloc_pair(car%, cdr%) - ENDIF - IF FNis_hashmap(ast%) THEN - map% = FNempty_hashmap - keys% = FNhashmap_keys(ast%) - WHILE NOT FNis_empty(keys%) - key$ = FNunbox_string(FNfirst(keys%)) - map% = FNhashmap_set(map%, key$, FNEVAL(FNhashmap_get(ast%, key$), env%)) - keys% = FNrest(keys%) - ENDWHILE - =map% - ENDIF -=ast% + =FNalloc_pair(FNEVAL(FNfirst(ast%), env%), FNeval_ast(FNrest(ast%), env%)) DEF FNget_argv PROCgc_enter diff --git a/impls/bbc-basic/step7_quote.bas b/impls/bbc-basic/step7_quote.bas index 5d3fdb1b42..6c0278b533 100644 --- a/impls/bbc-basic/step7_quote.bas +++ b/impls/bbc-basic/step7_quote.bas @@ -13,7 +13,7 @@ PROCcore_ns : REM This sets the data pointer REPEAT READ sym$, i% IF sym$ <> "" THEN - PROCenv_set(repl_env%, FNalloc_symbol(sym$), FNalloc_corefn(i%)) + PROCenv_set(repl_env%, sym$, FNalloc_corefn(i%)) ENDIF UNTIL sym$ = "" @@ -30,9 +30,9 @@ UNTIL form$ = "" argv% = FNget_argv IF FNis_empty(argv%) THEN - PROCenv_set(repl_env%, FNalloc_symbol("*ARGV*"), FNempty) + PROCenv_set(repl_env%, "*ARGV*", FNempty) ELSE - PROCenv_set(repl_env%, FNalloc_symbol("*ARGV*"), FNrest(argv%)) + PROCenv_set(repl_env%, "*ARGV*", FNrest(argv%)) val$ = FNrep("(load-file " + FNunbox_string(FNpr_str(FNfirst(argv%), TRUE)) + ")") END ENDIF @@ -86,30 +86,47 @@ DEF FNEVAL(ast%, env%) =FNgc_exit(FNEVAL_(ast%, env%)) DEF FNEVAL_(ast%, env%) - LOCAL car%, specialform%, val%, bindings% - REPEAT + LOCAL car%, val%, bindings%, key$ +31416 REM tail call optimization loop PROCgc_keep_only2(ast%, env%) - IF NOT FNis_list(ast%) THEN =FNeval_ast(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%) - specialform% = FALSE + IF FNis_vector(ast%) THEN =FNalloc_vector_pair(FNEVAL(car%, env%), FNeval_ast(FNrest(ast%), env%)) IF FNis_symbol(car%) THEN - specialform% = TRUE - CASE FNunbox_symbol(car%) OF + key$ = FNunbox_symbol(car%) + CASE key$ OF REM Special forms WHEN "def!" val% = FNEVAL(FNnth(ast%, 2), env%) - PROCenv_set(env%, FNnth(ast%, 1), 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%, FNfirst(bindings%), FNEVAL(FNnth(bindings%, 1), env%)) + PROCenv_set(env%, FNunbox_symbol(FNfirst(bindings%)), FNEVAL(FNnth(bindings%, 1), env%)) bindings% = FNrest(FNrest(bindings%)) ENDWHILE ast% = FNnth(ast%, 2) - REM Loop round for tail-call optimisation. + 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 @@ -121,42 +138,39 @@ DEF FNEVAL_(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 ELSE ast% = FNnth(ast%, 3) + IF FNcount(ast%) = 3 THEN =FNnil + ast% = FNnth(ast%, 3) ENDIF - REM Loop round for tail-call optimisation. + GOTO 31416 WHEN "fn*" =FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%) WHEN "quote" =FNnth(ast%, 1) - WHEN "quasiquoteexpand" - = FNquasiquote(FNnth(ast%, 1)) WHEN "quasiquote" ast% = FNquasiquote(FNnth(ast%, 1)) - REM Loop round for tail-call optimisation + GOTO 31416 OTHERWISE - specialform% = FALSE + car% = FNenv_get(env%, key$) ENDCASE + ELSE + car% = FNEVAL(car%, env%) ENDIF - IF NOT specialform% THEN - REM This is the "apply" part. - ast% = FNeval_ast(ast%, env%) - car% = FNfirst(ast%) - IF FNis_corefn(car%) THEN - =FNcore_call(FNunbox_corefn(car%), FNrest(ast%)) - ENDIF - IF FNis_fn(car%) THEN - env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), FNrest(ast%)) - ast% = FNfn_ast(car%) - REM Loop round for tail-call optimisation. - ELSE - ERROR &40E80918, "Not a function" - 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 - UNTIL FALSE + ERROR &40E80918, "Not a function" DEF FNPRINT(a%) =FNunbox_string(FNpr_str(a%, TRUE)) @@ -165,26 +179,8 @@ DEF FNrep(a$) =FNPRINT(FNEVAL(FNREAD(a$), repl_env%)) DEF FNeval_ast(ast%, env%) - LOCAL val%, car%, cdr%, map%, keys%, key$ - IF FNis_symbol(ast%) THEN =FNenv_get(env%, ast%) - IF FNis_seq(ast%) THEN IF FNis_empty(ast%) THEN =ast% - car% = FNEVAL(FNfirst(ast%), env%) - cdr% = FNeval_ast(FNrest(ast%), env%) - IF FNis_vector(ast%) THEN =FNalloc_vector_pair(car%, cdr%) - =FNalloc_pair(car%, cdr%) - ENDIF - IF FNis_hashmap(ast%) THEN - map% = FNempty_hashmap - keys% = FNhashmap_keys(ast%) - WHILE NOT FNis_empty(keys%) - key$ = FNunbox_string(FNfirst(keys%)) - map% = FNhashmap_set(map%, key$, FNEVAL(FNhashmap_get(ast%, key$), env%)) - keys% = FNrest(keys%) - ENDWHILE - =map% - ENDIF -=ast% + =FNalloc_pair(FNEVAL(FNfirst(ast%), env%), FNeval_ast(FNrest(ast%), env%)) DEF FNget_argv PROCgc_enter diff --git a/impls/bbc-basic/step8_macros.bas b/impls/bbc-basic/step8_macros.bas index 5f50ab2854..59b2164865 100644 --- a/impls/bbc-basic/step8_macros.bas +++ b/impls/bbc-basic/step8_macros.bas @@ -13,7 +13,7 @@ PROCcore_ns : REM This sets the data pointer REPEAT READ sym$, i% IF sym$ <> "" THEN - PROCenv_set(repl_env%, FNalloc_symbol(sym$), FNalloc_corefn(i%)) + PROCenv_set(repl_env%, sym$, FNalloc_corefn(i%)) ENDIF UNTIL sym$ = "" @@ -31,9 +31,9 @@ UNTIL form$ = "" argv% = FNget_argv IF FNis_empty(argv%) THEN - PROCenv_set(repl_env%, FNalloc_symbol("*ARGV*"), FNempty) + PROCenv_set(repl_env%, "*ARGV*", FNempty) ELSE - PROCenv_set(repl_env%, FNalloc_symbol("*ARGV*"), FNrest(argv%)) + PROCenv_set(repl_env%, "*ARGV*", FNrest(argv%)) val$ = FNrep("(load-file " + FNunbox_string(FNpr_str(FNfirst(argv%), TRUE)) + ")") END ENDIF @@ -82,63 +82,57 @@ DEF FNquasiquote(ast%) ENDIF =ast% -DEF FNis_macro_call(ast%, env%) - LOCAL car%, val% - IF NOT FNis_list(ast%) THEN =FALSE - car% = FNfirst(ast%) - IF NOT FNis_symbol(car%) THEN =FALSE - IF FNis_nil(FNenv_find(env%, car%)) THEN =FALSE - val% = FNenv_get(env%, car%) -=FNis_macro(val%) - -DEF FNmacroexpand(ast%, env%) - LOCAL mac%, macenv%, macast% - WHILE FNis_macro_call(ast%, env%) - REM PRINT "expanded ";FNpr_str(ast%, TRUE); - mac% = FNenv_get(env%, FNfirst(ast%)) - macenv% = FNnew_env(FNfn_env(mac%), FNfn_params(mac%), FNrest(ast%)) - macast% = FNfn_ast(mac%) - ast% = FNEVAL(macast%, macenv%) - REM PRINT " to ";FNpr_str(ast%, TRUE) - ENDWHILE -=ast% - DEF FNEVAL(ast%, env%) PROCgc_enter =FNgc_exit(FNEVAL_(ast%, env%)) DEF FNEVAL_(ast%, env%) - LOCAL car%, specialform%, val%, bindings% - REPEAT + LOCAL car%, val%, bindings%, key$ +31416 REM tail call optimization loop PROCgc_keep_only2(ast%, env%) - IF NOT FNis_list(ast%) THEN =FNeval_ast(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% - ast% = FNmacroexpand(ast%, env%) - IF NOT FNis_list(ast%) THEN =FNeval_ast(ast%, env%) car% = FNfirst(ast%) - specialform% = FALSE + IF FNis_vector(ast%) THEN =FNalloc_vector_pair(FNEVAL(car%, env%), FNeval_ast(FNrest(ast%), env%)) IF FNis_symbol(car%) THEN - specialform% = TRUE - CASE FNunbox_symbol(car%) OF + key$ = FNunbox_symbol(car%) + CASE key$ OF REM Special forms WHEN "def!" val% = FNEVAL(FNnth(ast%, 2), env%) - PROCenv_set(env%, FNnth(ast%, 1), val%) + 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%, FNnth(ast%, 1), 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%, FNfirst(bindings%), FNEVAL(FNnth(bindings%, 1), env%)) + PROCenv_set(env%, FNunbox_symbol(FNfirst(bindings%)), FNEVAL(FNnth(bindings%, 1), env%)) bindings% = FNrest(FNrest(bindings%)) ENDWHILE ast% = FNnth(ast%, 2) - REM Loop round for tail-call optimisation. + 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 @@ -150,44 +144,44 @@ DEF FNEVAL_(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 ELSE ast% = FNnth(ast%, 3) + IF FNcount(ast%) = 3 THEN =FNnil + ast% = FNnth(ast%, 3) ENDIF - REM Loop round for tail-call optimisation. + GOTO 31416 WHEN "fn*" =FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%) WHEN "quote" =FNnth(ast%, 1) - WHEN "quasiquoteexpand" - = FNquasiquote(FNnth(ast%, 1)) WHEN "quasiquote" ast% = FNquasiquote(FNnth(ast%, 1)) - REM Loop round for tail-call optimisation - WHEN "macroexpand" - =FNmacroexpand(FNnth(ast%, 1), env%) + GOTO 31416 OTHERWISE - specialform% = FALSE + car% = FNenv_get(env%, key$) ENDCASE + ELSE + car% = FNEVAL(car%, env%) ENDIF - IF NOT specialform% THEN - REM This is the "apply" part. - ast% = FNeval_ast(ast%, env%) - car% = FNfirst(ast%) - IF FNis_corefn(car%) THEN - =FNcore_call(FNunbox_corefn(car%), FNrest(ast%)) - ENDIF - IF FNis_fn(car%) THEN - env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), FNrest(ast%)) - ast% = FNfn_ast(car%) - REM Loop round for tail-call optimisation. - ELSE - ERROR &40E80918, "Not a function" - 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 - UNTIL FALSE + 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)) @@ -196,26 +190,8 @@ DEF FNrep(a$) =FNPRINT(FNEVAL(FNREAD(a$), repl_env%)) DEF FNeval_ast(ast%, env%) - LOCAL val%, car%, cdr%, map%, keys%, key$ - IF FNis_symbol(ast%) THEN =FNenv_get(env%, ast%) - IF FNis_seq(ast%) THEN IF FNis_empty(ast%) THEN =ast% - car% = FNEVAL(FNfirst(ast%), env%) - cdr% = FNeval_ast(FNrest(ast%), env%) - IF FNis_vector(ast%) THEN =FNalloc_vector_pair(car%, cdr%) - =FNalloc_pair(car%, cdr%) - ENDIF - IF FNis_hashmap(ast%) THEN - map% = FNempty_hashmap - keys% = FNhashmap_keys(ast%) - WHILE NOT FNis_empty(keys%) - key$ = FNunbox_string(FNfirst(keys%)) - map% = FNhashmap_set(map%, key$, FNEVAL(FNhashmap_get(ast%, key$), env%)) - keys% = FNrest(keys%) - ENDWHILE - =map% - ENDIF -=ast% + =FNalloc_pair(FNEVAL(FNfirst(ast%), env%), FNeval_ast(FNrest(ast%), env%)) DEF FNget_argv PROCgc_enter diff --git a/impls/bbc-basic/step9_try.bas b/impls/bbc-basic/step9_try.bas index 61d1036f89..e7294185c8 100644 --- a/impls/bbc-basic/step9_try.bas +++ b/impls/bbc-basic/step9_try.bas @@ -13,7 +13,7 @@ PROCcore_ns : REM This sets the data pointer REPEAT READ sym$, i% IF sym$ <> "" THEN - PROCenv_set(repl_env%, FNalloc_symbol(sym$), FNalloc_corefn(i%)) + PROCenv_set(repl_env%, sym$, FNalloc_corefn(i%)) ENDIF UNTIL sym$ = "" @@ -31,9 +31,9 @@ UNTIL form$ = "" argv% = FNget_argv IF FNis_empty(argv%) THEN - PROCenv_set(repl_env%, FNalloc_symbol("*ARGV*"), FNempty) + PROCenv_set(repl_env%, "*ARGV*", FNempty) ELSE - PROCenv_set(repl_env%, FNalloc_symbol("*ARGV*"), FNrest(argv%)) + PROCenv_set(repl_env%, "*ARGV*", FNrest(argv%)) val$ = FNrep("(load-file " + FNunbox_string(FNpr_str(FNfirst(argv%), TRUE)) + ")") END ENDIF @@ -82,27 +82,6 @@ DEF FNquasiquote(ast%) ENDIF =ast% -DEF FNis_macro_call(ast%, env%) - LOCAL car%, val% - IF NOT FNis_list(ast%) THEN =FALSE - car% = FNfirst(ast%) - IF NOT FNis_symbol(car%) THEN =FALSE - IF FNis_nil(FNenv_find(env%, car%)) THEN =FALSE - val% = FNenv_get(env%, car%) -=FNis_macro(val%) - -DEF FNmacroexpand(ast%, env%) - LOCAL mac%, macenv%, macast% - WHILE FNis_macro_call(ast%, env%) - REM PRINT "expanded ";FNpr_str(ast%, TRUE); - mac% = FNenv_get(env%, FNfirst(ast%)) - macenv% = FNnew_env(FNfn_env(mac%), FNfn_params(mac%), FNrest(ast%)) - macast% = FNfn_ast(mac%) - ast% = FNEVAL(macast%, macenv%) - REM PRINT " to ";FNpr_str(ast%, TRUE) - ENDWHILE -=ast% - DEF FNtry_catch(ast%, env%) LOCAL is_error%, ret% REM If there's no 'catch*' clause then we just evaluate the 'try*'. @@ -150,37 +129,52 @@ DEF FNEVAL(ast%, env%) =FNgc_exit(FNEVAL_(ast%, env%)) DEF FNEVAL_(ast%, env%) - LOCAL car%, specialform%, val%, bindings% - REPEAT + LOCAL car%, val%, bindings%, key$ +31416 REM tail call optimization loop PROCgc_keep_only2(ast%, env%) - IF NOT FNis_list(ast%) THEN =FNeval_ast(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% - ast% = FNmacroexpand(ast%, env%) - IF NOT FNis_list(ast%) THEN =FNeval_ast(ast%, env%) car% = FNfirst(ast%) - specialform% = FALSE + IF FNis_vector(ast%) THEN =FNalloc_vector_pair(FNEVAL(car%, env%), FNeval_ast(FNrest(ast%), env%)) IF FNis_symbol(car%) THEN - specialform% = TRUE - CASE FNunbox_symbol(car%) OF + key$ = FNunbox_symbol(car%) + CASE key$ OF REM Special forms WHEN "def!" val% = FNEVAL(FNnth(ast%, 2), env%) - PROCenv_set(env%, FNnth(ast%, 1), val%) + 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%, FNnth(ast%, 1), 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%, FNfirst(bindings%), FNEVAL(FNnth(bindings%, 1), env%)) + PROCenv_set(env%, FNunbox_symbol(FNfirst(bindings%)), FNEVAL(FNnth(bindings%, 1), env%)) bindings% = FNrest(FNrest(bindings%)) ENDWHILE ast% = FNnth(ast%, 2) - REM Loop round for tail-call optimisation. + 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 @@ -192,46 +186,46 @@ DEF FNEVAL_(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 ELSE ast% = FNnth(ast%, 3) + IF FNcount(ast%) = 3 THEN =FNnil + ast% = FNnth(ast%, 3) ENDIF - REM Loop round for tail-call optimisation. + GOTO 31416 WHEN "fn*" =FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%) WHEN "quote" =FNnth(ast%, 1) - WHEN "quasiquoteexpand" - = FNquasiquote(FNnth(ast%, 1)) WHEN "quasiquote" ast% = FNquasiquote(FNnth(ast%, 1)) - REM Loop round for tail-call optimisation - WHEN "macroexpand" - =FNmacroexpand(FNnth(ast%, 1), env%) + GOTO 31416 WHEN "try*" =FNtry_catch(ast%, env%) OTHERWISE - specialform% = FALSE + car% = FNenv_get(env%, key$) ENDCASE + ELSE + car% = FNEVAL(car%, env%) ENDIF - IF NOT specialform% THEN - REM This is the "apply" part. - ast% = FNeval_ast(ast%, env%) - car% = FNfirst(ast%) - IF FNis_corefn(car%) THEN - =FNcore_call(FNunbox_corefn(car%), FNrest(ast%)) - ENDIF - IF FNis_fn(car%) THEN - env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), FNrest(ast%)) - ast% = FNfn_ast(car%) - REM Loop round for tail-call optimisation. - ELSE - ERROR &40E80918, "Not a function" - 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 - UNTIL FALSE + 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)) @@ -240,26 +234,8 @@ DEF FNrep(a$) =FNPRINT(FNEVAL(FNREAD(a$), repl_env%)) DEF FNeval_ast(ast%, env%) - LOCAL val%, car%, cdr%, map%, keys%, key$ - IF FNis_symbol(ast%) THEN =FNenv_get(env%, ast%) - IF FNis_seq(ast%) THEN IF FNis_empty(ast%) THEN =ast% - car% = FNEVAL(FNfirst(ast%), env%) - cdr% = FNeval_ast(FNrest(ast%), env%) - IF FNis_vector(ast%) THEN =FNalloc_vector_pair(car%, cdr%) - =FNalloc_pair(car%, cdr%) - ENDIF - IF FNis_hashmap(ast%) THEN - map% = FNempty_hashmap - keys% = FNhashmap_keys(ast%) - WHILE NOT FNis_empty(keys%) - key$ = FNunbox_string(FNfirst(keys%)) - map% = FNhashmap_set(map%, key$, FNEVAL(FNhashmap_get(ast%, key$), env%)) - keys% = FNrest(keys%) - ENDWHILE - =map% - ENDIF -=ast% + =FNalloc_pair(FNEVAL(FNfirst(ast%), env%), FNeval_ast(FNrest(ast%), env%)) DEF FNget_argv PROCgc_enter diff --git a/impls/bbc-basic/stepA_mal.bas b/impls/bbc-basic/stepA_mal.bas index 2ca19477fb..a74d1cb9cf 100644 --- a/impls/bbc-basic/stepA_mal.bas +++ b/impls/bbc-basic/stepA_mal.bas @@ -13,7 +13,7 @@ PROCcore_ns : REM This sets the data pointer REPEAT READ sym$, i% IF sym$ <> "" THEN - PROCenv_set(repl_env%, FNalloc_symbol(sym$), FNalloc_corefn(i%)) + PROCenv_set(repl_env%, sym$, FNalloc_corefn(i%)) ENDIF UNTIL sym$ = "" @@ -32,9 +32,9 @@ UNTIL form$ = "" argv% = FNget_argv IF FNis_empty(argv%) THEN - PROCenv_set(repl_env%, FNalloc_symbol("*ARGV*"), FNempty) + PROCenv_set(repl_env%, "*ARGV*", FNempty) ELSE - PROCenv_set(repl_env%, FNalloc_symbol("*ARGV*"), FNrest(argv%)) + PROCenv_set(repl_env%, "*ARGV*", FNrest(argv%)) val$ = FNrep("(load-file " + FNunbox_string(FNpr_str(FNfirst(argv%), TRUE)) + ")") END ENDIF @@ -84,27 +84,6 @@ DEF FNquasiquote(ast%) ENDIF =ast% -DEF FNis_macro_call(ast%, env%) - LOCAL car%, val% - IF NOT FNis_list(ast%) THEN =FALSE - car% = FNfirst(ast%) - IF NOT FNis_symbol(car%) THEN =FALSE - IF FNis_nil(FNenv_find(env%, car%)) THEN =FALSE - val% = FNenv_get(env%, car%) -=FNis_macro(val%) - -DEF FNmacroexpand(ast%, env%) - LOCAL mac%, macenv%, macast% - WHILE FNis_macro_call(ast%, env%) - REM PRINT "expanded ";FNpr_str(ast%, TRUE); - mac% = FNenv_get(env%, FNfirst(ast%)) - macenv% = FNnew_env(FNfn_env(mac%), FNfn_params(mac%), FNrest(ast%)) - macast% = FNfn_ast(mac%) - ast% = FNEVAL(macast%, macenv%) - REM PRINT " to ";FNpr_str(ast%, TRUE) - ENDWHILE -=ast% - DEF FNtry_catch(ast%, env%) LOCAL is_error%, ret% REM If there's no 'catch*' clause then we just evaluate the 'try*'. @@ -152,37 +131,52 @@ DEF FNEVAL(ast%, env%) =FNgc_exit(FNEVAL_(ast%, env%)) DEF FNEVAL_(ast%, env%) - LOCAL car%, specialform%, val%, bindings% - REPEAT + LOCAL car%, val%, bindings%, key$ +31416 REM tail call optimization loop PROCgc_keep_only2(ast%, env%) - IF NOT FNis_list(ast%) THEN =FNeval_ast(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% - ast% = FNmacroexpand(ast%, env%) - IF NOT FNis_list(ast%) THEN =FNeval_ast(ast%, env%) car% = FNfirst(ast%) - specialform% = FALSE + IF FNis_vector(ast%) THEN =FNalloc_vector_pair(FNEVAL(car%, env%), FNeval_ast(FNrest(ast%), env%)) IF FNis_symbol(car%) THEN - specialform% = TRUE - CASE FNunbox_symbol(car%) OF + key$ = FNunbox_symbol(car%) + CASE key$ OF REM Special forms WHEN "def!" val% = FNEVAL(FNnth(ast%, 2), env%) - PROCenv_set(env%, FNnth(ast%, 1), val%) + 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%, FNnth(ast%, 1), 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%, FNfirst(bindings%), FNEVAL(FNnth(bindings%, 1), env%)) + PROCenv_set(env%, FNunbox_symbol(FNfirst(bindings%)), FNEVAL(FNnth(bindings%, 1), env%)) bindings% = FNrest(FNrest(bindings%)) ENDWHILE ast% = FNnth(ast%, 2) - REM Loop round for tail-call optimisation. + 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 @@ -194,46 +188,46 @@ DEF FNEVAL_(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 ELSE ast% = FNnth(ast%, 3) + IF FNcount(ast%) = 3 THEN =FNnil + ast% = FNnth(ast%, 3) ENDIF - REM Loop round for tail-call optimisation. + GOTO 31416 WHEN "fn*" =FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%) WHEN "quote" =FNnth(ast%, 1) - WHEN "quasiquoteexpand" - = FNquasiquote(FNnth(ast%, 1)) WHEN "quasiquote" ast% = FNquasiquote(FNnth(ast%, 1)) - REM Loop round for tail-call optimisation - WHEN "macroexpand" - =FNmacroexpand(FNnth(ast%, 1), env%) + GOTO 31416 WHEN "try*" =FNtry_catch(ast%, env%) OTHERWISE - specialform% = FALSE + car% = FNenv_get(env%, key$) ENDCASE + ELSE + car% = FNEVAL(car%, env%) ENDIF - IF NOT specialform% THEN - REM This is the "apply" part. - ast% = FNeval_ast(ast%, env%) - car% = FNfirst(ast%) - IF FNis_corefn(car%) THEN - =FNcore_call(FNunbox_corefn(car%), FNrest(ast%)) - ENDIF - IF FNis_fn(car%) THEN - env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), FNrest(ast%)) - ast% = FNfn_ast(car%) - REM Loop round for tail-call optimisation. - ELSE - ERROR &40E80918, "Not a function" - 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 - UNTIL FALSE + 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)) @@ -242,26 +236,8 @@ DEF FNrep(a$) =FNPRINT(FNEVAL(FNREAD(a$), repl_env%)) DEF FNeval_ast(ast%, env%) - LOCAL val%, car%, cdr%, map%, keys%, key$ - IF FNis_symbol(ast%) THEN =FNenv_get(env%, ast%) - IF FNis_seq(ast%) THEN IF FNis_empty(ast%) THEN =ast% - car% = FNEVAL(FNfirst(ast%), env%) - cdr% = FNeval_ast(FNrest(ast%), env%) - IF FNis_vector(ast%) THEN =FNalloc_vector_pair(car%, cdr%) - =FNalloc_pair(car%, cdr%) - ENDIF - IF FNis_hashmap(ast%) THEN - map% = FNempty_hashmap - keys% = FNhashmap_keys(ast%) - WHILE NOT FNis_empty(keys%) - key$ = FNunbox_string(FNfirst(keys%)) - map% = FNhashmap_set(map%, key$, FNEVAL(FNhashmap_get(ast%, key$), env%)) - keys% = FNrest(keys%) - ENDWHILE - =map% - ENDIF -=ast% + =FNalloc_pair(FNEVAL(FNfirst(ast%), env%), FNeval_ast(FNrest(ast%), env%)) DEF FNget_argv PROCgc_enter diff --git a/impls/c.2/env.c b/impls/c.2/env.c index 458de15215..f681079408 100644 --- a/impls/c.2/env.c +++ b/impls/c.2/env.c @@ -15,7 +15,7 @@ Env* env_make(Env* outer, list symbol_list, list exprs_list, MalType* more_symbo while (symbol_list) { - env = env_set(env, symbol_list->data, exprs_list->data); + env_set(env, ((MalType*)symbol_list->data)->value.mal_symbol, exprs_list->data); symbol_list = symbol_list->next; exprs_list = exprs_list->next; @@ -23,45 +23,28 @@ Env* env_make(Env* outer, list symbol_list, list exprs_list, MalType* more_symbo /* set the 'more' symbol if there is one */ if (more_symbol) { - env = env_set(env, more_symbol, make_list(exprs_list)); + env_set(env, more_symbol->value.mal_symbol, make_list(exprs_list)); } return env; } -Env* env_set(Env* current, MalType* symbol, MalType* value) { +void env_set(Env* current, char* symbol, MalType* value) { + + current->data = hashmap_put(current->data, symbol, value); - current->data = hashmap_put(current->data, symbol->value.mal_symbol, value); - return current; } -Env* env_find(Env* current, MalType* symbol) { +MalType* env_get(Env* current, char* symbol) { - MalType* val = hashmap_get(current->data, symbol->value.mal_symbol); + MalType* val = hashmap_get(current->data, symbol); if (val) { - return current; + return val; } else if (current->outer) { - return env_find(current->outer, symbol); + return env_get(current->outer, symbol); } else { return NULL; /* not found */ } } - -MalType* env_get(Env* current, MalType* symbol) { - - Env* env = env_find(current, symbol); - - if (env) { - return hashmap_get(env->data, symbol->value.mal_symbol); - } - else { - return make_error_fmt("'%s' not found", symbol->value.mal_symbol); - } -} - -Env* env_set_C_fn(Env* current, char* symbol_name, MalType*(*fn)(list)) { - - return env_set(current, make_symbol(symbol_name), make_function(fn)); -} diff --git a/impls/c.2/env.h b/impls/c.2/env.h index 825249dc94..3957c1f893 100644 --- a/impls/c.2/env.h +++ b/impls/c.2/env.h @@ -15,9 +15,7 @@ struct Env_s { }; Env* env_make(Env* outer, list binds, list exprs, MalType* variadic_symbol); -Env* env_set(Env* current, MalType* symbol, MalType* value); -Env* env_set_C_fn(Env* current, char* symbol_name, MalType*(*fn)(list)); -MalType* env_get(Env* current, MalType* symbol); -Env* env_find(Env* current, MalType* symbol); +void env_set(Env* current, char* symbol, MalType* value); +MalType* env_get(Env* current, char* symbol); #endif diff --git a/impls/c.2/step2_eval.c b/impls/c.2/step2_eval.c index 0b0d6424d9..a4ae27c2df 100644 --- a/impls/c.2/step2_eval.c +++ b/impls/c.2/step2_eval.c @@ -21,13 +21,41 @@ MalType* READ(char* str) { MalType* EVAL(MalType* ast, Env* env) { /* forward references */ - MalType* eval_ast(MalType* ast, Env* env); + list evaluate_list(list lst, Env* env); + list evaluate_vector(list lst, Env* env); + list evaluate_hashmap(list lst, Env* env); + + /* printf("EVAL: %s\n", pr_str(ast, READABLY)); */ /* NULL */ if (!ast) { return make_nil(); } + if (is_symbol(ast)) { + MalType* symbol_value = hashmap_get(env->data, ast->value.mal_symbol); + if (symbol_value) + return symbol_value; + else + return make_error_fmt("'%s' not found", ast->value.mal_symbol); + } + + if (is_vector(ast)) { + list result = evaluate_vector(ast->value.mal_list, env); + if (result && is_error(result->data)) + return result->data; + else + return make_vector(result); + } + + if (is_hashmap(ast)) { + list result = evaluate_hashmap(ast->value.mal_list, env); + if (result && is_error(result->data)) + return result->data; + else + return make_hashmap(result); + } + /* not a list */ - if (!is_list(ast)) { return eval_ast(ast, env); } + if (!is_list(ast)) { return ast; } /* empty list */ if (ast->value.mal_list == NULL) { return ast; } @@ -35,12 +63,10 @@ MalType* EVAL(MalType* ast, Env* env) { /* list */ /* evaluate the list */ - MalType* evaluated_list = eval_ast(ast, env); - - if (is_error(evaluated_list)) { return evaluated_list; } + list evlst = evaluate_list(ast->value.mal_list, env); + if (is_error(evlst->data)) return evlst->data; /* apply the first element of the list to the arguments */ - list evlst = evaluated_list->value.mal_list; MalType* func = evlst->data; if (is_function(func)) { @@ -112,58 +138,6 @@ int main(int argc, char** argv) { return 0; } -MalType* eval_ast(MalType* ast, Env* env) { - - /* forward references */ - list evaluate_list(list lst, Env* env); - list evaluate_vector(list lst, Env* env); - list evaluate_hashmap(list lst, Env* env); - - if (is_symbol(ast)) { - - MalType* symbol_value = hashmap_get(env->data, ast->value.mal_symbol); - - if (symbol_value) { - return symbol_value; - } else { - return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY)); - } - } - else if (is_list(ast)) { - - list result = evaluate_list(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_list(result); - } else { - return result->data; - } - } - else if (is_vector(ast)) { - - list result = evaluate_vector(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_vector(result); - } else { - return result->data; - } - } - else if (is_hashmap(ast)) { - - list result = evaluate_hashmap(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_hashmap(result); - } else { - return result->data; - } - } - else { - return ast; - } -} - list evaluate_list(list lst, Env* env) { list evlst = NULL; diff --git a/impls/c.2/step3_env.c b/impls/c.2/step3_env.c index bebfdb4989..977af01194 100644 --- a/impls/c.2/step3_env.c +++ b/impls/c.2/step3_env.c @@ -24,15 +24,45 @@ MalType* READ(char* str) { MalType* EVAL(MalType* ast, Env* env) { /* forward references */ - MalType* eval_ast(MalType* ast, Env* env); + list evaluate_list(list lst, Env* env); + list evaluate_vector(list lst, Env* env); + list evaluate_hashmap(list lst, Env* env); MalType* eval_defbang(MalType* ast, Env* env); MalType* eval_letstar(MalType* ast, Env* env); + MalType* dbgeval = env_get(env, "DEBUG-EVAL"); + if (dbgeval && ! is_false(dbgeval) && ! is_nil(dbgeval)) + printf("EVAL: %s\n", pr_str(ast, READABLY)); + /* NULL */ if (!ast) { return make_nil(); } + if (is_symbol(ast)) { + MalType* symbol_value = env_get(env, ast->value.mal_symbol); + if (symbol_value) + return symbol_value; + else + return make_error_fmt("'%s' not found", ast->value.mal_symbol); + } + + if (is_vector(ast)) { + list result = evaluate_vector(ast->value.mal_list, env); + if (result && is_error(result->data)) + return result->data; + else + return make_vector(result); + } + + if (is_hashmap(ast)) { + list result = evaluate_hashmap(ast->value.mal_list, env); + if (result && is_error(result->data)) + return result->data; + else + return make_hashmap(result); + } + /* not a list */ - if (!is_list(ast)) { return eval_ast(ast, env); } + if (!is_list(ast)) { return ast; } /* empty list */ if (ast->value.mal_list == NULL) { return ast; } @@ -52,12 +82,10 @@ MalType* EVAL(MalType* ast, Env* env) { } } /* first element is not a special symbol */ - MalType* evaluated_list = eval_ast(ast, env); - - if (is_error(evaluated_list)) { return evaluated_list; } + list evlst = evaluate_list(ast->value.mal_list, env); + if (is_error(evlst->data)) return evlst->data; /* apply the first element of the list to the arguments */ - list evlst = evaluated_list->value.mal_list; MalType* func = evlst->data; if (is_function(func)) { @@ -92,10 +120,10 @@ int main(int argc, char** argv) { puts("Press Ctrl+d to exit\n"); Env* repl_env = env_make(NULL, NULL, NULL, NULL); - repl_env = env_set_C_fn(repl_env, "+", mal_add); - repl_env = env_set_C_fn(repl_env, "-", mal_sub); - repl_env = env_set_C_fn(repl_env, "*", mal_mul); - repl_env = env_set_C_fn(repl_env, "/", mal_div); + env_set(repl_env, "+", make_function(mal_add)); + env_set(repl_env, "-", make_function(mal_sub)); + env_set(repl_env, "*", make_function(mal_mul)); + env_set(repl_env, "/", make_function(mal_div)); while (1) { @@ -122,58 +150,6 @@ int main(int argc, char** argv) { return 0; } -MalType* eval_ast(MalType* ast, Env* env) { - - /* forward references */ - list evaluate_list(list lst, Env* env); - list evaluate_vector(list lst, Env* env); - list evaluate_hashmap(list lst, Env* env); - - if (is_symbol(ast)) { - - MalType* symbol_value = env_get(env, ast); - - if (symbol_value) { - return symbol_value; - } else { - return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY)); - } - } - else if (is_list(ast)) { - - list result = evaluate_list(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_list(result); - } else { - return result->data; - } - } - else if (is_vector(ast)) { - - list result = evaluate_vector(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_vector(result); - } else { - return result->data; - } - } - else if (is_hashmap(ast)) { - - list result = evaluate_hashmap(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_hashmap(result); - } else { - return result->data; - } - } - else { - return ast; - } -} - MalType* eval_defbang(MalType* ast, Env* env) { list lst = (ast->value.mal_list)->next; @@ -185,7 +161,7 @@ MalType* eval_defbang(MalType* ast, Env* env) { MalType* result = EVAL(defbang_value, env); if (!is_error(result)) { - env_set(env, defbang_symbol, result); + env_set(env, defbang_symbol->value.mal_symbol, result); } return result; } @@ -206,7 +182,7 @@ MalType* eval_letstar(MalType* ast, Env* env) { MalType* symbol = letstar_bindings_list->data; MalType* value = letstar_bindings_list->next->data; - letstar_env = env_set(letstar_env, symbol, EVAL(value, letstar_env)); + env_set(letstar_env, symbol->value.mal_symbol, EVAL(value, letstar_env)); letstar_bindings_list = letstar_bindings_list->next->next; /* pop symbol and value*/ } diff --git a/impls/c.2/step4_if_fn_do.c b/impls/c.2/step4_if_fn_do.c index 93cdf63e25..d0142935ac 100644 --- a/impls/c.2/step4_if_fn_do.c +++ b/impls/c.2/step4_if_fn_do.c @@ -28,18 +28,48 @@ MalType* READ(char* str) { MalType* EVAL(MalType* ast, Env* env) { /* forward references */ - MalType* eval_ast(MalType* ast, Env* env); + list evaluate_list(list lst, Env* env); + list evaluate_vector(list lst, Env* env); + list evaluate_hashmap(list lst, Env* env); MalType* eval_defbang(MalType* ast, Env* env); MalType* eval_letstar(MalType* ast, Env* env); MalType* eval_if(MalType* ast, Env* env); MalType* eval_fnstar(MalType* ast, Env* env); MalType* eval_do(MalType* ast, Env* env); + MalType* dbgeval = env_get(env, "DEBUG-EVAL"); + if (dbgeval && ! is_false(dbgeval) && ! is_nil(dbgeval)) + printf("EVAL: %s\n", pr_str(ast, READABLY)); + /* NULL */ if (!ast) { return make_nil(); } + if (is_symbol(ast)) { + MalType* symbol_value = env_get(env, ast->value.mal_symbol); + if (symbol_value) + return symbol_value; + else + return make_error_fmt("'%s' not found", ast->value.mal_symbol); + } + + if (is_vector(ast)) { + list result = evaluate_vector(ast->value.mal_list, env); + if (result && is_error(result->data)) + return result->data; + else + return make_vector(result); + } + + if (is_hashmap(ast)) { + list result = evaluate_hashmap(ast->value.mal_list, env); + if (result && is_error(result->data)) + return result->data; + else + return make_hashmap(result); + } + /* not a list */ - if (!is_list(ast)) { return eval_ast(ast, env); } + if (!is_list(ast)) { return ast; } /* empty list */ if (ast->value.mal_list == NULL) { return ast; } @@ -68,12 +98,10 @@ MalType* EVAL(MalType* ast, Env* env) { } } /* first element is not a special symbol */ - MalType* evaluated_list = eval_ast(ast, env); - - if (is_error(evaluated_list)) { return evaluated_list; } + list evlst = evaluate_list(ast->value.mal_list, env); + if (is_error(evlst->data)) return evlst->data; /* apply the first element of the list to the arguments */ - list evlst = evaluated_list->value.mal_list; MalType* func = evlst->data; if (is_function(func)) { @@ -131,7 +159,7 @@ int main(int argc, char** argv) { char* symbol = mappings->data; MalType*(*function)(list) = (MalType*(*)(list))mappings->next->data; - env_set_C_fn(repl_env, symbol, function); + env_set(repl_env, symbol, make_function(function)); /* pop symbol and function from hashmap/list */ mappings = mappings->next->next; @@ -166,58 +194,6 @@ int main(int argc, char** argv) { return 0; } -MalType* eval_ast(MalType* ast, Env* env) { - - /* forward references */ - list evaluate_list(list lst, Env* env); - list evaluate_vector(list lst, Env* env); - list evaluate_hashmap(list lst, Env* env); - - if (is_symbol(ast)) { - - MalType* symbol_value = env_get(env, ast); - - if (symbol_value) { - return symbol_value; - } else { - return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY)); - } - } - else if (is_list(ast)) { - - list result = evaluate_list(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_list(result); - } else { - return result->data; - } - } - else if (is_vector(ast)) { - - list result = evaluate_vector(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_vector(result); - } else { - return result->data; - } - } - else if (is_hashmap(ast)) { - - list result = evaluate_hashmap(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_hashmap(result); - } else { - return result->data; - } - } - else { - return ast; - } -} - MalType* eval_defbang(MalType* ast, Env* env) { list lst = (ast->value.mal_list)->next; @@ -236,7 +212,7 @@ MalType* eval_defbang(MalType* ast, Env* env) { MalType* result = EVAL(defbang_value, env); if (!is_error(result)){ - env = env_set(env, defbang_symbol, result); + env_set(env, defbang_symbol->value.mal_symbol, result); } return result; } @@ -272,7 +248,7 @@ MalType* eval_letstar(MalType* ast, Env* env) { /* early return from error */ if (is_error(value)) { return value; } - env_set(letstar_env, symbol, value); + env_set(letstar_env, symbol->value.mal_symbol, value); bindings_list = bindings_list->next->next; } return EVAL(forms, letstar_env); diff --git a/impls/c.2/step5_tco.c b/impls/c.2/step5_tco.c index 78fbf40535..b214f3904d 100644 --- a/impls/c.2/step5_tco.c +++ b/impls/c.2/step5_tco.c @@ -28,7 +28,9 @@ MalType* READ(char* str) { MalType* EVAL(MalType* ast, Env* env) { /* forward references */ - MalType* eval_ast(MalType* ast, Env* env); + list evaluate_list(list lst, Env* env); + list evaluate_vector(list lst, Env* env); + list evaluate_hashmap(list lst, Env* env); MalType* eval_defbang(MalType* ast, Env** env); void eval_letstar(MalType** ast, Env** env); void eval_if(MalType** ast, Env** env); @@ -38,11 +40,39 @@ 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, "DEBUG-EVAL"); + if (dbgeval && ! is_false(dbgeval) && ! is_nil(dbgeval)) + printf("EVAL: %s\n", pr_str(ast, READABLY)); + /* NULL */ if (!ast) { return make_nil(); } + if (is_symbol(ast)) { + MalType* symbol_value = env_get(env, ast->value.mal_symbol); + if (symbol_value) + return symbol_value; + else + return make_error_fmt("'%s' not found", ast->value.mal_symbol); + } + + if (is_vector(ast)) { + list result = evaluate_vector(ast->value.mal_list, env); + if (result && is_error(result->data)) + return result->data; + else + return make_vector(result); + } + + if (is_hashmap(ast)) { + list result = evaluate_hashmap(ast->value.mal_list, env); + if (result && is_error(result->data)) + return result->data; + else + return make_hashmap(result); + } + /* not a list */ - if (!is_list(ast)) { return eval_ast(ast, env); } + if (!is_list(ast)) { return ast; } /* empty list */ if (ast->value.mal_list == NULL) { return ast; } @@ -86,10 +116,10 @@ MalType* EVAL(MalType* ast, Env* env) { } } /* first element is not a special symbol */ - MalType* evaluated_list = eval_ast(ast, env); + list evlst = evaluate_list(ast->value.mal_list, env); + if (is_error(evlst->data)) return evlst->data; /* apply the first element of the list to the arguments */ - list evlst = evaluated_list->value.mal_list; MalType* func = evlst->data; if (is_function(func)) { @@ -151,7 +181,7 @@ int main(int argc, char** argv) { char* symbol = mappings->data; MalType*(*function)(list) = (MalType*(*)(list))mappings->next->data; - env_set_C_fn(repl_env, symbol, function); + env_set(repl_env, symbol, make_function(function)); /* pop symbol and function from hashmap/list */ mappings = mappings->next->next; @@ -186,58 +216,6 @@ int main(int argc, char** argv) { return 0; } -MalType* eval_ast(MalType* ast, Env* env) { - - /* forward references */ - list evaluate_list(list lst, Env* env); - list evaluate_vector(list lst, Env* env); - list evaluate_hashmap(list lst, Env* env); - - if (is_symbol(ast)) { - - MalType* symbol_value = env_get(env, ast); - - if (symbol_value) { - return symbol_value; - } else { - return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY)); - } - } - else if (is_list(ast)) { - - list result = evaluate_list(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_list(result); - } else { - return result->data; - } - } - else if (is_vector(ast)) { - - list result = evaluate_vector(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_vector(result); - } else { - return result->data; - } - } - else if (is_hashmap(ast)) { - - list result = evaluate_hashmap(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_hashmap(result); - } else { - return result->data; - } - } - else { - return ast; - } -} - MalType* eval_defbang(MalType* ast, Env** env) { list lst = (ast->value.mal_list)->next; @@ -256,7 +234,7 @@ MalType* eval_defbang(MalType* ast, Env** env) { MalType* result = EVAL(defbang_value, *env); if (!is_error(result)){ - *env = env_set(*env, defbang_symbol, result); + env_set(*env, defbang_symbol->value.mal_symbol, result); } return result; } @@ -298,7 +276,7 @@ void eval_letstar(MalType** ast, Env** env) { return; } - env_set(letstar_env, symbol, value); + env_set(letstar_env, symbol->value.mal_symbol, value); bindings_list = bindings_list->next->next; } diff --git a/impls/c.2/step6_file.c b/impls/c.2/step6_file.c index 4e73fb78b2..cd8074624d 100644 --- a/impls/c.2/step6_file.c +++ b/impls/c.2/step6_file.c @@ -28,7 +28,9 @@ MalType* READ(char* str) { MalType* EVAL(MalType* ast, Env* env) { /* forward references */ - MalType* eval_ast(MalType* ast, Env* env); + list evaluate_list(list lst, Env* env); + list evaluate_vector(list lst, Env* env); + list evaluate_hashmap(list lst, Env* env); MalType* eval_defbang(MalType* ast, Env** env); void eval_letstar(MalType** ast, Env** env); void eval_if(MalType** ast, Env** env); @@ -38,11 +40,39 @@ 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, "DEBUG-EVAL"); + if (dbgeval && ! is_false(dbgeval) && ! is_nil(dbgeval)) + printf("EVAL: %s\n", pr_str(ast, READABLY)); + /* NULL */ if (!ast) { return make_nil(); } + if (is_symbol(ast)) { + MalType* symbol_value = env_get(env, ast->value.mal_symbol); + if (symbol_value) + return symbol_value; + else + return make_error_fmt("'%s' not found", ast->value.mal_symbol); + } + + if (is_vector(ast)) { + list result = evaluate_vector(ast->value.mal_list, env); + if (result && is_error(result->data)) + return result->data; + else + return make_vector(result); + } + + if (is_hashmap(ast)) { + list result = evaluate_hashmap(ast->value.mal_list, env); + if (result && is_error(result->data)) + return result->data; + else + return make_hashmap(result); + } + /* not a list */ - if (!is_list(ast)) { return eval_ast(ast, env); } + if (!is_list(ast)) { return ast; } /* empty list */ if (ast->value.mal_list == NULL) { return ast; } @@ -86,12 +116,10 @@ MalType* EVAL(MalType* ast, Env* env) { } } /* first element is not a special symbol */ - MalType* evaluated_list = eval_ast(ast, env); - - if (is_error(evaluated_list)) { return evaluated_list; } + list evlst = evaluate_list(ast->value.mal_list, env); + if (is_error(evlst->data)) return evlst->data; /* apply the first element of the list to the arguments */ - list evlst = evaluated_list->value.mal_list; MalType* func = evlst->data; if (is_function(func)) { @@ -159,13 +187,13 @@ int main(int argc, char** argv) { char* symbol = mappings->data; MalType*(*function)(list) = (MalType*(*)(list))mappings->next->data; - env_set_C_fn(repl_env, symbol, function); + env_set(repl_env, symbol, make_function(function)); /* pop symbol and function from hashmap/list */ mappings = mappings->next->next; } - env_set_C_fn(repl_env, "eval", mal_eval); + env_set(repl_env, "eval", make_function(mal_eval)); /* add functions written in mal - not using rep as it prints the result */ EVAL(READ("(def! not (fn* (a) (if a false true)))"), repl_env); @@ -177,7 +205,7 @@ int main(int argc, char** argv) { for (int i = 2; i < argc; i++) { lst = list_push(lst, make_string(argv[i])); } - env_set(repl_env, make_symbol("*ARGV*"), make_list(list_reverse(lst))); + env_set(repl_env, "*ARGV*", make_list(list_reverse(lst))); /* run in script mode if a filename is given */ if (argc > 1) { @@ -218,58 +246,6 @@ int main(int argc, char** argv) { return 0; } -MalType* eval_ast(MalType* ast, Env* env) { - - /* forward references */ - list evaluate_list(list lst, Env* env); - list evaluate_vector(list lst, Env* env); - list evaluate_hashmap(list lst, Env* env); - - if (is_symbol(ast)) { - - MalType* symbol_value = env_get(env, ast); - - if (symbol_value) { - return symbol_value; - } else { - return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY)); - } - } - else if (is_list(ast)) { - - list result = evaluate_list(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_list(result); - } else { - return result->data; - } - } - else if (is_vector(ast)) { - - list result = evaluate_vector(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_vector(result); - } else { - return result->data; - } - } - else if (is_hashmap(ast)) { - - list result = evaluate_hashmap(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_hashmap(result); - } else { - return result->data; - } - } - else { - return ast; - } -} - MalType* eval_defbang(MalType* ast, Env** env) { list lst = (ast->value.mal_list)->next; @@ -288,7 +264,7 @@ MalType* eval_defbang(MalType* ast, Env** env) { MalType* result = EVAL(defbang_value, *env); if (!is_error(result)){ - *env = env_set(*env, defbang_symbol, result); + env_set(*env, defbang_symbol->value.mal_symbol, result); } return result; } @@ -330,7 +306,7 @@ void eval_letstar(MalType** ast, Env** env) { return; } - env_set(letstar_env, symbol, value); + env_set(letstar_env, symbol->value.mal_symbol, value); bindings_list = bindings_list->next->next; } diff --git a/impls/c.2/step7_quote.c b/impls/c.2/step7_quote.c index 27cbd53721..e95c1df668 100644 --- a/impls/c.2/step7_quote.c +++ b/impls/c.2/step7_quote.c @@ -19,7 +19,6 @@ #define SYMBOL_FNSTAR "fn*" #define SYMBOL_QUOTE "quote" #define SYMBOL_QUASIQUOTE "quasiquote" -#define SYMBOL_QUASIQUOTEEXPAND "quasiquoteexpand" #define SYMBOL_UNQUOTE "unquote" #define SYMBOL_SPLICE_UNQUOTE "splice-unquote" @@ -33,7 +32,9 @@ MalType* READ(char* str) { MalType* EVAL(MalType* ast, Env* env) { /* forward references */ - MalType* eval_ast(MalType* ast, Env* env); + list evaluate_list(list lst, Env* env); + list evaluate_vector(list lst, Env* env); + list evaluate_hashmap(list lst, Env* env); MalType* eval_defbang(MalType* ast, Env** env); void eval_letstar(MalType** ast, Env** env); void eval_if(MalType** ast, Env** env); @@ -41,16 +42,43 @@ MalType* EVAL(MalType* ast, Env* env) { MalType* eval_do(MalType* ast, Env* env); MalType* eval_quote(MalType* ast); MalType* eval_quasiquote(MalType* ast); - MalType* eval_quasiquoteexpand(MalType* ast); /* Use goto to jump here rather than calling eval for tail-call elimination */ TCE_entry_point: + MalType* dbgeval = env_get(env, "DEBUG-EVAL"); + if (dbgeval && ! is_false(dbgeval) && ! is_nil(dbgeval)) + printf("EVAL: %s\n", pr_str(ast, READABLY)); + /* NULL */ if (!ast) { return make_nil(); } + if (is_symbol(ast)) { + MalType* symbol_value = env_get(env, ast->value.mal_symbol); + if (symbol_value) + return symbol_value; + else + return make_error_fmt("'%s' not found", ast->value.mal_symbol); + } + + if (is_vector(ast)) { + list result = evaluate_vector(ast->value.mal_list, env); + if (result && is_error(result->data)) + return result->data; + else + return make_vector(result); + } + + if (is_hashmap(ast)) { + list result = evaluate_hashmap(ast->value.mal_list, env); + if (result && is_error(result->data)) + return result->data; + else + return make_hashmap(result); + } + /* not a list */ - if (!is_list(ast)) { return eval_ast(ast, env); } + if (!is_list(ast)) { return ast; } /* empty list */ if (ast->value.mal_list == NULL) { return ast; } @@ -102,20 +130,13 @@ MalType* EVAL(MalType* ast, Env* env) { if (is_error(ast)) { return ast; } goto TCE_entry_point; } - else if (strcmp(symbol, SYMBOL_QUASIQUOTEEXPAND) == 0) { - - list lst = ast->value.mal_list; - return eval_quasiquote(make_list(lst)); - } } /* first element is not a special symbol */ - MalType* evaluated_list = eval_ast(ast, env); - - if (is_error(evaluated_list)) { return evaluated_list; } + list evlst = evaluate_list(ast->value.mal_list, env); + if (is_error(evlst->data)) return evlst->data; /* apply the first element of the list to the arguments */ - list evlst = evaluated_list->value.mal_list; MalType* func = evlst->data; if (is_function(func)) { @@ -183,13 +204,13 @@ int main(int argc, char** argv) { char* symbol = mappings->data; MalType*(*function)(list) = (MalType*(*)(list))mappings->next->data; - env_set_C_fn(repl_env, symbol, function); + env_set(repl_env, symbol, make_function(function)); /* pop symbol and function from hashmap/list */ mappings = mappings->next->next; } - env_set_C_fn(repl_env, "eval", mal_eval); + env_set(repl_env, "eval", make_function(mal_eval)); /* add functions written in mal - not using rep as it prints the result */ EVAL(READ("(def! not (fn* (a) (if a false true)))"), repl_env); @@ -201,7 +222,7 @@ int main(int argc, char** argv) { for (long i = 2; i < argc; i++) { lst = list_push(lst, make_string(argv[i])); } - env_set(repl_env, make_symbol("*ARGV*"), make_list(list_reverse(lst))); + env_set(repl_env, "*ARGV*", make_list(list_reverse(lst))); /* run in script mode if a filename is given */ if (argc > 1) { @@ -242,58 +263,6 @@ int main(int argc, char** argv) { return 0; } -MalType* eval_ast(MalType* ast, Env* env) { - - /* forward references */ - list evaluate_list(list lst, Env* env); - list evaluate_vector(list lst, Env* env); - list evaluate_hashmap(list lst, Env* env); - - if (is_symbol(ast)) { - - MalType* symbol_value = env_get(env, ast); - - if (symbol_value) { - return symbol_value; - } else { - return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY)); - } - } - else if (is_list(ast)) { - - list result = evaluate_list(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_list(result); - } else { - return result->data; - } - } - else if (is_vector(ast)) { - - list result = evaluate_vector(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_vector(result); - } else { - return result->data; - } - } - else if (is_hashmap(ast)) { - - list result = evaluate_hashmap(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_hashmap(result); - } else { - return result->data; - } - } - else { - return ast; - } -} - MalType* eval_defbang(MalType* ast, Env** env) { list lst = (ast->value.mal_list)->next; @@ -312,7 +281,7 @@ MalType* eval_defbang(MalType* ast, Env** env) { MalType* result = EVAL(defbang_value, *env); if (!is_error(result)){ - *env = env_set(*env, defbang_symbol, result); + env_set(*env, defbang_symbol->value.mal_symbol, result); } return result; } @@ -354,7 +323,7 @@ void eval_letstar(MalType** ast, Env** env) { return; } - env_set(letstar_env, symbol, value); + env_set(letstar_env, symbol->value.mal_symbol, value); bindings_list = bindings_list->next->next; } diff --git a/impls/c.2/step8_macros.c b/impls/c.2/step8_macros.c index 06c8097f91..04cbe6db25 100644 --- a/impls/c.2/step8_macros.c +++ b/impls/c.2/step8_macros.c @@ -19,11 +19,9 @@ #define SYMBOL_FNSTAR "fn*" #define SYMBOL_QUOTE "quote" #define SYMBOL_QUASIQUOTE "quasiquote" -#define SYMBOL_QUASIQUOTEEXPAND "quasiquoteexpand" #define SYMBOL_UNQUOTE "unquote" #define SYMBOL_SPLICE_UNQUOTE "splice-unquote" #define SYMBOL_DEFMACROBANG "defmacro!" -#define SYMBOL_MACROEXPAND "macroexpand" #define PROMPT_STRING "user> " @@ -35,7 +33,10 @@ MalType* READ(char* str) { MalType* EVAL(MalType* ast, Env* env) { /* forward references */ - MalType* eval_ast(MalType* ast, Env* env); + MalType* apply(MalType* fn, list args); + list evaluate_list(list lst, Env* env); + list evaluate_vector(list lst, Env* env); + list evaluate_hashmap(list lst, Env* env); MalType* eval_defbang(MalType* ast, Env** env); void eval_letstar(MalType** ast, Env** env); void eval_if(MalType** ast, Env** env); @@ -43,23 +44,44 @@ MalType* EVAL(MalType* ast, Env* env) { MalType* eval_do(MalType* ast, Env* env); MalType* eval_quote(MalType* ast); MalType* eval_quasiquote(MalType* ast); - MalType* eval_quasiquoteexpand(MalType* ast); MalType* eval_defmacrobang(MalType*, Env** env); - MalType* eval_macroexpand(MalType* ast, Env* env); - MalType* macroexpand(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, "DEBUG-EVAL"); + if (dbgeval && ! is_false(dbgeval) && ! is_nil(dbgeval)) + printf("EVAL: %s\n", pr_str(ast, READABLY)); + /* NULL */ if (!ast) { return make_nil(); } - /* macroexpansion */ - ast = macroexpand(ast, env); - if (is_error(ast)) { return ast; } + if (is_symbol(ast)) { + MalType* symbol_value = env_get(env, ast->value.mal_symbol); + if (symbol_value) + return symbol_value; + else + return make_error_fmt("'%s' not found", ast->value.mal_symbol); + } + + if (is_vector(ast)) { + list result = evaluate_vector(ast->value.mal_list, env); + if (result && is_error(result->data)) + return result->data; + else + return make_vector(result); + } + + if (is_hashmap(ast)) { + list result = evaluate_hashmap(ast->value.mal_list, env); + if (result && is_error(result->data)) + return result->data; + else + return make_hashmap(result); + } /* not a list */ - if (!is_list(ast)) { return eval_ast(ast, env); } + if (!is_list(ast)) { return ast; } /* empty list */ if (ast->value.mal_list == NULL) { return ast; } @@ -111,30 +133,25 @@ MalType* EVAL(MalType* ast, Env* env) { if (is_error(ast)) { return ast; } goto TCE_entry_point; } - else if (strcmp(symbol, SYMBOL_QUASIQUOTEEXPAND) == 0) { - - list lst = ast->value.mal_list; - return eval_quasiquote(make_list(lst)); - } else if (strcmp(symbol, SYMBOL_DEFMACROBANG) == 0) { return eval_defmacrobang(ast, &env); } - else if (strcmp(symbol, SYMBOL_MACROEXPAND) == 0) { - return eval_macroexpand(ast, env); - } } /* first element is not a special symbol */ - MalType* evaluated_list = eval_ast(ast, env); - - if (is_error(evaluated_list)) { return evaluated_list; } + MalType* func = EVAL(first, env); + if (is_error(func)) { return func; } + if (func->is_macro) { + ast = apply(func, ast->value.mal_list->next); + if (is_error(ast)) { return ast; } + goto TCE_entry_point; + } + list evlst = evaluate_list(ast->value.mal_list->next, env); + if (evlst && is_error(evlst->data)) { return evlst->data; } /* apply the first element of the list to the arguments */ - list evlst = evaluated_list->value.mal_list; - MalType* func = evlst->data; - if (is_function(func)) { - return (*func->value.mal_function)(evlst->next); + return (*func->value.mal_function)(evlst); } else if (is_closure(func)) { @@ -142,7 +159,7 @@ MalType* EVAL(MalType* ast, Env* env) { list params = (closure->parameters)->value.mal_list; long param_count = list_count(params); - long arg_count = list_count(evlst->next); + long arg_count = list_count(evlst); if (param_count > arg_count) { return make_error("too few arguments supplied to function"); @@ -153,7 +170,7 @@ MalType* EVAL(MalType* ast, Env* env) { else { /* TCE - modify ast and env directly and jump back to eval */ - env = env_make(closure->env, params, evlst->next, closure->more_symbol); + env = env_make(closure->env, params, evlst, closure->more_symbol); ast = func->value.mal_closure->definition; if (is_error(ast)) { return ast; } @@ -198,13 +215,13 @@ int main(int argc, char** argv) { char* symbol = mappings->data; MalType*(*function)(list) = (MalType*(*)(list))mappings->next->data; - env_set_C_fn(repl_env, symbol, function); + env_set(repl_env, symbol, make_function(function)); /* pop symbol and function from hashmap/list */ mappings = mappings->next->next; } - env_set_C_fn(repl_env, "eval", mal_eval); + env_set(repl_env, "eval", make_function(mal_eval)); /* add functions written in mal - not using rep as it prints the result */ EVAL(READ("(def! not (fn* (a) (if a false true)))"), repl_env); @@ -216,7 +233,7 @@ int main(int argc, char** argv) { for (long i = 2; i < argc; i++) { lst = list_push(lst, make_string(argv[i])); } - env_set(repl_env, make_symbol("*ARGV*"), make_list(list_reverse(lst))); + env_set(repl_env, "*ARGV*", make_list(list_reverse(lst))); /* run in script mode if a filename is given */ if (argc > 1) { @@ -257,58 +274,6 @@ int main(int argc, char** argv) { return 0; } -MalType* eval_ast(MalType* ast, Env* env) { - - /* forward references */ - list evaluate_list(list lst, Env* env); - list evaluate_vector(list lst, Env* env); - list evaluate_hashmap(list lst, Env* env); - - if (is_symbol(ast)) { - - MalType* symbol_value = env_get(env, ast); - - if (symbol_value) { - return symbol_value; - } else { - return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY)); - } - } - else if (is_list(ast)) { - - list result = evaluate_list(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_list(result); - } else { - return result->data; - } - } - else if (is_vector(ast)) { - - list result = evaluate_vector(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_vector(result); - } else { - return result->data; - } - } - else if (is_hashmap(ast)) { - - list result = evaluate_hashmap(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_hashmap(result); - } else { - return result->data; - } - } - else { - return ast; - } -} - MalType* eval_defbang(MalType* ast, Env** env) { list lst = (ast->value.mal_list)->next; @@ -327,7 +292,7 @@ MalType* eval_defbang(MalType* ast, Env** env) { MalType* result = EVAL(defbang_value, *env); if (!is_error(result)){ - *env = env_set(*env, defbang_symbol, result); + env_set(*env, defbang_symbol->value.mal_symbol, result); } return result; } @@ -369,7 +334,7 @@ void eval_letstar(MalType** ast, Env** env) { return; } - env_set(letstar_env, symbol, value); + env_set(letstar_env, symbol->value.mal_symbol, value); bindings_list = bindings_list->next->next; } @@ -668,51 +633,11 @@ MalType* eval_defmacrobang(MalType* ast, Env** env) { if (!is_error(result)) { result = copy_type(result); result->is_macro = 1; - *env = env_set(*env, defbang_symbol, result); + env_set(*env, defbang_symbol->value.mal_symbol, result); } return result; } -MalType* eval_macroexpand(MalType* ast, Env* env) { - - /* forward reference */ - MalType* macroexpand(MalType* ast, Env* env); - - list lst = ast->value.mal_list; - - if (!lst->next) { - return make_nil(); - } - else if (lst->next->next) { - return make_error("'macroexpand': expected exactly one argument"); - } - else { - return macroexpand(lst->next->data, env); - } -} - -MalType* macroexpand(MalType* ast, Env* env) { - - /* forward reference */ - int is_macro_call(MalType* ast, Env* env); - - while(is_macro_call(ast, env)) { - - list lst = ast->value.mal_list; - - MalType* macro_fn = env_get(env, lst->data); - MalClosure* cls = macro_fn->value.mal_closure; - MalType* more_symbol = cls->more_symbol; - - list params_list = (cls->parameters)->value.mal_list; - list args_list = lst->next; - - env = env_make(cls->env, params_list, args_list, more_symbol); - ast = EVAL(cls->definition, env); - } - return ast; -} - list evaluate_list(list lst, Env* env) { list evlst = NULL; @@ -866,32 +791,3 @@ MalType* apply(MalType* fn, list args) { } } } - -int is_macro_call(MalType* ast, Env* env) { - - /* not a list */ - if (!is_list(ast)) { - return 0; - } - - /* empty list */ - list lst = ast->value.mal_list; - if (!lst) { - return 0; - } - - /* first item not a symbol */ - MalType* first = lst->data; - if (!is_symbol(first)) { - return 0; - } - - /* lookup symbol */ - MalType* val = env_get(env, first); - if (is_error(val)) { - return 0; - } - else { - return (val->is_macro); - } -} diff --git a/impls/c.2/step9_try.c b/impls/c.2/step9_try.c index 5bcf328973..45418bb080 100644 --- a/impls/c.2/step9_try.c +++ b/impls/c.2/step9_try.c @@ -19,11 +19,9 @@ #define SYMBOL_FNSTAR "fn*" #define SYMBOL_QUOTE "quote" #define SYMBOL_QUASIQUOTE "quasiquote" -#define SYMBOL_QUASIQUOTEEXPAND "quasiquoteexpand" #define SYMBOL_UNQUOTE "unquote" #define SYMBOL_SPLICE_UNQUOTE "splice-unquote" #define SYMBOL_DEFMACROBANG "defmacro!" -#define SYMBOL_MACROEXPAND "macroexpand" #define SYMBOL_TRYSTAR "try*" #define SYMBOL_CATCHSTAR "catch*" @@ -37,7 +35,10 @@ MalType* READ(char* str) { MalType* EVAL(MalType* ast, Env* env) { /* forward references */ - MalType* eval_ast(MalType* ast, Env* env); + MalType* apply(MalType* fn, list args); + list evaluate_list(list lst, Env* env); + list evaluate_vector(list lst, Env* env); + list evaluate_hashmap(list lst, Env* env); MalType* eval_defbang(MalType* ast, Env** env); void eval_letstar(MalType** ast, Env** env); void eval_if(MalType** ast, Env** env); @@ -45,24 +46,45 @@ MalType* EVAL(MalType* ast, Env* env) { MalType* eval_do(MalType* ast, Env* env); MalType* eval_quote(MalType* ast); MalType* eval_quasiquote(MalType* ast); - MalType* eval_quasiquoteexpand(MalType* ast); MalType* eval_defmacrobang(MalType*, Env** env); - MalType* eval_macroexpand(MalType* ast, Env* env); - MalType* macroexpand(MalType* ast, Env* env); void eval_try(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, "DEBUG-EVAL"); + if (dbgeval && ! is_false(dbgeval) && ! is_nil(dbgeval)) + printf("EVAL: %s\n", pr_str(ast, READABLY)); + /* NULL */ if (!ast) { return make_nil(); } - /* macroexpansion */ - ast = macroexpand(ast, env); - if (is_error(ast)) { return ast; } + if (is_symbol(ast)) { + MalType* symbol_value = env_get(env, ast->value.mal_symbol); + if (symbol_value) + return symbol_value; + else + return make_error_fmt("'%s' not found", ast->value.mal_symbol); + } + + if (is_vector(ast)) { + list result = evaluate_vector(ast->value.mal_list, env); + if (result && is_error(result->data)) + return result->data; + else + return make_vector(result); + } + + if (is_hashmap(ast)) { + list result = evaluate_hashmap(ast->value.mal_list, env); + if (result && is_error(result->data)) + return result->data; + else + return make_hashmap(result); + } /* not a list */ - if (!is_list(ast)) { return eval_ast(ast, env); } + if (!is_list(ast)) { return ast; } /* empty list */ if (ast->value.mal_list == NULL) { return ast; } @@ -114,17 +136,9 @@ MalType* EVAL(MalType* ast, Env* env) { if (is_error(ast)) { return ast; } goto TCE_entry_point; } - else if (strcmp(symbol, SYMBOL_QUASIQUOTEEXPAND) == 0) { - - list lst = ast->value.mal_list; - return eval_quasiquote(make_list(lst)); - } else if (strcmp(symbol, SYMBOL_DEFMACROBANG) == 0) { return eval_defmacrobang(ast, &env); } - else if (strcmp(symbol, SYMBOL_MACROEXPAND) == 0) { - return eval_macroexpand(ast, env); - } else if (strcmp(symbol, SYMBOL_TRYSTAR) == 0) { /* TCE - modify ast and env directly and jump back to eval */ @@ -135,16 +149,19 @@ MalType* EVAL(MalType* ast, Env* env) { } } /* first element is not a special symbol */ - MalType* evaluated_list = eval_ast(ast, env); - - if (is_error(evaluated_list)) { return evaluated_list; } + MalType* func = EVAL(first, env); + if (is_error(func)) { return func; } + if (func->is_macro) { + ast = apply(func, ast->value.mal_list->next); + if (is_error(ast)) { return ast; } + goto TCE_entry_point; + } + list evlst = evaluate_list(ast->value.mal_list->next, env); + if (evlst && is_error(evlst->data)) { return evlst->data; } /* apply the first element of the list to the arguments */ - list evlst = evaluated_list->value.mal_list; - MalType* func = evlst->data; - if (is_function(func)) { - return (*func->value.mal_function)(evlst->next); + return (*func->value.mal_function)(evlst); } else if (is_closure(func)) { @@ -152,7 +169,7 @@ MalType* EVAL(MalType* ast, Env* env) { list params = (closure->parameters)->value.mal_list; long param_count = list_count(params); - long arg_count = list_count(evlst->next); + long arg_count = list_count(evlst); if (param_count > arg_count) { return make_error("too few arguments supplied to function"); @@ -163,7 +180,7 @@ MalType* EVAL(MalType* ast, Env* env) { else { /* TCE - modify ast and env directly and jump back to eval */ - env = env_make(closure->env, params, evlst->next, closure->more_symbol); + env = env_make(closure->env, params, evlst, closure->more_symbol); ast = func->value.mal_closure->definition; if (is_error(ast)) { return ast; } @@ -209,13 +226,13 @@ int main(int argc, char** argv) { char* symbol = mappings->data; MalType*(*function)(list) = (MalType*(*)(list))mappings->next->data; - env_set_C_fn(repl_env, symbol, function); + env_set(repl_env, symbol, make_function(function)); /* pop symbol and function from hashmap/list */ mappings = mappings->next->next; } - env_set_C_fn(repl_env, "eval", mal_eval); + env_set(repl_env, "eval", make_function(mal_eval)); /* add functions written in mal - not using rep as it prints the result */ EVAL(READ("(def! not (fn* (a) (if a false true)))"), repl_env); @@ -227,7 +244,7 @@ int main(int argc, char** argv) { for (long i = 2; i < argc; i++) { lst = list_push(lst, make_string(argv[i])); } - env_set(repl_env, make_symbol("*ARGV*"), make_list(list_reverse(lst))); + env_set(repl_env, "*ARGV*", make_list(list_reverse(lst))); /* run in script mode if a filename is given */ if (argc > 1) { @@ -268,58 +285,6 @@ int main(int argc, char** argv) { return 0; } -MalType* eval_ast(MalType* ast, Env* env) { - - /* forward references */ - list evaluate_list(list lst, Env* env); - list evaluate_vector(list lst, Env* env); - list evaluate_hashmap(list lst, Env* env); - - if (is_symbol(ast)) { - - MalType* symbol_value = env_get(env, ast); - - if (symbol_value) { - return symbol_value; - } else { - return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY)); - } - } - else if (is_list(ast)) { - - list result = evaluate_list(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_list(result); - } else { - return result->data; - } - } - else if (is_vector(ast)) { - - list result = evaluate_vector(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_vector(result); - } else { - return result->data; - } - } - else if (is_hashmap(ast)) { - - list result = evaluate_hashmap(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_hashmap(result); - } else { - return result->data; - } - } - else { - return ast; - } -} - MalType* eval_defbang(MalType* ast, Env** env) { list lst = (ast->value.mal_list)->next; @@ -338,7 +303,7 @@ MalType* eval_defbang(MalType* ast, Env** env) { MalType* result = EVAL(defbang_value, *env); if (!is_error(result)){ - *env = env_set(*env, defbang_symbol, result); + env_set(*env, defbang_symbol->value.mal_symbol, result); } return result; } @@ -380,7 +345,7 @@ void eval_letstar(MalType** ast, Env** env) { return; } - env_set(letstar_env, symbol, value); + env_set(letstar_env, symbol->value.mal_symbol, value); bindings_list = bindings_list->next->next; } @@ -679,51 +644,11 @@ MalType* eval_defmacrobang(MalType* ast, Env** env) { if (!is_error(result)) { result = copy_type(result); result->is_macro = 1; - *env = env_set(*env, defbang_symbol, result); + env_set(*env, defbang_symbol->value.mal_symbol, result); } return result; } -MalType* eval_macroexpand(MalType* ast, Env* env) { - - /* forward reference */ - MalType* macroexpand(MalType* ast, Env* env); - - list lst = ast->value.mal_list; - - if (!lst->next) { - return make_nil(); - } - else if (lst->next->next) { - return make_error("'macroexpand': expected exactly one argument"); - } - else { - return macroexpand(lst->next->data, env); - } -} - -MalType* macroexpand(MalType* ast, Env* env) { - - /* forward reference */ - int is_macro_call(MalType* ast, Env* env); - - while(is_macro_call(ast, env)) { - - list lst = ast->value.mal_list; - - MalType* macro_fn = env_get(env, lst->data); - MalClosure* cls = macro_fn->value.mal_closure; - MalType* more_symbol = cls->more_symbol; - - list params_list = (cls->parameters)->value.mal_list; - list args_list = lst->next; - - env = env_make(cls->env, params_list, args_list, more_symbol); - ast = EVAL(cls->definition, env); - } - return ast; -} - void eval_try(MalType** ast, Env** env) { list lst = (*ast)->value.mal_list; @@ -773,11 +698,10 @@ void eval_try(MalType** ast, Env** env) { } /* bind the symbol to the exception */ - list symbol_list = list_make(catch_list->next->data); - list expr_list = list_make(try_result->value.mal_error); - - /* TODO: validate symbols and exprs match before calling env_make */ - Env* catch_env = env_make(*env, symbol_list, expr_list, NULL); + Env* catch_env = env_make(*env, NULL, NULL, NULL); + env_set(catch_env, + ((MalType*)catch_list->next->data)->value.mal_symbol, + try_result->value.mal_error); *ast = catch_list->next->next->data; *env = catch_env; @@ -937,32 +861,3 @@ MalType* apply(MalType* fn, list args) { } } } - -int is_macro_call(MalType* ast, Env* env) { - - /* not a list */ - if (!is_list(ast)) { - return 0; - } - - /* empty list */ - list lst = ast->value.mal_list; - if (!lst) { - return 0; - } - - /* first item not a symbol */ - MalType* first = lst->data; - if (!is_symbol(first)) { - return 0; - } - - /* lookup symbol */ - MalType* val = env_get(env, first); - if (is_error(val)) { - return 0; - } - else { - return (val->is_macro); - } -} diff --git a/impls/c.2/stepA_mal.c b/impls/c.2/stepA_mal.c index 8cd1a51d3d..782fd69553 100644 --- a/impls/c.2/stepA_mal.c +++ b/impls/c.2/stepA_mal.c @@ -20,11 +20,9 @@ #define SYMBOL_FNSTAR "fn*" #define SYMBOL_QUOTE "quote" #define SYMBOL_QUASIQUOTE "quasiquote" -#define SYMBOL_QUASIQUOTEEXPAND "quasiquoteexpand" #define SYMBOL_UNQUOTE "unquote" #define SYMBOL_SPLICE_UNQUOTE "splice-unquote" #define SYMBOL_DEFMACROBANG "defmacro!" -#define SYMBOL_MACROEXPAND "macroexpand" #define SYMBOL_TRYSTAR "try*" #define SYMBOL_CATCHSTAR "catch*" @@ -38,7 +36,10 @@ MalType* READ(char* str) { MalType* EVAL(MalType* ast, Env* env) { /* forward references */ - MalType* eval_ast(MalType* ast, Env* env); + MalType* apply(MalType* fn, list args); + list evaluate_list(list lst, Env* env); + list evaluate_vector(list lst, Env* env); + list evaluate_hashmap(list lst, Env* env); MalType* eval_defbang(MalType* ast, Env** env); void eval_letstar(MalType** ast, Env** env); void eval_if(MalType** ast, Env** env); @@ -46,24 +47,45 @@ MalType* EVAL(MalType* ast, Env* env) { MalType* eval_do(MalType* ast, Env* env); MalType* eval_quote(MalType* ast); MalType* eval_quasiquote(MalType* ast); - MalType* eval_quasiquoteexpand(MalType* ast); MalType* eval_defmacrobang(MalType*, Env** env); - MalType* eval_macroexpand(MalType* ast, Env* env); - MalType* macroexpand(MalType* ast, Env* env); void eval_try(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, "DEBUG-EVAL"); + if (dbgeval && ! is_false(dbgeval) && ! is_nil(dbgeval)) + printf("EVAL: %s\n", pr_str(ast, READABLY)); + /* NULL */ if (!ast) { return make_nil(); } - /* macroexpansion */ - ast = macroexpand(ast, env); - if (is_error(ast)) { return ast; } + if (is_symbol(ast)) { + MalType* symbol_value = env_get(env, ast->value.mal_symbol); + if (symbol_value) + return symbol_value; + else + return make_error_fmt("'%s' not found", ast->value.mal_symbol); + } + + if (is_vector(ast)) { + list result = evaluate_vector(ast->value.mal_list, env); + if (result && is_error(result->data)) + return result->data; + else + return make_vector(result); + } + + if (is_hashmap(ast)) { + list result = evaluate_hashmap(ast->value.mal_list, env); + if (result && is_error(result->data)) + return result->data; + else + return make_hashmap(result); + } /* not a list */ - if (!is_list(ast)) { return eval_ast(ast, env); } + if (!is_list(ast)) { return ast; } /* empty list */ if (ast->value.mal_list == NULL) { return ast; } @@ -115,17 +137,9 @@ MalType* EVAL(MalType* ast, Env* env) { if (is_error(ast)) { return ast; } goto TCE_entry_point; } - else if (strcmp(symbol, SYMBOL_QUASIQUOTEEXPAND) == 0) { - - list lst = ast->value.mal_list; - return eval_quasiquote(make_list(lst)); - } else if (strcmp(symbol, SYMBOL_DEFMACROBANG) == 0) { return eval_defmacrobang(ast, &env); } - else if (strcmp(symbol, SYMBOL_MACROEXPAND) == 0) { - return eval_macroexpand(ast, env); - } else if (strcmp(symbol, SYMBOL_TRYSTAR) == 0) { /* TCE - modify ast and env directly and jump back to eval */ @@ -136,16 +150,19 @@ MalType* EVAL(MalType* ast, Env* env) { } } /* first element is not a special symbol */ - MalType* evaluated_list = eval_ast(ast, env); - - if (is_error(evaluated_list)) { return evaluated_list; } + MalType* func = EVAL(first, env); + if (is_error(func)) { return func; } + if (func->is_macro) { + ast = apply(func, ast->value.mal_list->next); + if (is_error(ast)) { return ast; } + goto TCE_entry_point; + } + list evlst = evaluate_list(ast->value.mal_list->next, env); + if (evlst && is_error(evlst->data)) { return evlst->data; } /* apply the first element of the list to the arguments */ - list evlst = evaluated_list->value.mal_list; - MalType* func = evlst->data; - if (is_function(func)) { - return (*func->value.mal_function)(evlst->next); + return (*func->value.mal_function)(evlst); } else if (is_closure(func)) { @@ -153,7 +170,7 @@ MalType* EVAL(MalType* ast, Env* env) { list params = (closure->parameters)->value.mal_list; long param_count = list_count(params); - long arg_count = list_count(evlst->next); + long arg_count = list_count(evlst); if (param_count > arg_count) { return make_error("too few arguments supplied to function"); @@ -164,7 +181,7 @@ MalType* EVAL(MalType* ast, Env* env) { else { /* TCE - modify ast and env directly and jump back to eval */ - env = env_make(closure->env, params, evlst->next, closure->more_symbol); + env = env_make(closure->env, params, evlst, closure->more_symbol); ast = func->value.mal_closure->definition; if (is_error(ast)) { return ast; } @@ -233,14 +250,14 @@ int main(int argc, char** argv) { char* symbol = mappings->data; MalType*(*function)(list) = mappings->next->data; - env_set_C_fn(repl_env, symbol, function); + env_set(repl_env, symbol, make_function(function)); /* pop symbol and function from hashmap/list */ mappings = mappings->next->next; } - env_set_C_fn(repl_env, "eval", mal_eval); - env_set_C_fn(repl_env, "readline", mal_readline); + env_set(repl_env, "eval", make_function(mal_eval)); + env_set(repl_env, "readline", make_function(mal_readline)); /* add functions written in mal - not using rep as it prints the result */ EVAL(READ("(def! not (fn* (a) (if a false true)))"), repl_env); @@ -252,8 +269,8 @@ int main(int argc, char** argv) { for (long i = 2; i < argc; i++) { lst = list_push(lst, make_string(argv[i])); } - env_set(repl_env, make_symbol("*ARGV*"), make_list(list_reverse(lst))); - env_set(repl_env, make_symbol("*host-language*"), make_string("c.2")); + env_set(repl_env, "*ARGV*", make_list(list_reverse(lst))); + env_set(repl_env, "*host-language*", make_string("c.2")); /* run in script mode if a filename is given */ if (argc > 1) { @@ -293,58 +310,6 @@ int main(int argc, char** argv) { return 0; } -MalType* eval_ast(MalType* ast, Env* env) { - - /* forward references */ - list evaluate_list(list lst, Env* env); - list evaluate_vector(list lst, Env* env); - list evaluate_hashmap(list lst, Env* env); - - if (is_symbol(ast)) { - - MalType* symbol_value = env_get(env, ast); - - if (symbol_value) { - return symbol_value; - } else { - return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY)); - } - } - else if (is_list(ast)) { - - list result = evaluate_list(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_list(result); - } else { - return result->data; - } - } - else if (is_vector(ast)) { - - list result = evaluate_vector(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_vector(result); - } else { - return result->data; - } - } - else if (is_hashmap(ast)) { - - list result = evaluate_hashmap(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_hashmap(result); - } else { - return result->data; - } - } - else { - return ast; - } -} - MalType* eval_defbang(MalType* ast, Env** env) { list lst = (ast->value.mal_list)->next; @@ -363,7 +328,7 @@ MalType* eval_defbang(MalType* ast, Env** env) { MalType* result = EVAL(defbang_value, *env); if (!is_error(result)){ - *env = env_set(*env, defbang_symbol, result); + env_set(*env, defbang_symbol->value.mal_symbol, result); } return result; } @@ -405,7 +370,7 @@ void eval_letstar(MalType** ast, Env** env) { return; } - env_set(letstar_env, symbol, value); + env_set(letstar_env, symbol->value.mal_symbol, value); bindings_list = bindings_list->next->next; } @@ -704,51 +669,11 @@ MalType* eval_defmacrobang(MalType* ast, Env** env) { if (!is_error(result)) { result = copy_type(result); result->is_macro = 1; - *env = env_set(*env, defbang_symbol, result); + env_set(*env, defbang_symbol->value.mal_symbol, result); } return result; } -MalType* eval_macroexpand(MalType* ast, Env* env) { - - /* forward reference */ - MalType* macroexpand(MalType* ast, Env* env); - - list lst = ast->value.mal_list; - - if (!lst->next) { - return make_nil(); - } - else if (lst->next->next) { - return make_error("'macroexpand': expected exactly one argument"); - } - else { - return macroexpand(lst->next->data, env); - } -} - -MalType* macroexpand(MalType* ast, Env* env) { - - /* forward reference */ - int is_macro_call(MalType* ast, Env* env); - - while(is_macro_call(ast, env)) { - - list lst = ast->value.mal_list; - - MalType* macro_fn = env_get(env, lst->data); - MalClosure* cls = macro_fn->value.mal_closure; - MalType* more_symbol = cls->more_symbol; - - list params_list = (cls->parameters)->value.mal_list; - list args_list = lst->next; - - env = env_make(cls->env, params_list, args_list, more_symbol); - ast = EVAL(cls->definition, env); - } - return ast; -} - void eval_try(MalType** ast, Env** env) { list lst = (*ast)->value.mal_list; @@ -798,10 +723,10 @@ void eval_try(MalType** ast, Env** env) { } /* bind the symbol to the exception */ - list symbol_list = list_make(catch_list->next->data); - list expr_list = list_make(try_result->value.mal_error); - - Env* catch_env = env_make(*env, symbol_list, expr_list, NULL); + Env* catch_env = env_make(*env, NULL, NULL, NULL); + env_set(catch_env, + ((MalType*)catch_list->next->data)->value.mal_symbol, + try_result->value.mal_error); *ast = catch_list->next->next->data; *env = catch_env; @@ -961,32 +886,3 @@ MalType* apply(MalType* fn, list args) { } } } - -int is_macro_call(MalType* ast, Env* env) { - - /* not a list */ - if (!is_list(ast)) { - return 0; - } - - /* empty list */ - list lst = ast->value.mal_list; - if (!lst) { - return 0; - } - - /* first item not a symbol */ - MalType* first = lst->data; - if (!is_symbol(first)) { - return 0; - } - - /* lookup symbol */ - MalType* val = env_get(env, first); - if (is_error(val)) { - return 0; - } - else { - return (val->is_macro); - } -} diff --git a/impls/c/env.c b/impls/c/env.c index c3128f97af..b0204280aa 100644 --- a/impls/c/env.c +++ b/impls/c/env.c @@ -20,10 +20,11 @@ Env *new_env(Env *outer, MalVal* binds, MalVal *exprs) { if (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))); + env_set(e, _nth(binds, i+1)->val.string, + _slice(exprs, i, _count(exprs))); break; } else { - env_set(e, _nth(binds, i), _nth(exprs, i)); + env_set(e, _nth(binds, i)->val.string, _nth(exprs, i)); } } assert(varargs || (binds_len == exprs_len), @@ -34,24 +35,17 @@ Env *new_env(Env *outer, MalVal* binds, MalVal *exprs) { return e; } -Env *env_find(Env *env, MalVal *key) { - void *val = g_hash_table_lookup(env->table, key->val.string); +MalVal *env_get(Env *env, const char *key) { + MalVal *val = g_hash_table_lookup(env->table, key); if (val) { - return env; + return val; } else if (env->outer) { - return env_find(env->outer, key); + return env_get(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; +void env_set(Env *env, char *key, MalVal *val) { + g_hash_table_insert(env->table, key, val); } diff --git a/impls/c/step2_eval.c b/impls/c/step2_eval.c index 8c54184c05..b0b786e807 100644 --- a/impls/c/step2_eval.c +++ b/impls/c/step2_eval.c @@ -29,15 +29,19 @@ MalVal *READ(char prompt[], char *str) { } // eval -MalVal *eval_ast(MalVal *ast, GHashTable *env) { +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) || (ast->type == MAL_VECTOR)) { + } 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; @@ -62,22 +66,12 @@ MalVal *eval_ast(MalVal *ast, GHashTable *env) { //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); + 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)); diff --git a/impls/c/step3_env.c b/impls/c/step3_env.c index d51704e053..30c63336fd 100644 --- a/impls/c/step3_env.c +++ b/impls/c/step3_env.c @@ -29,12 +29,22 @@ MalVal *READ(char prompt[], char *str) { } // eval -MalVal *eval_ast(MalVal *ast, Env *env) { +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); - return env_get(env, ast); - } else if ((ast->type == MAL_LIST) || (ast->type == MAL_VECTOR)) { + 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; @@ -59,15 +69,6 @@ MalVal *eval_ast(MalVal *ast, Env *env) { //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)); @@ -81,7 +82,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { *a2 = _nth(ast, 2); MalVal *res = EVAL(a2, env); if (mal_error) return NULL; - env_set(env, a1, res); + env_set(env, a1->val.string, res); return res; } else if (strcmp("let*", a0->val.string) == 0) { //g_print("eval apply let*\n"); @@ -97,12 +98,12 @@ MalVal *EVAL(MalVal *ast, Env *env) { key = g_array_index(a1->val.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)); + env_set(let_env, key->val.string, EVAL(val, let_env)); } return EVAL(a2, let_env); } else { //g_print("eval apply\n"); - MalVal *el = eval_ast(ast, env); + 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)); @@ -142,10 +143,10 @@ 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); + 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() diff --git a/impls/c/step4_if_fn_do.c b/impls/c/step4_if_fn_do.c index c6628c16c2..6413a4e43d 100644 --- a/impls/c/step4_if_fn_do.c +++ b/impls/c/step4_if_fn_do.c @@ -30,12 +30,22 @@ MalVal *READ(char prompt[], char *str) { } // eval -MalVal *eval_ast(MalVal *ast, Env *env) { +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); - return env_get(env, ast); - } else if ((ast->type == MAL_LIST) || (ast->type == MAL_VECTOR)) { + 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; @@ -60,15 +70,6 @@ MalVal *eval_ast(MalVal *ast, Env *env) { //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)); @@ -82,7 +83,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { *a2 = _nth(ast, 2); MalVal *res = EVAL(a2, env); if (mal_error) return NULL; - env_set(env, a1, res); + env_set(env, a1->val.string, res); return res; } else if ((a0->type & MAL_SYMBOL) && strcmp("let*", a0->val.string) == 0) { @@ -99,13 +100,13 @@ MalVal *EVAL(MalVal *ast, Env *env) { key = g_array_index(a1->val.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)); + 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 = eval_ast(_rest(ast), env); + 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) { @@ -136,7 +137,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { return mf; } else { //g_print("eval apply\n"); - MalVal *el = eval_ast(ast, env); + MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); if (!el || mal_error) { return NULL; } MalVal *f = _first(el), *args = _rest(el); @@ -177,8 +178,7 @@ void init_repl_env() { // 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), + env_set(repl_env, core_ns[i].name, malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); } diff --git a/impls/c/step5_tco.c b/impls/c/step5_tco.c index 917e3e3807..26e9beb592 100644 --- a/impls/c/step5_tco.c +++ b/impls/c/step5_tco.c @@ -30,12 +30,24 @@ MalVal *READ(char prompt[], char *str) { } // eval -MalVal *eval_ast(MalVal *ast, Env *env) { +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); - return env_get(env, ast); - } else if ((ast->type == MAL_LIST) || (ast->type == MAL_VECTOR)) { + 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; @@ -60,17 +72,6 @@ MalVal *eval_ast(MalVal *ast, Env *env) { //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)); @@ -84,7 +85,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { *a2 = _nth(ast, 2); MalVal *res = EVAL(a2, env); if (mal_error) return NULL; - env_set(env, a1, res); + env_set(env, a1->val.string, res); return res; } else if ((a0->type & MAL_SYMBOL) && strcmp("let*", a0->val.string) == 0) { @@ -101,7 +102,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { key = g_array_index(a1->val.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)); + env_set(let_env, key->val.string, EVAL(val, let_env)); } ast = a2; env = let_env; @@ -109,7 +110,7 @@ MalVal *EVAL(MalVal *ast, Env *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); + _map2((MalVal *(*)(void*, void*))EVAL, _slice(ast, 1, _count(ast) - 1), env); ast = _last(ast); // Continue loop } else if ((a0->type & MAL_SYMBOL) && @@ -141,7 +142,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { return mf; } else { //g_print("eval apply\n"); - MalVal *el = eval_ast(ast, env); + MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); if (!el || mal_error) { return NULL; } MalVal *f = _first(el), *args = _rest(el); @@ -190,8 +191,7 @@ void init_repl_env() { // 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), + env_set(repl_env, core_ns[i].name, malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); } diff --git a/impls/c/step6_file.c b/impls/c/step6_file.c index e7388c878b..7126ce525b 100644 --- a/impls/c/step6_file.c +++ b/impls/c/step6_file.c @@ -30,12 +30,24 @@ MalVal *READ(char prompt[], char *str) { } // eval -MalVal *eval_ast(MalVal *ast, Env *env) { +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); - return env_get(env, ast); - } else if ((ast->type == MAL_LIST) || (ast->type == MAL_VECTOR)) { + 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; @@ -60,17 +72,6 @@ MalVal *eval_ast(MalVal *ast, Env *env) { //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)); @@ -84,7 +85,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { *a2 = _nth(ast, 2); MalVal *res = EVAL(a2, env); if (mal_error) return NULL; - env_set(env, a1, res); + env_set(env, a1->val.string, res); return res; } else if ((a0->type & MAL_SYMBOL) && strcmp("let*", a0->val.string) == 0) { @@ -101,7 +102,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { key = g_array_index(a1->val.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)); + env_set(let_env, key->val.string, EVAL(val, let_env)); } ast = a2; env = let_env; @@ -109,7 +110,7 @@ MalVal *EVAL(MalVal *ast, Env *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); + _map2((MalVal *(*)(void*, void*))EVAL, _slice(ast, 1, _count(ast)-1), env); ast = _last(ast); // Continue loop } else if ((a0->type & MAL_SYMBOL) && @@ -141,7 +142,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { return mf; } else { //g_print("eval apply\n"); - MalVal *el = eval_ast(ast, env); + MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); if (!el || mal_error) { return NULL; } MalVal *f = _first(el), *args = _rest(el); @@ -192,12 +193,10 @@ void init_repl_env(int argc, char *argv[]) { // 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), + env_set(repl_env, core_ns[i].name, malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); } - env_set(repl_env, - malval_new_symbol("eval"), + env_set(repl_env, "eval", malval_new_function((void*(*)(void *))do_eval, 1)); MalVal *_argv = _listX(0); @@ -205,7 +204,7 @@ void init_repl_env(int argc, char *argv[]) { MalVal *arg = malval_new_string(argv[i]); g_array_append_val(_argv->val.array, arg); } - env_set(repl_env, malval_new_symbol("*ARGV*"), _argv); + env_set(repl_env, "*ARGV*", _argv); // core.mal: defined using the language itself RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); diff --git a/impls/c/step7_quote.c b/impls/c/step7_quote.c index a42f978041..71dfc608c1 100644 --- a/impls/c/step7_quote.c +++ b/impls/c/step7_quote.c @@ -68,12 +68,24 @@ MalVal *quasiquote(MalVal *ast) { } } -MalVal *eval_ast(MalVal *ast, Env *env) { +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); - return env_get(env, ast); - } else if ((ast->type == MAL_LIST) || (ast->type == MAL_VECTOR)) { + 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; @@ -98,17 +110,6 @@ MalVal *eval_ast(MalVal *ast, Env *env) { //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)); @@ -122,7 +123,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { *a2 = _nth(ast, 2); MalVal *res = EVAL(a2, env); if (mal_error) return NULL; - env_set(env, a1, res); + env_set(env, a1->val.string, res); return res; } else if ((a0->type & MAL_SYMBOL) && strcmp("let*", a0->val.string) == 0) { @@ -139,7 +140,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { key = g_array_index(a1->val.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)); + env_set(let_env, key->val.string, EVAL(val, let_env)); } ast = a2; env = let_env; @@ -148,9 +149,6 @@ MalVal *EVAL(MalVal *ast, Env *env) { strcmp("quote", a0->val.string) == 0) { //g_print("eval apply quote\n"); return _nth(ast, 1); - } else if ((a0->type & MAL_SYMBOL) && - strcmp("quasiquoteexpand", a0->val.string) == 0) { - return quasiquote(_nth(ast, 1)); } else if ((a0->type & MAL_SYMBOL) && strcmp("quasiquote", a0->val.string) == 0) { //g_print("eval apply quasiquote\n"); @@ -160,7 +158,7 @@ MalVal *EVAL(MalVal *ast, Env *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); + _map2((MalVal *(*)(void*, void*))EVAL, _slice(ast, 1, _count(ast)-1), env); ast = _last(ast); // Continue loop } else if ((a0->type & MAL_SYMBOL) && @@ -192,7 +190,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { return mf; } else { //g_print("eval apply\n"); - MalVal *el = eval_ast(ast, env); + MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); if (!el || mal_error) { return NULL; } MalVal *f = _first(el), *args = _rest(el); @@ -243,12 +241,10 @@ void init_repl_env(int argc, char *argv[]) { // 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), + env_set(repl_env, core_ns[i].name, malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); } - env_set(repl_env, - malval_new_symbol("eval"), + env_set(repl_env, "eval", malval_new_function((void*(*)(void *))do_eval, 1)); MalVal *_argv = _listX(0); @@ -256,7 +252,7 @@ void init_repl_env(int argc, char *argv[]) { MalVal *arg = malval_new_string(argv[i]); g_array_append_val(_argv->val.array, arg); } - env_set(repl_env, malval_new_symbol("*ARGV*"), _argv); + env_set(repl_env, "*ARGV*", _argv); // core.mal: defined using the language itself RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); diff --git a/impls/c/step8_macros.c b/impls/c/step8_macros.c index ac5a3b0f02..2311b63be0 100644 --- a/impls/c/step8_macros.c +++ b/impls/c/step8_macros.c @@ -11,7 +11,6 @@ // Declarations MalVal *EVAL(MalVal *ast, Env *env); MalVal *quasiquote(MalVal *ast); -MalVal *macroexpand(MalVal *ast, Env *env); // read MalVal *READ(char prompt[], char *str) { @@ -69,31 +68,24 @@ MalVal *quasiquote(MalVal *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 *EVAL(MalVal *ast, Env *env) { + while (TRUE) { -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)); + + MalVal *dbgeval = env_get(env, "DEBUG-EVAL"); + if (dbgeval && !(dbgeval->type & (MAL_FALSE|MAL_NIL))) { + g_print("EVAL: %s\n", _pr_str(ast,1)); } - 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)) { + 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; @@ -118,25 +110,8 @@ MalVal *eval_ast(MalVal *ast, Env *env) { //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; @@ -148,7 +123,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { *a2 = _nth(ast, 2); MalVal *res = EVAL(a2, env); if (mal_error) return NULL; - env_set(env, a1, res); + env_set(env, a1->val.string, res); return res; } else if ((a0->type & MAL_SYMBOL) && strcmp("let*", a0->val.string) == 0) { @@ -165,7 +140,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { key = g_array_index(a1->val.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)); + env_set(let_env, key->val.string, EVAL(val, let_env)); } ast = a2; env = let_env; @@ -174,9 +149,6 @@ MalVal *EVAL(MalVal *ast, Env *env) { strcmp("quote", a0->val.string) == 0) { //g_print("eval apply quote\n"); return _nth(ast, 1); - } else if ((a0->type & MAL_SYMBOL) && - strcmp("quasiquoteexpand", a0->val.string) == 0) { - return quasiquote(_nth(ast, 1)); } else if ((a0->type & MAL_SYMBOL) && strcmp("quasiquote", a0->val.string) == 0) { //g_print("eval apply quasiquote\n"); @@ -188,20 +160,17 @@ MalVal *EVAL(MalVal *ast, Env *env) { //g_print("eval apply defmacro!\n"); MalVal *a1 = _nth(ast, 1), *a2 = _nth(ast, 2); - MalVal *res = EVAL(a2, env); + 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, res); + env_set(env, a1->val.string, 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); + _map2((MalVal *(*)(void*, void*))EVAL, _slice(ast, 1, _count(ast)-1), env); ast = _last(ast); // Continue loop } else if ((a0->type & MAL_SYMBOL) && @@ -234,10 +203,15 @@ MalVal *EVAL(MalVal *ast, 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); + 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) { @@ -285,12 +259,10 @@ void init_repl_env(int argc, char *argv[]) { // 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), + env_set(repl_env, core_ns[i].name, malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); } - env_set(repl_env, - malval_new_symbol("eval"), + env_set(repl_env, "eval", malval_new_function((void*(*)(void *))do_eval, 1)); MalVal *_argv = _listX(0); @@ -298,7 +270,7 @@ void init_repl_env(int argc, char *argv[]) { MalVal *arg = malval_new_string(argv[i]); g_array_append_val(_argv->val.array, arg); } - env_set(repl_env, malval_new_symbol("*ARGV*"), _argv); + env_set(repl_env, "*ARGV*", _argv); // core.mal: defined using the language itself RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); diff --git a/impls/c/step9_try.c b/impls/c/step9_try.c index 61ac91f784..9bdf356330 100644 --- a/impls/c/step9_try.c +++ b/impls/c/step9_try.c @@ -12,7 +12,6 @@ // Declarations MalVal *EVAL(MalVal *ast, Env *env); MalVal *quasiquote(MalVal *ast); -MalVal *macroexpand(MalVal *ast, Env *env); // read MalVal *READ(char prompt[], char *str) { @@ -70,31 +69,24 @@ MalVal *quasiquote(MalVal *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 *EVAL(MalVal *ast, Env *env) { + while (TRUE) { -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)); + + MalVal *dbgeval = env_get(env, "DEBUG-EVAL"); + if (dbgeval && !(dbgeval->type & (MAL_FALSE|MAL_NIL))) { + g_print("EVAL: %s\n", _pr_str(ast,1)); } - 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)) { + 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; @@ -119,25 +111,8 @@ MalVal *eval_ast(MalVal *ast, Env *env) { //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; @@ -149,7 +124,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { *a2 = _nth(ast, 2); MalVal *res = EVAL(a2, env); if (mal_error) return NULL; - env_set(env, a1, res); + env_set(env, a1->val.string, res); return res; } else if ((a0->type & MAL_SYMBOL) && strcmp("let*", a0->val.string) == 0) { @@ -166,7 +141,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { key = g_array_index(a1->val.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)); + env_set(let_env, key->val.string, EVAL(val, let_env)); } ast = a2; env = let_env; @@ -175,9 +150,6 @@ MalVal *EVAL(MalVal *ast, Env *env) { strcmp("quote", a0->val.string) == 0) { //g_print("eval apply quote\n"); return _nth(ast, 1); - } else if ((a0->type & MAL_SYMBOL) && - strcmp("quasiquoteexpand", a0->val.string) == 0) { - return quasiquote(_nth(ast, 1)); } else if ((a0->type & MAL_SYMBOL) && strcmp("quasiquote", a0->val.string) == 0) { //g_print("eval apply quasiquote\n"); @@ -189,16 +161,13 @@ MalVal *EVAL(MalVal *ast, Env *env) { //g_print("eval apply defmacro!\n"); MalVal *a1 = _nth(ast, 1), *a2 = _nth(ast, 2); - MalVal *res = EVAL(a2, env); + 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, res); + env_set(env, a1->val.string, 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"); @@ -226,7 +195,7 @@ MalVal *EVAL(MalVal *ast, Env *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); + _map2((MalVal *(*)(void*, void*))EVAL, _slice(ast, 1, _count(ast)-1), env); ast = _last(ast); // Continue loop } else if ((a0->type & MAL_SYMBOL) && @@ -259,10 +228,15 @@ MalVal *EVAL(MalVal *ast, 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); + 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) { @@ -310,12 +284,10 @@ void init_repl_env(int argc, char *argv[]) { // 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), + env_set(repl_env, core_ns[i].name, malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); } - env_set(repl_env, - malval_new_symbol("eval"), + env_set(repl_env, "eval", malval_new_function((void*(*)(void *))do_eval, 1)); MalVal *_argv = _listX(0); @@ -323,7 +295,7 @@ void init_repl_env(int argc, char *argv[]) { MalVal *arg = malval_new_string(argv[i]); g_array_append_val(_argv->val.array, arg); } - env_set(repl_env, malval_new_symbol("*ARGV*"), _argv); + env_set(repl_env, "*ARGV*", _argv); // core.mal: defined using the language itself RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); diff --git a/impls/c/stepA_mal.c b/impls/c/stepA_mal.c index 75051170f3..95862d2a5c 100644 --- a/impls/c/stepA_mal.c +++ b/impls/c/stepA_mal.c @@ -12,7 +12,6 @@ // Declarations MalVal *EVAL(MalVal *ast, Env *env); MalVal *quasiquote(MalVal *ast); -MalVal *macroexpand(MalVal *ast, Env *env); // read MalVal *READ(char prompt[], char *str) { @@ -70,31 +69,24 @@ MalVal *quasiquote(MalVal *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 *EVAL(MalVal *ast, Env *env) { + while (TRUE) { -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)); + + MalVal *dbgeval = env_get(env, "DEBUG-EVAL"); + if (dbgeval && !(dbgeval->type & (MAL_FALSE|MAL_NIL))) { + g_print("EVAL: %s\n", _pr_str(ast,1)); } - 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)) { + 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; @@ -119,25 +111,8 @@ MalVal *eval_ast(MalVal *ast, Env *env) { //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; @@ -149,7 +124,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { *a2 = _nth(ast, 2); MalVal *res = EVAL(a2, env); if (mal_error) return NULL; - env_set(env, a1, res); + env_set(env, a1->val.string, res); return res; } else if ((a0->type & MAL_SYMBOL) && strcmp("let*", a0->val.string) == 0) { @@ -166,7 +141,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { key = g_array_index(a1->val.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)); + env_set(let_env, key->val.string, EVAL(val, let_env)); } ast = a2; env = let_env; @@ -175,9 +150,6 @@ MalVal *EVAL(MalVal *ast, Env *env) { strcmp("quote", a0->val.string) == 0) { //g_print("eval apply quote\n"); return _nth(ast, 1); - } else if ((a0->type & MAL_SYMBOL) && - strcmp("quasiquoteexpand", a0->val.string) == 0) { - return quasiquote(_nth(ast, 1)); } else if ((a0->type & MAL_SYMBOL) && strcmp("quasiquote", a0->val.string) == 0) { //g_print("eval apply quasiquote\n"); @@ -189,20 +161,18 @@ MalVal *EVAL(MalVal *ast, Env *env) { //g_print("eval apply defmacro!\n"); MalVal *a1 = _nth(ast, 1), *a2 = _nth(ast, 2); - MalVal *res = EVAL(a2, env); + 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, res); + env_set(env, a1->val.string, 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); + 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) { @@ -231,7 +201,7 @@ MalVal *EVAL(MalVal *ast, Env *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); + _map2((MalVal *(*)(void*, void*))EVAL, _slice(ast, 1, _count(ast)-1), env); ast = _last(ast); // Continue loop } else if ((a0->type & MAL_SYMBOL) && @@ -264,10 +234,15 @@ MalVal *EVAL(MalVal *ast, 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); + 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) { @@ -315,12 +290,10 @@ void init_repl_env(int argc, char *argv[]) { // 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), + env_set(repl_env, core_ns[i].name, malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); } - env_set(repl_env, - malval_new_symbol("eval"), + env_set(repl_env, "eval", malval_new_function((void*(*)(void *))do_eval, 1)); MalVal *_argv = _listX(0); @@ -328,7 +301,7 @@ void init_repl_env(int argc, char *argv[]) { MalVal *arg = malval_new_string(argv[i]); g_array_append_val(_argv->val.array, arg); } - env_set(repl_env, malval_new_symbol("*ARGV*"), _argv); + env_set(repl_env, "*ARGV*", _argv); // core.mal: defined using the language itself RE(repl_env, "", "(def! *host-language* \"c\")"); diff --git a/impls/c/types.h b/impls/c/types.h index 7f327b8e7c..d4674c9ef9 100644 --- a/impls/c/types.h +++ b/impls/c/types.h @@ -35,9 +35,9 @@ typedef struct Env { } 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); +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 diff --git a/impls/clojure/src/mal/step2_eval.cljc b/impls/clojure/src/mal/step2_eval.cljc index 2727f0585c..fde4a12f96 100644 --- a/impls/clojure/src/mal/step2_eval.cljc +++ b/impls/clojure/src/mal/step2_eval.cljc @@ -10,36 +10,32 @@ (reader/read-string strng)) ;; eval -(declare EVAL) -(defn eval-ast [ast env] +(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")))) - (seq? ast) (doall (map #(EVAL % env) ast)) - - (vector? ast) (vec (doall (map #(EVAL % env) ast))) + (vector? ast) (vec (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) + (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 (eval-ast ast env) + (let [el (map #(EVAL % env) ast) f (first el) args (rest el)] - (apply f args))))) + (apply f args))) + + :else ;; not a list, map, symbol or vector + ast)) ;; print (defn PRINT [exp] (printer/pr-str exp)) diff --git a/impls/clojure/src/mal/step3_env.cljc b/impls/clojure/src/mal/step3_env.cljc index 6a2c8da5a3..f716cf6768 100644 --- a/impls/clojure/src/mal/step3_env.cljc +++ b/impls/clojure/src/mal/step3_env.cljc @@ -11,26 +11,24 @@ (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)) +(defn EVAL [ast env] - (vector? ast) (vec (doall (map #(EVAL % env) ast))) + (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))))) - (map? ast) (apply hash-map (doall (map #(EVAL % env) - (mapcat identity ast)))) + (cond + (symbol? ast) (env/env-get env ast) - :else ast)) + (vector? ast) (vec (map #(EVAL % env) ast)) -(defn EVAL [ast env] - ;; indented to match later steps - ;;(prn "EVAL" ast (keys @env)) (flush) - (if (not (seq? ast)) - (eval-ast ast env) + (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] @@ -48,10 +46,13 @@ (EVAL a2 let-env)) ;; apply - (let [el (eval-ast ast env) + (let [el (map #(EVAL % env) ast) f (first el) args (rest el)] - (apply f args)))))) + (apply f args)))) + + :else ;; not a list, map, symbol or vector + ast)) ;; print (defn PRINT [exp] (printer/pr-str exp)) diff --git a/impls/clojure/src/mal/step4_if_fn_do.cljc b/impls/clojure/src/mal/step4_if_fn_do.cljc index fe3e4c9b02..21fc8fa140 100644 --- a/impls/clojure/src/mal/step4_if_fn_do.cljc +++ b/impls/clojure/src/mal/step4_if_fn_do.cljc @@ -12,26 +12,24 @@ (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)) +(defn EVAL [ast env] - (vector? ast) (vec (doall (map #(EVAL % env) ast))) + (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))))) - (map? ast) (apply hash-map (doall (map #(EVAL % env) - (mapcat identity ast)))) + (cond + (symbol? ast) (env/env-get env ast) - :else ast)) + (vector? ast) (vec (map #(EVAL % env) ast)) -(defn EVAL [ast env] - ;; indented to match later steps - ;;(prn "EVAL" ast (keys @env)) (flush) - (if (not (seq? ast)) - (eval-ast ast env) + (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] @@ -49,7 +47,7 @@ (EVAL a2 let-env)) 'do - (last (eval-ast (rest ast) env)) + (last (doall (map #(EVAL % env) (rest ast)))) 'if (let [cond (EVAL a1 env)] @@ -64,10 +62,13 @@ (EVAL a2 (env/env env a1 (or args '())))) ;; apply - (let [el (eval-ast ast env) + (let [el (map #(EVAL % env) ast) f (first el) args (rest el)] - (apply f args)))))) + (apply f args)))) + + :else ;; not a list, map, symbol or vector + ast)) ;; print (defn PRINT [exp] (printer/pr-str exp)) diff --git a/impls/clojure/src/mal/step5_tco.cljc b/impls/clojure/src/mal/step5_tco.cljc index dc1209e1e6..0b836e8bb3 100644 --- a/impls/clojure/src/mal/step5_tco.cljc +++ b/impls/clojure/src/mal/step5_tco.cljc @@ -12,27 +12,26 @@ (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)) +(defn EVAL [ast env] + (loop [ast ast + env env] - (vector? ast) (vec (doall (map #(EVAL % env) ast))) + (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))))) - (map? ast) (apply hash-map (doall (map #(EVAL % env) - (mapcat identity ast)))) + (cond + (symbol? ast) (env/env-get env ast) - :else ast)) + (vector? ast) (vec (map #(EVAL % env) ast)) -(defn EVAL [ast env] - (loop [ast ast - env env] - ;;(prn "EVAL" ast (keys @env)) (flush) - (if (not (seq? ast)) - (eval-ast ast env) + (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] @@ -50,7 +49,7 @@ (recur a2 let-env)) 'do - (do (eval-ast (->> ast (drop-last) (drop 1)) env) + (do (doall (map #(EVAL % env) (->> ast (drop-last) (drop 1)))) (recur (last ast) env)) 'if @@ -70,13 +69,17 @@ :parameters a1}) ;; apply - (let [el (eval-ast ast env) + (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)))))))) + (apply f args))))) + + :else ;; not a list, map, symbol or vector + ast))) + ;; print (defn PRINT [exp] (printer/pr-str exp)) diff --git a/impls/clojure/src/mal/step6_file.cljc b/impls/clojure/src/mal/step6_file.cljc index d81a291a02..bbd581eb4b 100644 --- a/impls/clojure/src/mal/step6_file.cljc +++ b/impls/clojure/src/mal/step6_file.cljc @@ -12,27 +12,26 @@ (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)) +(defn EVAL [ast env] + (loop [ast ast + env env] - (vector? ast) (vec (doall (map #(EVAL % env) ast))) + (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))))) - (map? ast) (apply hash-map (doall (map #(EVAL % env) - (mapcat identity ast)))) + (cond + (symbol? ast) (env/env-get env ast) - :else ast)) + (vector? ast) (vec (map #(EVAL % env) ast)) -(defn EVAL [ast env] - (loop [ast ast - env env] - ;;(prn "EVAL" ast (keys @env)) (flush) - (if (not (seq? ast)) - (eval-ast ast env) + (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] @@ -50,7 +49,7 @@ (recur a2 let-env)) 'do - (do (eval-ast (->> ast (drop-last) (drop 1)) env) + (do (doall (map #(EVAL % env) (->> ast (drop-last) (drop 1)))) (recur (last ast) env)) 'if @@ -70,13 +69,17 @@ :parameters a1}) ;; apply - (let [el (eval-ast ast env) + (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)))))))) + (apply f args))))) + + :else ;; not a list, map, symbol or vector + ast))) + ;; print (defn PRINT [exp] (printer/pr-str exp)) diff --git a/impls/clojure/src/mal/step7_quote.cljc b/impls/clojure/src/mal/step7_quote.cljc index 5b2284158f..df510b65b2 100644 --- a/impls/clojure/src/mal/step7_quote.cljc +++ b/impls/clojure/src/mal/step7_quote.cljc @@ -12,8 +12,6 @@ (reader/read-string strng)) ;; eval -(declare EVAL) - (declare quasiquote) (defn starts_with [ast sym] (and (seq? ast) @@ -27,32 +25,32 @@ (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)) + (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 [ast env] - (cond - (symbol? ast) (env/env-get env ast) - - (seq? ast) (doall (map #(EVAL % env) ast)) +(defn EVAL [ast env] + (loop [ast ast + env env] - (vector? ast) (vec (doall (map #(EVAL % env) ast))) + (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))))) - (map? ast) (apply hash-map (doall (map #(EVAL % env) - (mapcat identity ast)))) + (cond + (symbol? ast) (env/env-get env ast) - :else ast)) + (vector? ast) (vec (map #(EVAL % env) ast)) -(defn EVAL [ast env] - (loop [ast ast - env env] - ;;(prn "EVAL" ast (keys @env)) (flush) - (if (not (seq? ast)) - (eval-ast ast env) + (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] @@ -72,14 +70,11 @@ 'quote a1 - 'quasiquoteexpand - (quasiquote a1) - 'quasiquote (recur (quasiquote a1) env) 'do - (do (eval-ast (->> ast (drop-last) (drop 1)) env) + (do (doall (map #(EVAL % env) (->> ast (drop-last) (drop 1)))) (recur (last ast) env)) 'if @@ -99,13 +94,17 @@ :parameters a1}) ;; apply - (let [el (eval-ast ast env) + (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)))))))) + (apply f args))))) + + :else ;; not a list, map, symbol or vector + ast))) + ;; print (defn PRINT [exp] (printer/pr-str exp)) diff --git a/impls/clojure/src/mal/step8_macros.cljc b/impls/clojure/src/mal/step8_macros.cljc index fea4a39519..7d09216ec4 100644 --- a/impls/clojure/src/mal/step8_macros.cljc +++ b/impls/clojure/src/mal/step8_macros.cljc @@ -1,5 +1,4 @@ (ns mal.step8-macros - (:refer-clojure :exclude [macroexpand]) (:require [mal.readline :as readline] #?(:clj [clojure.repl]) [mal.reader :as reader] @@ -13,8 +12,6 @@ (reader/read-string strng)) ;; eval -(declare EVAL) - (declare quasiquote) (defn starts_with [ast sym] (and (seq? ast) @@ -34,46 +31,28 @@ (or (symbol? ast) (map? ast)) (list 'quote ast) :else 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) - ;; Get original unadorned function because ClojureScript (1.10) - ;; limits functions with meta on them to arity 20 - (let [mac (:orig (meta (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)) +(defn EVAL [ast env] + (loop [ast ast + env env] - (vector? ast) (vec (doall (map #(EVAL % env) ast))) + (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))))) - (map? ast) (apply hash-map (doall (map #(EVAL % env) - (mapcat identity ast)))) + (cond + (symbol? ast) (env/env-get env ast) - :else ast)) + (vector? ast) (vec (map #(EVAL % env) ast)) -(defn EVAL [ast env] - (loop [ast ast - env env] - ;;(prn "EVAL" ast (keys @env)) (flush) - (if (not (seq? ast)) - (eval-ast ast env) + (map? ast) (apply hash-map (map #(EVAL % env) (mapcat identity ast))) + (seq? ast) ;; apply list - (let [ast (macroexpand ast env)] - (if (not (seq? ast)) - (eval-ast ast env) - + ;; indented to match later steps (let [[a0 a1 a2 a3] ast] (condp = a0 nil @@ -91,9 +70,6 @@ 'quote a1 - 'quasiquoteexpand - (quasiquote a1) - 'quasiquote (recur (quasiquote a1) env) @@ -105,11 +81,8 @@ :ismacro true})] (env/env-set env a1 mac)) - 'macroexpand - (macroexpand a1 env) - 'do - (do (eval-ast (->> ast (drop-last) (drop 1)) env) + (do (doall (map #(EVAL % env) (->> ast (drop-last) (drop 1)))) (recur (last ast) env)) 'if @@ -133,13 +106,19 @@ :parameters a1})) ;; apply - (let [el (eval-ast ast env) - f (first el) - args (rest el) + (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)))))))))) + (apply f args))))))) + + :else ;; not a list, map, symbol or vector + ast))) + ;; print (defn PRINT [exp] (printer/pr-str exp)) diff --git a/impls/clojure/src/mal/step9_try.cljc b/impls/clojure/src/mal/step9_try.cljc index 47a430c818..1915b427fb 100644 --- a/impls/clojure/src/mal/step9_try.cljc +++ b/impls/clojure/src/mal/step9_try.cljc @@ -1,5 +1,4 @@ (ns mal.step9-try - (:refer-clojure :exclude [macroexpand]) (:require [mal.readline :as readline] #?(:clj [clojure.repl]) [mal.reader :as reader] @@ -13,8 +12,6 @@ (reader/read-string strng)) ;; eval -(declare EVAL) - (declare quasiquote) (defn starts_with [ast sym] (and (seq? ast) @@ -34,46 +31,28 @@ (or (symbol? ast) (map? ast)) (list 'quote ast) :else 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) - ;; Get original unadorned function because ClojureScript (1.10) - ;; limits functions with meta on them to arity 20 - (let [mac (:orig (meta (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)) +(defn EVAL [ast env] + (loop [ast ast + env env] - (vector? ast) (vec (doall (map #(EVAL % env) ast))) + (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))))) - (map? ast) (apply hash-map (doall (map #(EVAL % env) - (mapcat identity ast)))) + (cond + (symbol? ast) (env/env-get env ast) - :else ast)) + (vector? ast) (vec (map #(EVAL % env) ast)) -(defn EVAL [ast env] - (loop [ast ast - env env] - ;;(prn "EVAL" ast (keys @env)) (flush) - (if (not (seq? ast)) - (eval-ast ast env) + (map? ast) (apply hash-map (map #(EVAL % env) (mapcat identity ast))) + (seq? ast) ;; apply list - (let [ast (macroexpand ast env)] - (if (not (seq? ast)) - (eval-ast ast env) - + ;; indented to match later steps (let [[a0 a1 a2 a3] ast] (condp = a0 nil @@ -91,9 +70,6 @@ 'quote a1 - 'quasiquoteexpand - (quasiquote a1) - 'quasiquote (recur (quasiquote a1) env) @@ -105,9 +81,6 @@ :ismacro true})] (env/env-set env a1 mac)) - 'macroexpand - (macroexpand a1 env) - 'try* (if (= 'catch* (nth a2 0)) (try @@ -126,7 +99,7 @@ (EVAL a1 env)) 'do - (do (eval-ast (->> ast (drop-last) (drop 1)) env) + (do (doall (map #(EVAL % env) (->> ast (drop-last) (drop 1)))) (recur (last ast) env)) 'if @@ -150,13 +123,19 @@ :parameters a1})) ;; apply - (let [el (eval-ast ast env) - f (first el) - args (rest el) + (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)))))))))) + (apply f args))))))) + + :else ;; not a list, map, symbol or vector + ast))) + ;; print (defn PRINT [exp] (printer/pr-str exp)) diff --git a/impls/clojure/src/mal/stepA_mal.cljc b/impls/clojure/src/mal/stepA_mal.cljc index d6203ef4e8..6d13886af3 100644 --- a/impls/clojure/src/mal/stepA_mal.cljc +++ b/impls/clojure/src/mal/stepA_mal.cljc @@ -1,5 +1,4 @@ (ns mal.stepA-mal - (:refer-clojure :exclude [macroexpand]) (:require [mal.readline :as readline] #?(:clj [clojure.repl]) [mal.reader :as reader] @@ -13,8 +12,6 @@ (reader/read-string strng)) ;; eval -(declare EVAL) - (declare quasiquote) (defn starts_with [ast sym] (and (seq? ast) @@ -34,46 +31,28 @@ (or (symbol? ast) (map? ast)) (list 'quote ast) :else 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) - ;; Get original unadorned function because ClojureScript (1.10) - ;; limits functions with meta on them to arity 20 - (let [mac (:orig (meta (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)) +(defn EVAL [ast env] + (loop [ast ast + env env] - (vector? ast) (vec (doall (map #(EVAL % env) ast))) + (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))))) - (map? ast) (apply hash-map (doall (map #(EVAL % env) - (mapcat identity ast)))) + (cond + (symbol? ast) (env/env-get env ast) - :else ast)) + (vector? ast) (vec (map #(EVAL % env) ast)) -(defn EVAL [ast env] - (loop [ast ast - env env] - ;;(prn "EVAL" ast (keys @env)) (flush) - (if (not (seq? ast)) - (eval-ast ast env) + (map? ast) (apply hash-map (map #(EVAL % env) (mapcat identity ast))) + (seq? ast) ;; apply list - (let [ast (macroexpand ast env)] - (if (not (seq? ast)) - (eval-ast ast env) - + ;; indented to match later steps (let [[a0 a1 a2 a3] ast] (condp = a0 nil @@ -91,9 +70,6 @@ 'quote a1 - 'quasiquoteexpand - (quasiquote a1) - 'quasiquote (recur (quasiquote a1) env) @@ -105,9 +81,6 @@ :ismacro true})] (env/env-set env a1 mac)) - 'macroexpand - (macroexpand a1 env) - 'clj* #?(:clj (eval (reader/read-string a1)) :cljs (throw (ex-info "clj* unsupported in ClojureScript mode" {}))) @@ -134,7 +107,7 @@ (EVAL a1 env)) 'do - (do (eval-ast (->> ast (drop-last) (drop 1)) env) + (do (doall (map #(EVAL % env) (->> ast (drop-last) (drop 1)))) (recur (last ast) env)) 'if @@ -158,13 +131,19 @@ :parameters a1})) ;; apply - (let [el (eval-ast ast env) - f (first el) - args (rest el) + (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)))))))))) + (apply f args))))))) + + :else ;; not a list, map, symbol or vector + ast))) + ;; print (defn PRINT [exp] (printer/pr-str exp)) diff --git a/impls/coffee/env.coffee b/impls/coffee/env.coffee index 097933a3ad..17af434c48 100644 --- a/impls/coffee/env.coffee +++ b/impls/coffee/env.coffee @@ -12,9 +12,7 @@ exports.Env = class Env 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 @ + if key of @data then @ else if @outer then @outer.find(key) else null set: (key, value) -> @@ -22,10 +20,8 @@ exports.Env = class Env 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] + throw new Error("'" + key + "' not found") if !env + env.data[key] # vim: ts=2:sw=2 diff --git a/impls/coffee/step2_eval.coffee b/impls/coffee/step2_eval.coffee index 56df8e1550..7cf6dfaebd 100644 --- a/impls/coffee/step2_eval.coffee +++ b/impls/coffee/step2_eval.coffee @@ -7,24 +7,24 @@ printer = require "./printer.coffee" 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)) +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) - 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(v, env) for k,v of ast - new_hm - else ast + return new_hm + else return 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...] = ast.map((a) -> EVAL(a, env)) f(args...) diff --git a/impls/coffee/step3_env.coffee b/impls/coffee/step3_env.coffee index c8a17f45db..5143da9c49 100644 --- a/impls/coffee/step3_env.coffee +++ b/impls/coffee/step3_env.coffee @@ -8,20 +8,23 @@ Env = require("./env.coffee").Env 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) -> + 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(v, env) for k,v of ast - new_hm - else ast + return new_hm + else return 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 @@ -35,7 +38,7 @@ EVAL = (ast, env) -> let_env.set(a1[i], EVAL(a1[i+1], let_env)) EVAL(a2, let_env) else - [f, args...] = eval_ast ast, env + [f, args...] = ast.map((a) -> EVAL(a, env)) f(args...) diff --git a/impls/coffee/step4_if_fn_do.coffee b/impls/coffee/step4_if_fn_do.coffee index 69c54cb8dc..e49f15ff35 100644 --- a/impls/coffee/step4_if_fn_do.coffee +++ b/impls/coffee/step4_if_fn_do.coffee @@ -9,20 +9,23 @@ 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) -> + 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(v, env) for k,v of ast - new_hm - else ast + return new_hm + else return 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 @@ -36,7 +39,7 @@ EVAL = (ast, env) -> let_env.set(a1[i], EVAL(a1[i+1], let_env)) EVAL(a2, let_env) when "do" - el = eval_ast(ast[1..], env) + el = ast[1..].map((a) -> EVAL(a, env)) el[el.length-1] when "if" cond = EVAL(a1, env) @@ -47,7 +50,7 @@ EVAL = (ast, env) -> when "fn*" (args...) -> EVAL(a2, new Env(env, a1, args)) else - [f, args...] = eval_ast ast, env + [f, args...] = ast.map((a) -> EVAL(a, env)) f(args...) diff --git a/impls/coffee/step5_tco.coffee b/impls/coffee/step5_tco.coffee index dececcf185..3c354fa7c6 100644 --- a/impls/coffee/step5_tco.coffee +++ b/impls/coffee/step5_tco.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(v, env) for k,v of ast - new_hm - else 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) diff --git a/impls/coffee/step6_file.coffee b/impls/coffee/step6_file.coffee index 23d764c4bb..87226b6268 100644 --- a/impls/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(v, env) for k,v of ast - new_hm - else 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) diff --git a/impls/coffee/step7_quote.coffee b/impls/coffee/step7_quote.coffee index 3cc8c2d788..352862b324 100644 --- a/impls/coffee/step7_quote.coffee +++ b/impls/coffee/step7_quote.coffee @@ -25,21 +25,24 @@ quasiquote = (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)) +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(v, env) for k,v of ast - new_hm - else 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 @@ -55,12 +58,10 @@ EVAL = (ast, env) -> env = let_env when "quote" return a1 - when "quasiquoteexpand" - return quasiquote(a1) when "quasiquote" ast = quasiquote(a1) 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) @@ -71,7 +72,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) diff --git a/impls/coffee/step8_macros.coffee b/impls/coffee/step8_macros.coffee index 20d914623a..986aea9444 100644 --- a/impls/coffee/step8_macros.coffee +++ b/impls/coffee/step8_macros.coffee @@ -23,36 +23,25 @@ quasiquote = (ast) -> else if types._symbol_Q(ast) || types._hash_map_Q(ast) then [types._symbol('quote'), ast] else ast -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)) +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(v, 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 + return new_hm + else return ast # 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 @@ -67,8 +56,6 @@ EVAL = (ast, env) -> env = let_env when "quote" return a1 - when "quasiquoteexpand" - return quasiquote(a1) when "quasiquote" ast = quasiquote(a1) when "defmacro!" @@ -76,10 +63,8 @@ EVAL = (ast, env) -> f = types._clone(f) f.__ismacro__ = true return env.set(a1, f) - when "macroexpand" - return macroexpand(a1, 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) @@ -90,7 +75,11 @@ EVAL = (ast, env) -> when "fn*" return types._function(EVAL, a2, env, a1) else - [f, args...] = eval_ast ast, env + 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) diff --git a/impls/coffee/step9_try.coffee b/impls/coffee/step9_try.coffee index e885bd9fda..6658d7c2af 100644 --- a/impls/coffee/step9_try.coffee +++ b/impls/coffee/step9_try.coffee @@ -23,36 +23,25 @@ quasiquote = (ast) -> else if types._symbol_Q(ast) || types._hash_map_Q(ast) then [types._symbol('quote'), ast] else ast -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)) +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(v, 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 + return new_hm + else return ast # 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 @@ -67,8 +56,6 @@ EVAL = (ast, env) -> env = let_env when "quote" return a1 - when "quasiquoteexpand" - return quasiquote(a1) when "quasiquote" ast = quasiquote(a1) when "defmacro!" @@ -76,8 +63,6 @@ EVAL = (ast, env) -> f = types._clone(f) f.__ismacro__ = true return env.set(a1, f) - when "macroexpand" - return macroexpand(a1, env) when "try*" try return EVAL(a1, env) catch exc @@ -88,7 +73,7 @@ EVAL = (ast, env) -> else throw exc 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) @@ -99,7 +84,11 @@ EVAL = (ast, env) -> when "fn*" return types._function(EVAL, a2, env, a1) else - [f, args...] = eval_ast ast, env + 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) diff --git a/impls/coffee/stepA_mal.coffee b/impls/coffee/stepA_mal.coffee index 504c81eaaf..4b030ed417 100644 --- a/impls/coffee/stepA_mal.coffee +++ b/impls/coffee/stepA_mal.coffee @@ -23,36 +23,25 @@ quasiquote = (ast) -> else if types._symbol_Q(ast) || types._hash_map_Q(ast) then [types._symbol('quote'), ast] else ast -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)) +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(v, 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 + return new_hm + else return ast # 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 @@ -67,8 +56,6 @@ EVAL = (ast, env) -> env = let_env when "quote" return a1 - when "quasiquoteexpand" - return quasiquote(a1) when "quasiquote" ast = quasiquote(a1) when "defmacro!" @@ -76,8 +63,6 @@ EVAL = (ast, env) -> f = types._clone(f) f.__ismacro__ = true return env.set(a1, f) - when "macroexpand" - return macroexpand(a1, env) when "try*" try return EVAL(a1, env) catch exc @@ -91,10 +76,10 @@ EVAL = (ast, env) -> res = eval(a1.toString()) return if typeof(res) == 'undefined' then null else res when "." - el = eval_ast(ast[2..], env) + el = ast[2..].map((a) -> EVAL(a, env)) return eval(a1.toString())(el...) 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) @@ -105,7 +90,11 @@ EVAL = (ast, env) -> when "fn*" return types._function(EVAL, a2, env, a1) else - [f, args...] = eval_ast ast, env + 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) diff --git a/impls/common-lisp/src/env.lisp b/impls/common-lisp/src/env.lisp index 771b72cf53..aea1c8b895 100644 --- a/impls/common-lisp/src/env.lisp +++ b/impls/common-lisp/src/env.lisp @@ -4,7 +4,6 @@ (:export :undefined-symbol :create-mal-env :get-env - :find-env :set-env :mal-env-bindings)) @@ -30,16 +29,12 @@ (bindings (make-hash-table :test 'equal) :read-only t) (parent nil :read-only t)) -(defun find-env (env symbol) - (when env - (or (gethash (mal-data-value symbol) - (mal-env-bindings env)) - (find-env (mal-env-parent env) symbol)))) - (defun get-env (env symbol) - (or (find-env env symbol) - (error 'undefined-symbol - :symbol (format nil "~a" (mal-data-value 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)) diff --git a/impls/common-lisp/src/step2_eval.lisp b/impls/common-lisp/src/step2_eval.lisp index 611d1dced9..b82ef6968e 100644 --- a/impls/common-lisp/src/step2_eval.lisp +++ b/impls/common-lisp/src/step2_eval.lisp @@ -17,37 +17,38 @@ (in-package :mal) -(defvar *repl-env* (make-mal-value-hash-table)) +(defvar *repl-env* (make-hash-table :test 'equal)) -(setf (genhash:hashref (make-mal-symbol "+") *repl-env*) +(setf (gethash "+" *repl-env*) (make-mal-builtin-fn (lambda (value1 value2) (make-mal-number (+ (mal-data-value value1) (mal-data-value value2)))))) -(setf (genhash:hashref (make-mal-symbol "-") *repl-env*) +(setf (gethash "-" *repl-env*) (make-mal-builtin-fn (lambda (value1 value2) (make-mal-number (- (mal-data-value value1) (mal-data-value value2)))))) -(setf (genhash:hashref (make-mal-symbol "*") *repl-env*) +(setf (gethash "*" *repl-env*) (make-mal-builtin-fn (lambda (value1 value2) (make-mal-number (* (mal-data-value value1) (mal-data-value value2)))))) -(setf (genhash:hashref (make-mal-symbol "/") *repl-env*) +(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 ((value (genhash:hashref symbol env))) - (if value + (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" (mal-data-value symbol)))))) + :symbol (format nil "~a" key)))))) -(defun eval-sequence (sequence env) - (map 'list +(defun eval-sequence (type sequence env) + (map type (lambda (ast) (mal-eval ast env)) (mal-data-value sequence))) @@ -60,25 +61,25 @@ hash-map-value) (make-mal-hash-map new-hash-table))) -(defun eval-ast (ast env) +(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-sequence ast env)) - (types:vector (make-mal-vector (apply 'vector (eval-sequence 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 mal-eval (ast env) - (cond - ((not (mal-list-p ast)) (eval-ast ast env)) - ((zerop (length (mal-data-value ast))) ast) - (t (progn - (let ((evaluated-list (eval-ast ast env))) +(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))))))) + (cdr evaluated-list))))) (defun mal-print (expression) (printer:pr-str expression)) diff --git a/impls/common-lisp/src/step3_env.lisp b/impls/common-lisp/src/step3_env.lisp index 069dc35331..17a7ccd991 100644 --- a/impls/common-lisp/src/step3_env.lisp +++ b/impls/common-lisp/src/step3_env.lisp @@ -47,8 +47,8 @@ (defvar mal-def! (make-mal-symbol "def!")) (defvar mal-let* (make-mal-symbol "let*")) -(defun eval-sequence (sequence env) - (map 'list +(defun eval-sequence (type sequence env) + (map type (lambda (ast) (mal-eval ast env)) (mal-data-value sequence))) @@ -61,11 +61,20 @@ hash-map-value) (make-mal-hash-map new-hash-table))) -(defun eval-ast (ast env) +(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 (env:get-env env ast)) - (types:list (eval-sequence ast env)) - (types:vector (make-mal-vector (apply 'vector (eval-sequence ast env)))) + (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))) @@ -89,24 +98,18 @@ (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-ast ast 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-eval (ast env) - (cond - ((null ast) mal-nil) - ((not (mal-list-p ast)) (eval-ast ast env)) - ((zerop (length (mal-data-value ast))) ast) - (t (eval-list ast env)))) - (defun mal-print (expression) (printer:pr-str expression)) diff --git a/impls/common-lisp/src/step4_if_fn_do.lisp b/impls/common-lisp/src/step4_if_fn_do.lisp index db3070da51..aa789bfec6 100644 --- a/impls/common-lisp/src/step4_if_fn_do.lisp +++ b/impls/common-lisp/src/step4_if_fn_do.lisp @@ -30,8 +30,8 @@ (defvar mal-if (make-mal-symbol "if")) (defvar mal-fn* (make-mal-symbol "fn*")) -(defun eval-sequence (sequence env) - (map 'list +(defun eval-sequence (type sequence env) + (map type (lambda (ast) (mal-eval ast env)) (mal-data-value sequence))) @@ -44,11 +44,20 @@ hash-map-value) (make-mal-hash-map new-hash-table))) -(defun eval-ast (ast env) +(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 (env:get-env env ast)) - (types:list (eval-sequence ast env)) - (types:vector (make-mal-vector (apply 'vector (eval-sequence ast env)))) + (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))) @@ -72,6 +81,7 @@ (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)) @@ -83,7 +93,7 @@ (let ((predicate (mal-eval (second forms) env))) (mal-eval (if (or (mal-data-value= predicate mal-nil) (mal-data-value= predicate mal-false)) - (fourth forms) + (or (fourth forms) mal-nil) (third forms)) env))) ((mal-data-value= mal-fn* (first forms)) @@ -93,7 +103,7 @@ (mal-eval body (env:create-mal-env :parent env :binds (listify (mal-data-value arglist)) :exprs args)))))) - (t (let* ((evaluated-list (eval-ast ast env)) + (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) @@ -102,13 +112,6 @@ (defun mal-read (string) (reader:read-str string)) -(defun mal-eval (ast env) - (cond - ((null ast) mal-nil) - ((not (mal-list-p ast)) (eval-ast ast env)) - ((zerop (length (mal-data-value ast))) ast) - (t (eval-list ast env)))) - (defun mal-print (expression) (printer:pr-str expression)) diff --git a/impls/common-lisp/src/step5_tco.lisp b/impls/common-lisp/src/step5_tco.lisp index 2a162f5700..e2a5305d9f 100644 --- a/impls/common-lisp/src/step5_tco.lisp +++ b/impls/common-lisp/src/step5_tco.lisp @@ -30,8 +30,8 @@ (defvar mal-if (make-mal-symbol "if")) (defvar mal-fn* (make-mal-symbol "fn*")) -(defun eval-sequence (sequence env) - (map 'list +(defun eval-sequence (type sequence env) + (map type (lambda (ast) (mal-eval ast env)) (mal-data-value sequence))) @@ -44,25 +44,31 @@ hash-map-value) (make-mal-hash-map new-hash-table))) -(defun eval-ast (ast env) - (switch-mal-type ast - (types:symbol (env:get-env env ast)) - (types:list (eval-sequence ast env)) - (types:vector (make-mal-vector (apply 'vector (eval-sequence ast env)))) - (types:hash-map (eval-hash-map ast env)) - (types:any ast))) - (defun mal-read (string) (reader:read-str string)) (defun mal-eval (ast env) (loop - do (cond - ((null ast) (return mal-nil)) - ((not (mal-list-p ast)) (return (eval-ast ast env))) - ((zerop (length (mal-data-value ast))) (return ast)) - (t (let ((forms (mal-data-value ast))) + 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)))) @@ -92,7 +98,7 @@ (let ((predicate (mal-eval (second forms) env))) (setf ast (if (or (mal-data-value= predicate mal-nil) (mal-data-value= predicate mal-false)) - (fourth forms) + (or (fourth forms) mal-nil) (third forms))))) ((mal-data-value= mal-fn* (first forms)) @@ -106,7 +112,7 @@ (cons :ast body) (cons :env env)))))) - (t (let* ((evaluated-list (eval-ast ast 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)) @@ -118,7 +124,8 @@ :binds (map 'list #'identity (mal-data-value (cdr (assoc :params attrs)))) - :exprs (cdr evaluated-list))))))))))))) + :exprs (cdr evaluated-list)))))))))) + (types:any (return ast))))) (defun mal-print (expression) (printer:pr-str expression)) diff --git a/impls/common-lisp/src/step6_file.lisp b/impls/common-lisp/src/step6_file.lisp index 0b299b92fe..e605ee35d2 100644 --- a/impls/common-lisp/src/step6_file.lisp +++ b/impls/common-lisp/src/step6_file.lisp @@ -30,8 +30,8 @@ (defvar mal-if (make-mal-symbol "if")) (defvar mal-fn* (make-mal-symbol "fn*")) -(defun eval-sequence (sequence env) - (map 'list +(defun eval-sequence (type sequence env) + (map type (lambda (ast) (mal-eval ast env)) (mal-data-value sequence))) @@ -44,25 +44,31 @@ hash-map-value) (make-mal-hash-map new-hash-table))) -(defun eval-ast (ast env) - (switch-mal-type ast - (types:symbol (env:get-env env ast)) - (types:list (eval-sequence ast env)) - (types:vector (make-mal-vector (apply 'vector (eval-sequence ast env)))) - (types:hash-map (eval-hash-map ast env)) - (types:any ast))) - (defun mal-read (string) (reader:read-str string)) (defun mal-eval (ast env) (loop - do (cond - ((null ast) (return mal-nil)) - ((not (mal-list-p ast)) (return (eval-ast ast env))) - ((zerop (length (mal-data-value ast))) (return ast)) - (t (let ((forms (mal-data-value ast))) + 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)))) @@ -92,7 +98,7 @@ (let ((predicate (mal-eval (second forms) env))) (setf ast (if (or (mal-data-value= predicate mal-nil) (mal-data-value= predicate mal-false)) - (fourth forms) + (or (fourth forms) mal-nil) (third forms))))) ((mal-data-value= mal-fn* (first forms)) @@ -106,7 +112,7 @@ (cons :ast body) (cons :env env)))))) - (t (let* ((evaluated-list (eval-ast ast 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)) @@ -118,7 +124,8 @@ :binds (map 'list #'identity (mal-data-value (cdr (assoc :params attrs)))) - :exprs (cdr evaluated-list))))))))))))) + :exprs (cdr evaluated-list)))))))))) + (types:any (return ast))))) (defun mal-print (expression) (printer:pr-str expression)) diff --git a/impls/common-lisp/src/step7_quote.lisp b/impls/common-lisp/src/step7_quote.lisp index 14b0167c5f..546488cfcd 100644 --- a/impls/common-lisp/src/step7_quote.lisp +++ b/impls/common-lisp/src/step7_quote.lisp @@ -31,15 +31,14 @@ (defvar mal-fn* (make-mal-symbol "fn*")) (defvar mal-quote (make-mal-symbol "quote")) (defvar mal-quasiquote (make-mal-symbol "quasiquote")) -(defvar mal-quasiquoteexpand (make-mal-symbol "quasiquoteexpand")) (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 (sequence env) - (map 'list +(defun eval-sequence (type sequence env) + (map type (lambda (ast) (mal-eval ast env)) (mal-data-value sequence))) @@ -52,14 +51,6 @@ hash-map-value) (make-mal-hash-map new-hash-table))) -(defun eval-ast (ast env) - (switch-mal-type ast - (types:symbol (env:get-env env ast)) - (types:list (eval-sequence ast env)) - (types:vector (make-mal-vector (apply 'vector (eval-sequence ast env)))) - (types:hash-map (eval-hash-map ast env)) - (types:any ast))) - (defun qq-reducer (elt acc) (make-mal-list (if (and (mal-list-p elt) @@ -84,18 +75,29 @@ (defun mal-eval (ast env) (loop - do (cond - ((null ast) (return mal-nil)) - ((not (mal-list-p ast)) (return (eval-ast ast env))) - ((zerop (length (mal-data-value ast))) (return ast)) - (t (let ((forms (mal-data-value ast))) + 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-quasiquoteexpand (first forms)) - (return (quasiquote (second forms)))) - ((mal-data-value= mal-quasiquote (first forms)) (setf ast (quasiquote (second forms)))) @@ -128,7 +130,7 @@ (let ((predicate (mal-eval (second forms) env))) (setf ast (if (or (mal-data-value= predicate mal-nil) (mal-data-value= predicate mal-false)) - (fourth forms) + (or (fourth forms) mal-nil) (third forms))))) ((mal-data-value= mal-fn* (first forms)) @@ -142,7 +144,7 @@ (cons :ast body) (cons :env env)))))) - (t (let* ((evaluated-list (eval-ast ast 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)) @@ -154,7 +156,8 @@ :binds (map 'list #'identity (mal-data-value (cdr (assoc :params attrs)))) - :exprs (cdr evaluated-list))))))))))))) + :exprs (cdr evaluated-list)))))))))) + (types:any (return ast))))) (defun mal-print (expression) (printer:pr-str expression)) diff --git a/impls/common-lisp/src/step8_macros.lisp b/impls/common-lisp/src/step8_macros.lisp index 3f5e5dd663..8f6745da3e 100644 --- a/impls/common-lisp/src/step8_macros.lisp +++ b/impls/common-lisp/src/step8_macros.lisp @@ -43,19 +43,12 @@ (defvar mal-fn* (make-mal-symbol "fn*")) (defvar mal-quote (make-mal-symbol "quote")) (defvar mal-quasiquote (make-mal-symbol "quasiquote")) -(defvar mal-quasiquoteexpand (make-mal-symbol "quasiquoteexpand")) (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-macroexpand (make-mal-symbol "macroexpand")) - -(defun eval-sequence (sequence env) - (map 'list - (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)) @@ -66,14 +59,6 @@ hash-map-value) (make-mal-hash-map new-hash-table))) -(defun eval-ast (ast env) - (switch-mal-type ast - (types:symbol (env:get-env env ast)) - (types:list (eval-sequence ast env)) - (types:vector (make-mal-vector (apply 'vector (eval-sequence ast env)))) - (types:hash-map (eval-hash-map ast env)) - (types:any ast))) - (defun qq-reducer (elt acc) (make-mal-list (if (and (mal-list-p elt) @@ -92,48 +77,39 @@ (types:symbol (make-mal-list (list mal-quote ast))) (types:any ast))) -(defun is-macro-call (ast env) - (when (mal-list-p ast) - (let* ((func-symbol (first (mal-data-value ast))) - (func (when (mal-symbol-p func-symbol) - (env:find-env env func-symbol)))) - (and func - (mal-fn-p func) - (cdr (assoc :is-macro (mal-data-attrs func))))))) - -(defun mal-macroexpand (ast env) - (loop - while (is-macro-call ast env) - do (let* ((forms (mal-data-value ast)) - (func (env:get-env env (first forms)))) - (setf ast (apply (mal-data-value func) - (cdr forms))))) - ast) - (defun mal-read (string) (reader:read-str string)) (defun mal-eval (ast env) (loop - do (setf ast (mal-macroexpand ast env)) - do (cond - ((null ast) (return mal-nil)) - ((not (mal-list-p ast)) (return (eval-ast ast env))) - ((zerop (length (mal-data-value ast))) (return ast)) - (t (let ((forms (mal-data-value ast))) + 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-quasiquoteexpand (first forms)) - (return (quasiquote (second forms)))) - ((mal-data-value= mal-quasiquote (first forms)) (setf ast (quasiquote (second forms)))) - ((mal-data-value= mal-macroexpand (first forms)) - (return (mal-macroexpand (second forms) env))) - ((mal-data-value= mal-def! (first forms)) (return (env:set-env env (second forms) (mal-eval (third forms) env)))) @@ -175,7 +151,7 @@ (let ((predicate (mal-eval (second forms) env))) (setf ast (if (or (mal-data-value= predicate mal-nil) (mal-data-value= predicate mal-false)) - (fourth forms) + (or (fourth forms) mal-nil) (third forms))))) ((mal-data-value= mal-fn* (first forms)) @@ -190,23 +166,26 @@ (cons :env env) (cons :is-macro nil)))))) - (t (let* ((evaluated-list (eval-ast ast env)) - (function (car evaluated-list))) + (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))) + (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 (cdr evaluated-list))))) + :exprs (map 'list (lambda (x) (mal-eval x env)) args)))))) ((mal-builtin-fn-p function) (return (apply (mal-data-value function) - (cdr evaluated-list)))) + (map 'list (lambda (x) (mal-eval x env)) args)))) (t (error 'invalid-function :form function - :context "apply"))))))))))) + :context "apply")))))))) + (types:any (return ast))))) (defun mal-print (expression) (printer:pr-str expression)) diff --git a/impls/common-lisp/src/step9_try.lisp b/impls/common-lisp/src/step9_try.lisp index a696115196..e0e667a024 100644 --- a/impls/common-lisp/src/step9_try.lisp +++ b/impls/common-lisp/src/step9_try.lisp @@ -43,23 +43,16 @@ (defvar mal-fn* (make-mal-symbol "fn*")) (defvar mal-quote (make-mal-symbol "quote")) (defvar mal-quasiquote (make-mal-symbol "quasiquote")) -(defvar mal-quasiquoteexpand (make-mal-symbol "quasiquoteexpand")) (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-macroexpand (make-mal-symbol "macroexpand")) (defvar mal-try* (make-mal-symbol "try*")) (defvar mal-catch* (make-mal-symbol "catch*")) (defvar mal-throw (make-mal-symbol "throw")) -(defun eval-sequence (sequence env) - (map 'list - (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))) @@ -69,14 +62,6 @@ hash-map-value) (make-mal-hash-map new-hash-table))) -(defun eval-ast (ast env) - (switch-mal-type ast - (types:symbol (env:get-env env ast)) - (types:list (eval-sequence ast env)) - (types:vector (make-mal-vector (apply 'vector (eval-sequence ast env)))) - (types:hash-map (eval-hash-map ast env)) - (types:any ast))) - (defun qq-reducer (elt acc) (make-mal-list (if (and (mal-list-p elt) @@ -95,48 +80,39 @@ (types:symbol (make-mal-list (list mal-quote ast))) (types:any ast))) -(defun is-macro-call (ast env) - (when (mal-list-p ast) - (let* ((func-symbol (first (mal-data-value ast))) - (func (when (mal-symbol-p func-symbol) - (env:find-env env func-symbol)))) - (and func - (mal-fn-p func) - (cdr (assoc :is-macro (mal-data-attrs func))))))) - -(defun mal-macroexpand (ast env) - (loop - while (is-macro-call ast env) - do (let* ((forms (mal-data-value ast)) - (func (env:get-env env (first forms)))) - (setf ast (apply (mal-data-value func) - (cdr forms))))) - ast) - (defun mal-read (string) (reader:read-str string)) (defun mal-eval (ast env) (loop - do (setf ast (mal-macroexpand ast env)) - do (cond - ((null ast) (return mal-nil)) - ((not (mal-list-p ast)) (return (eval-ast ast env))) - ((zerop (length (mal-data-value ast))) (return ast)) - (t (let ((forms (mal-data-value ast))) + 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-quasiquoteexpand (first forms)) - (return (quasiquote (second forms)))) - ((mal-data-value= mal-quasiquote (first forms)) (setf ast (quasiquote (second forms)))) - ((mal-data-value= mal-macroexpand (first forms)) - (return (mal-macroexpand (second forms) env))) - ((mal-data-value= mal-def! (first forms)) (return (env:set-env env (second forms) (mal-eval (third forms) env)))) @@ -178,7 +154,7 @@ (let ((predicate (mal-eval (second forms) env))) (setf ast (if (or (mal-data-value= predicate mal-nil) (mal-data-value= predicate mal-false)) - (fourth forms) + (or (fourth forms) mal-nil) (third forms))))) ((mal-data-value= mal-fn* (first forms)) @@ -209,23 +185,26 @@ (mal-exception-data condition) (make-mal-string (format nil "~a" condition))))))))))))) - (t (let* ((evaluated-list (eval-ast ast env)) - (function (car evaluated-list))) + (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))) + (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 (cdr evaluated-list))))) + :exprs (map 'list (lambda (x) (mal-eval x env)) args)))))) ((mal-builtin-fn-p function) (return (apply (mal-data-value function) - (cdr evaluated-list)))) + (map 'list (lambda (x) (mal-eval x env)) args)))) (t (error 'invalid-function :form function - :context "apply"))))))))))) + :context "apply")))))))) + (types:any (return ast))))) (defun mal-print (expression) (printer:pr-str expression)) diff --git a/impls/common-lisp/src/stepA_mal.lisp b/impls/common-lisp/src/stepA_mal.lisp index 6e360faa3e..38428694c6 100644 --- a/impls/common-lisp/src/stepA_mal.lisp +++ b/impls/common-lisp/src/stepA_mal.lisp @@ -42,23 +42,16 @@ (defvar mal-fn* (make-mal-symbol "fn*")) (defvar mal-quote (make-mal-symbol "quote")) (defvar mal-quasiquote (make-mal-symbol "quasiquote")) -(defvar mal-quasiquoteexpand (make-mal-symbol "quasiquoteexpand")) (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-macroexpand (make-mal-symbol "macroexpand")) (defvar mal-try* (make-mal-symbol "try*")) (defvar mal-catch* (make-mal-symbol "catch*")) (defvar mal-throw (make-mal-symbol "throw")) -(defun eval-sequence (sequence env) - (map 'list - (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))) @@ -68,14 +61,6 @@ hash-map-value) (make-mal-hash-map new-hash-table))) -(defun eval-ast (ast env) - (switch-mal-type ast - (types:symbol (env:get-env env ast)) - (types:list (eval-sequence ast env)) - (types:vector (make-mal-vector (apply 'vector (eval-sequence ast env)))) - (types:hash-map (eval-hash-map ast env)) - (types:any ast))) - (defun qq-reducer (elt acc) (make-mal-list (if (and (mal-list-p elt) @@ -94,48 +79,39 @@ (types:symbol (make-mal-list (list mal-quote ast))) (types:any ast))) -(defun is-macro-call (ast env) - (when (mal-list-p ast) - (let* ((func-symbol (first (mal-data-value ast))) - (func (when (mal-symbol-p func-symbol) - (env:find-env env func-symbol)))) - (and func - (mal-fn-p func) - (cdr (assoc :is-macro (mal-data-attrs func))))))) - -(defun mal-macroexpand (ast env) - (loop - while (is-macro-call ast env) - do (let* ((forms (mal-data-value ast)) - (func (env:get-env env (first forms)))) - (setf ast (apply (mal-data-value func) - (cdr forms))))) - ast) - (defun mal-read (string) (reader:read-str string)) (defun mal-eval (ast env) (loop - do (setf ast (mal-macroexpand ast env)) - do (cond - ((null ast) (return mal-nil)) - ((not (mal-list-p ast)) (return (eval-ast ast env))) - ((zerop (length (mal-data-value ast))) (return ast)) - (t (let ((forms (mal-data-value ast))) + 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-quasiquoteexpand (first forms)) - (return (quasiquote (second forms)))) - ((mal-data-value= mal-quasiquote (first forms)) (setf ast (quasiquote (second forms)))) - ((mal-data-value= mal-macroexpand (first forms)) - (return (mal-macroexpand (second forms) env))) - ((mal-data-value= mal-def! (first forms)) (return (env:set-env env (second forms) (mal-eval (third forms) env)))) @@ -177,7 +153,7 @@ (let ((predicate (mal-eval (second forms) env))) (setf ast (if (or (mal-data-value= predicate mal-nil) (mal-data-value= predicate mal-false)) - (fourth forms) + (or (fourth forms) mal-nil) (third forms))))) ((mal-data-value= mal-fn* (first forms)) @@ -206,25 +182,28 @@ :binds (list (second catch-forms)) :exprs (list (if (typep condition 'mal-user-exception) (mal-exception-data condition) - (make-mal-string (format nil "~a" condition))))))))))))) + (make-mal-string (format nil "~a" condition))))))))))))) - (t (let* ((evaluated-list (eval-ast ast env)) - (function (car evaluated-list))) + (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))) + (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 (cdr evaluated-list))))) + :exprs (map 'list (lambda (x) (mal-eval x env)) args)))))) ((mal-builtin-fn-p function) (return (apply (mal-data-value function) - (cdr evaluated-list)))) + (map 'list (lambda (x) (mal-eval x env)) args)))) (t (error 'invalid-function :form function - :context "apply"))))))))))) + :context "apply")))))))) + (types:any (return ast))))) (defun mal-print (expression) (printer:pr-str expression)) diff --git a/impls/cpp/step2_eval.cpp b/impls/cpp/step2_eval.cpp index dcd9461174..9b64f5ea5c 100644 --- a/impls/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/impls/cpp/step3_env.cpp b/impls/cpp/step3_env.cpp index 26b2bc4b85..fe76214a71 100644 --- a/impls/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/impls/cpp/step4_if_fn_do.cpp b/impls/cpp/step4_if_fn_do.cpp index 2369cb3a40..cef3c4ed99 100644 --- a/impls/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); diff --git a/impls/cpp/step5_tco.cpp b/impls/cpp/step5_tco.cpp index 3aa9d4a866..0766d53f02 100644 --- a/impls/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); diff --git a/impls/cpp/step6_file.cpp b/impls/cpp/step6_file.cpp index ad16f6db9e..e0c15e6109 100644 --- a/impls/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); diff --git a/impls/cpp/step7_quote.cpp b/impls/cpp/step7_quote.cpp index 337353dd13..1ced69952a 100644 --- a/impls/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); @@ -146,11 +152,6 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr env) continue; // TCO } - if (special == "quasiquoteexpand") { - checkArgsIs("quasiquote", 1, argCount); - return quasiquote(list->item(1)); - } - if (special == "quasiquote") { checkArgsIs("quasiquote", 1, argCount); ast = quasiquote(list->item(1)); diff --git a/impls/cpp/step8_macros.cpp b/impls/cpp/step8_macros.cpp index a425fdd2a8..b8897adbd1 100644 --- a/impls/cpp/step8_macros.cpp +++ b/impls/cpp/step8_macros.cpp @@ -15,7 +15,6 @@ 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 ReadLine s_readLine("~/.mal-history"); @@ -79,13 +78,13 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr 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); + 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); } @@ -163,16 +162,6 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr env) continue; // TCO } - if (special == "macroexpand") { - checkArgsIs("macroexpand", 1, argCount); - return macroExpand(list->item(1), env); - } - - if (special == "quasiquoteexpand") { - checkArgsIs("quasiquote", 1, argCount); - return quasiquote(list->item(1)); - } - if (special == "quasiquote") { checkArgsIs("quasiquote", 1, argCount); ast = quasiquote(list->item(1)); @@ -186,15 +175,20 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr env) } // 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); + 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()+1, items->end()); + env = lambda->makeEnv(items->begin(), items->end()); continue; // TCO } else { - return APPLY(op, items->begin()+1, items->end()); + malValueVec* items = STATIC_CAST(malList, list->rest())->evalItems(env); + return APPLY(op, items->begin(), items->end()); } } } @@ -256,31 +250,6 @@ static malValuePtr quasiquote(malValuePtr obj) return res; } -static const malLambda* isMacroApplication(malValuePtr obj, malEnvPtr env) -{ - const malList* seq = DYNAMIC_CAST(malList, obj); - if (seq && !seq->isEmpty()) { - if (malSymbol* sym = DYNAMIC_CAST(malSymbol, seq->item(0))) { - 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* 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)))", diff --git a/impls/cpp/step9_try.cpp b/impls/cpp/step9_try.cpp index 5b38a8469a..f107ee6910 100644 --- a/impls/cpp/step9_try.cpp +++ b/impls/cpp/step9_try.cpp @@ -15,7 +15,6 @@ 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 ReadLine s_readLine("~/.mal-history"); @@ -82,13 +81,13 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr 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); + 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); } @@ -166,16 +165,6 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr env) continue; // TCO } - if (special == "macroexpand") { - checkArgsIs("macroexpand", 1, argCount); - return macroExpand(list->item(1), env); - } - - if (special == "quasiquoteexpand") { - checkArgsIs("quasiquote", 1, argCount); - return quasiquote(list->item(1)); - } - if (special == "quasiquote") { checkArgsIs("quasiquote", 1, argCount); ast = quasiquote(list->item(1)); @@ -235,15 +224,20 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr env) } // 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); + 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()+1, items->end()); + env = lambda->makeEnv(items->begin(), items->end()); continue; // TCO } else { - return APPLY(op, items->begin()+1, items->end()); + malValueVec* items = STATIC_CAST(malList, list->rest())->evalItems(env); + return APPLY(op, items->begin(), items->end()); } } } @@ -305,31 +299,6 @@ static malValuePtr quasiquote(malValuePtr obj) return res; } -static const malLambda* isMacroApplication(malValuePtr obj, malEnvPtr env) -{ - const malList* seq = DYNAMIC_CAST(malList, obj); - if (seq && !seq->isEmpty()) { - if (malSymbol* sym = DYNAMIC_CAST(malSymbol, seq->item(0))) { - 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* 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)))", diff --git a/impls/cpp/stepA_mal.cpp b/impls/cpp/stepA_mal.cpp index 34c940ba81..143a9bec6c 100644 --- a/impls/cpp/stepA_mal.cpp +++ b/impls/cpp/stepA_mal.cpp @@ -15,7 +15,6 @@ 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 ReadLine s_readLine("~/.mal-history"); @@ -83,13 +82,13 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr 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); + 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); } @@ -167,16 +166,6 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr env) continue; // TCO } - if (special == "macroexpand") { - checkArgsIs("macroexpand", 1, argCount); - return macroExpand(list->item(1), env); - } - - if (special == "quasiquoteexpand") { - checkArgsIs("quasiquote", 1, argCount); - return quasiquote(list->item(1)); - } - if (special == "quasiquote") { checkArgsIs("quasiquote", 1, argCount); ast = quasiquote(list->item(1)); @@ -236,15 +225,20 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr env) } // 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); + 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()+1, items->end()); + env = lambda->makeEnv(items->begin(), items->end()); continue; // TCO } else { - return APPLY(op, items->begin()+1, items->end()); + malValueVec* items = STATIC_CAST(malList, list->rest())->evalItems(env); + return APPLY(op, items->begin(), items->end()); } } } @@ -306,31 +300,6 @@ static malValuePtr quasiquote(malValuePtr obj) return res; } -static const malLambda* isMacroApplication(malValuePtr obj, malEnvPtr env) -{ - const malList* seq = DYNAMIC_CAST(malList, obj); - if (seq && !seq->isEmpty()) { - if (malSymbol* sym = DYNAMIC_CAST(malSymbol, seq->item(0))) { - 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* 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)))", diff --git a/impls/cs/env.cs b/impls/cs/env.cs index 39ab100e0f..c4ef84fa8b 100644 --- a/impls/cs/env.cs +++ b/impls/cs/env.cs @@ -26,26 +26,16 @@ public Env(Env outer, MalList binds, MalList exprs) { } } - public Env find(MalSymbol key) { - if (data.ContainsKey(key.getName())) { - return this; + public MalVal get(string key) { + if (data.ContainsKey(key)) { + return data[key]; } else if (outer != null) { - return outer.find(key); + return outer.get(key); } else { return null; } } - public MalVal get(MalSymbol key) { - Env e = find(key); - if (e == null) { - throw new Mal.types.MalException( - "'" + key.getName() + "' not found"); - } else { - return e.data[key.getName()]; - } - } - public Env set(MalSymbol key, MalVal value) { data[key.getName()] = value; return this; diff --git a/impls/cs/step2_eval.cs b/impls/cs/step2_eval.cs index 8c68336482..415ac7be50 100644 --- a/impls/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/impls/cs/step3_env.cs b/impls/cs/step3_env.cs index 6c4f2fe193..f6a7f11626 100644 --- a/impls/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 index aefe22652a..285509baa5 100644 --- a/impls/cs/step4_if_fn_do.cs +++ b/impls/cs/step4_if_fn_do.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, a3, 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]; @@ -79,16 +78,17 @@ static MalVal EVAL(MalVal orig_ast, Env env) { } return EVAL(a2, let_env); case "do": - el = (MalList)eval_ast(ast.rest(), env); - return el[el.size()-1]; + 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) { - a3 = ast[3]; - return EVAL(a3, env); + return EVAL(ast[3], env); } else { return Mal.types.Nil; } @@ -104,9 +104,12 @@ static MalVal EVAL(MalVal orig_ast, 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()); + 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/step5_tco.cs b/impls/cs/step5_tco.cs index 55d414aaa8..2350e6f375 100644 --- a/impls/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/impls/cs/step6_file.cs b/impls/cs/step6_file.cs index 2569b0f4f2..f7f741c809 100644 --- a/impls/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; } diff --git a/impls/cs/step7_quote.cs b/impls/cs/step7_quote.cs index 6ed7b23399..4e1c46d9fb 100644 --- a/impls/cs/step7_quote.cs +++ b/impls/cs/step7_quote.cs @@ -59,42 +59,39 @@ public static MalVal quasiquote(MalVal 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(); + 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]; @@ -124,13 +121,13 @@ static MalVal EVAL(MalVal orig_ast, Env env) { break; case "quote": return ast[1]; - case "quasiquoteexpand": - return quasiquote(ast[1]); case "quasiquote": orig_ast = quasiquote(ast[1]); 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": @@ -155,14 +152,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/impls/cs/step8_macros.cs b/impls/cs/step8_macros.cs index 30e040be25..a9650e1c2c 100644 --- a/impls/cs/step8_macros.cs +++ b/impls/cs/step8_macros.cs @@ -59,70 +59,38 @@ public static MalVal quasiquote(MalVal ast) { } } - 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(); + 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 - MalVal expanded = macroexpand(orig_ast, env); - if (!expanded.list_Q()) { - return eval_ast(expanded, env); - } - MalList ast = (MalList) expanded; + MalList ast = (MalList) orig_ast; if (ast.size() == 0) { return ast; } a0 = ast[0]; @@ -153,8 +121,6 @@ static MalVal EVAL(MalVal orig_ast, Env env) { break; case "quote": return ast[1]; - case "quasiquoteexpand": - return quasiquote(ast[1]); case "quasiquote": orig_ast = quasiquote(ast[1]); break; @@ -166,11 +132,10 @@ static MalVal EVAL(MalVal orig_ast, Env 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); + foreach (MalVal mv in ast.slice(1, ast.size()-1).getValue()) { + EVAL(mv, env); + } orig_ast = ast[ast.size()-1]; break; case "if": @@ -195,14 +160,21 @@ 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); + 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(el.rest()); + env = f.genEnv(arguments); } else { - return f.apply(el.rest()); + return f.apply(arguments); } break; } diff --git a/impls/cs/step9_try.cs b/impls/cs/step9_try.cs index 31dab06cb7..6fd01817c9 100644 --- a/impls/cs/step9_try.cs +++ b/impls/cs/step9_try.cs @@ -59,70 +59,38 @@ public static MalVal quasiquote(MalVal ast) { } } - 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(); + 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 - MalVal expanded = macroexpand(orig_ast, env); - if (!expanded.list_Q()) { - return eval_ast(expanded, env); - } - MalList ast = (MalList) expanded; + MalList ast = (MalList) orig_ast; if (ast.size() == 0) { return ast; } a0 = ast[0]; @@ -153,8 +121,6 @@ static MalVal EVAL(MalVal orig_ast, Env env) { break; case "quote": return ast[1]; - case "quasiquoteexpand": - return quasiquote(ast[1]); case "quasiquote": orig_ast = quasiquote(ast[1]); break; @@ -166,9 +132,6 @@ static MalVal EVAL(MalVal orig_ast, Env 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); @@ -191,7 +154,9 @@ static MalVal EVAL(MalVal orig_ast, Env env) { throw e; } 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": @@ -216,14 +181,21 @@ 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); + 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(el.rest()); + env = f.genEnv(arguments); } else { - return f.apply(el.rest()); + return f.apply(arguments); } break; } diff --git a/impls/cs/stepA_mal.cs b/impls/cs/stepA_mal.cs index cdc1490187..76a7504417 100644 --- a/impls/cs/stepA_mal.cs +++ b/impls/cs/stepA_mal.cs @@ -59,70 +59,38 @@ public static MalVal quasiquote(MalVal ast) { } } - 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(); + 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 - MalVal expanded = macroexpand(orig_ast, env); - if (!expanded.list_Q()) { - return eval_ast(expanded, env); - } - MalList ast = (MalList) expanded; + MalList ast = (MalList) orig_ast; if (ast.size() == 0) { return ast; } a0 = ast[0]; @@ -153,8 +121,6 @@ static MalVal EVAL(MalVal orig_ast, Env env) { break; case "quote": return ast[1]; - case "quasiquoteexpand": - return quasiquote(ast[1]); case "quasiquote": orig_ast = quasiquote(ast[1]); break; @@ -166,9 +132,6 @@ static MalVal EVAL(MalVal orig_ast, Env 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); @@ -191,7 +154,9 @@ static MalVal EVAL(MalVal orig_ast, Env env) { throw e; } 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": @@ -216,14 +181,21 @@ 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); + 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(el.rest()); + env = f.genEnv(arguments); } else { - return f.apply(el.rest()); + return f.apply(arguments); } break; } diff --git a/impls/d/env.d b/impls/d/env.d index 200a864bf5..b7faa8cc3a 100644 --- a/impls/d/env.d +++ b/impls/d/env.d @@ -2,7 +2,7 @@ import types; class Env { Env outer; - MalType[MalSymbol] data; + MalType[string] data; this(Env outer_v, MalType[] binds = [], MalType[] exprs = []) { @@ -14,40 +14,31 @@ class Env { { auto rest_arg_name = verify_cast!MalSymbol(binds[i + 1]); auto rest_exprs = new MalList(exprs[i..$]); - set(rest_arg_name, rest_exprs); + set(rest_arg_name.name, rest_exprs); break; } else { - set(arg_name, exprs[i]); + set(arg_name.name, exprs[i]); } } } - MalType set(MalSymbol key, MalType val) + MalType set(string key, MalType val) { data[key] = val; return val; } - Env find(MalSymbol key) + MalType get(string key) { auto val = (key in data); if (val !is null) { - return this; + return data[key]; } else if (outer is null) { return null; } else { - return outer.find(key); + return outer.get(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/impls/d/step2_eval.d b/impls/d/step2_eval.d index aec2a100cc..eb80ce16cd 100644 --- a/impls/d/step2_eval.d +++ b/impls/d/step2_eval.d @@ -14,19 +14,18 @@ MalType READ(string str) return read_str(str); } -MalType eval_ast(MalType ast, Env env) +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(MalList)ast) - { - auto el = array(lst.elements.map!(e => EVAL(e, env))); - return new MalList(el); - } else if (auto lst = cast(MalVector)ast) { auto el = array(lst.elements.map!(e => EVAL(e, env))); @@ -41,27 +40,21 @@ MalType eval_ast(MalType ast, Env 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) + // todo: indent right + else if (auto ast_list = cast(MalList)ast) + { + if (ast_list.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..$]; + 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) diff --git a/impls/d/step3_env.d b/impls/d/step3_env.d index e733379ca4..722a5dbc82 100644 --- a/impls/d/step3_env.d +++ b/impls/d/step3_env.d @@ -16,16 +16,18 @@ MalType READ(string str) return read_str(str); } -MalType eval_ast(MalType ast, Env env) +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) { - return env.get(sym); - } - else if (auto lst = cast(MalList)ast) - { - auto el = array(lst.elements.map!(e => EVAL(e, env))); - return new MalList(el); + if (auto val = env.get(sym.name)) + return val; + else + throw new Exception("'" ~ sym.name ~ "' not found"); } else if (auto lst = cast(MalVector)ast) { @@ -41,19 +43,9 @@ MalType eval_ast(MalType ast, Env 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); - } + // todo: indent right + else if (auto ast_list = cast(MalList)ast) + { if (ast_list.elements.length == 0) { return ast; @@ -64,7 +56,7 @@ MalType EVAL(MalType ast, Env env) { case "def!": auto a1 = verify_cast!MalSymbol(ast_list.elements[1]); - return env.set(a1, EVAL(ast_list.elements[2], env)); + return env.set(a1.name, EVAL(ast_list.elements[2], env)); case "let*": auto a1 = verify_cast!MalSequential(ast_list.elements[1]); @@ -73,16 +65,20 @@ MalType EVAL(MalType ast, Env env) { 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)); + let_env.set(var_name.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..$]; + 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) @@ -130,10 +126,10 @@ static MalType mal_div(MalType[] a ...) 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, "/")); + 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 (;;) { diff --git a/impls/d/step4_if_fn_do.d b/impls/d/step4_if_fn_do.d index aac2d1e874..255f71578a 100644 --- a/impls/d/step4_if_fn_do.d +++ b/impls/d/step4_if_fn_do.d @@ -17,16 +17,18 @@ MalType READ(string str) return read_str(str); } -MalType eval_ast(MalType ast, Env env) +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) { - return env.get(sym); - } - else if (auto lst = cast(MalList)ast) - { - auto el = array(lst.elements.map!(e => EVAL(e, env))); - return new MalList(el); + if (auto val = env.get(sym.name)) + return val; + else + throw new Exception("'" ~ sym.name ~ "' not found"); } else if (auto lst = cast(MalVector)ast) { @@ -42,20 +44,9 @@ MalType eval_ast(MalType ast, Env 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); - } - + // todo: indent right + else if (auto ast_list = cast(MalList)ast) + { auto aste = ast_list.elements; if (aste.length == 0) { @@ -67,7 +58,7 @@ MalType EVAL(MalType ast, Env env) { case "def!": auto a1 = verify_cast!MalSymbol(aste[1]); - return env.set(a1, EVAL(aste[2], env)); + return env.set(a1.name, EVAL(aste[2], env)); case "let*": auto a1 = verify_cast!MalSequential(aste[1]); @@ -76,14 +67,15 @@ MalType EVAL(MalType ast, Env env) { 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)); + let_env.set(var_name.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]; + foreach (elt; aste[1..$-1]) { + EVAL(elt, env); + } + return EVAL(aste[$-1], env); case "if": auto cond = EVAL(aste[1], env); @@ -100,13 +92,8 @@ MalType EVAL(MalType ast, Env env) 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..$]; + 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); @@ -121,6 +108,11 @@ MalType EVAL(MalType ast, Env env) throw new Exception("Expected a function"); } } + } + else + { + return ast; + } } string PRINT(MalType ast) @@ -143,7 +135,7 @@ 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)); + repl_env.set(sym_name, new MalBuiltinFunc(f, sym_name)); } // core.mal: defined using the language itself diff --git a/impls/d/step5_tco.d b/impls/d/step5_tco.d index 120d95139a..315f73d0dd 100644 --- a/impls/d/step5_tco.d +++ b/impls/d/step5_tco.d @@ -17,16 +17,20 @@ MalType READ(string str) return read_str(str); } -MalType eval_ast(MalType ast, Env env) +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) { - return env.get(sym); - } - else if (auto lst = cast(MalList)ast) - { - auto el = array(lst.elements.map!(e => EVAL(e, env))); - return new MalList(el); + if (auto val = env.get(sym.name)) + return val; + else + throw new Exception("'" ~ sym.name ~ "' not found"); } else if (auto lst = cast(MalVector)ast) { @@ -42,22 +46,8 @@ MalType eval_ast(MalType ast, Env env) } return new MalHashmap(new_data); } - else - { - return ast; - } -} - -MalType EVAL(MalType ast, Env env) -{ - for (;;) + else if (auto ast_list = cast(MalList)ast) { - 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) { @@ -69,7 +59,7 @@ MalType EVAL(MalType ast, Env env) { case "def!": auto a1 = verify_cast!MalSymbol(aste[1]); - return env.set(a1, EVAL(aste[2], env)); + return env.set(a1.name, EVAL(aste[2], env)); case "let*": auto a1 = verify_cast!MalSequential(aste[1]); @@ -78,15 +68,16 @@ MalType EVAL(MalType ast, Env env) { 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)); + let_env.set(var_name.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); + foreach (elt; aste[1..$-1]) { + EVAL(elt, env); + } ast = aste[$-1]; continue; // TCO @@ -113,13 +104,8 @@ MalType EVAL(MalType ast, Env env) 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..$]; + 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); @@ -137,6 +123,11 @@ MalType EVAL(MalType ast, Env env) } } } + else + { + return ast; + } + } } string PRINT(MalType ast) @@ -159,7 +150,7 @@ 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)); + repl_env.set(sym_name, new MalBuiltinFunc(f, sym_name)); } // core.mal: defined using the language itself diff --git a/impls/d/step6_file.d b/impls/d/step6_file.d index 321b90b042..38a712581b 100644 --- a/impls/d/step6_file.d +++ b/impls/d/step6_file.d @@ -18,16 +18,20 @@ MalType READ(string str) return read_str(str); } -MalType eval_ast(MalType ast, Env env) +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) { - return env.get(sym); - } - else if (auto lst = cast(MalList)ast) - { - auto el = array(lst.elements.map!(e => EVAL(e, env))); - return new MalList(el); + if (auto val = env.get(sym.name)) + return val; + else + throw new Exception("'" ~ sym.name ~ "' not found"); } else if (auto lst = cast(MalVector)ast) { @@ -43,22 +47,8 @@ MalType eval_ast(MalType ast, Env env) } return new MalHashmap(new_data); } - else - { - return ast; - } -} - -MalType EVAL(MalType ast, Env env) -{ - for (;;) + else if (auto ast_list = cast(MalList)ast) { - 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) { @@ -70,7 +60,7 @@ MalType EVAL(MalType ast, Env env) { case "def!": auto a1 = verify_cast!MalSymbol(aste[1]); - return env.set(a1, EVAL(aste[2], env)); + return env.set(a1.name, EVAL(aste[2], env)); case "let*": auto a1 = verify_cast!MalSequential(aste[1]); @@ -79,15 +69,16 @@ MalType EVAL(MalType ast, Env env) { 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)); + let_env.set(var_name.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); + foreach (elt; aste[1..$-1]) { + EVAL(elt, env); + } ast = aste[$-1]; continue; // TCO @@ -114,13 +105,8 @@ MalType EVAL(MalType ast, Env env) 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..$]; + 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); @@ -138,6 +124,11 @@ MalType EVAL(MalType ast, Env env) } } } + else + { + return ast; + } + } } string PRINT(MalType ast) @@ -166,15 +157,15 @@ 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)); + 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(new MalSymbol("eval"), new MalBuiltinFunc(eval_func, "eval")); - repl_env.set(new MalSymbol("*ARGV*"), create_argv_list(args)); + 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); diff --git a/impls/d/step7_quote.d b/impls/d/step7_quote.d index 5b3e13afbe..f9217c2542 100644 --- a/impls/d/step7_quote.d +++ b/impls/d/step7_quote.d @@ -34,7 +34,7 @@ MalType quasiquote(MalType ast) if (starts_with(ast, sym_unquote)) return aste[1]; - MalType res = new MalList([]);; + 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]); @@ -50,16 +50,20 @@ MalType READ(string str) return read_str(str); } -MalType eval_ast(MalType ast, Env env) +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) { - return env.get(sym); - } - else if (auto lst = cast(MalList)ast) - { - auto el = array(lst.elements.map!(e => EVAL(e, env))); - return new MalList(el); + if (auto val = env.get(sym.name)) + return val; + else + throw new Exception("'" ~ sym.name ~ "' not found"); } else if (auto lst = cast(MalVector)ast) { @@ -75,22 +79,8 @@ MalType eval_ast(MalType ast, Env env) } return new MalHashmap(new_data); } - else - { - return ast; - } -} - -MalType EVAL(MalType ast, Env env) -{ - for (;;) + else if (auto ast_list = cast(MalList)ast) { - 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) { @@ -102,7 +92,7 @@ MalType EVAL(MalType ast, Env env) { case "def!": auto a1 = verify_cast!MalSymbol(aste[1]); - return env.set(a1, EVAL(aste[2], env)); + return env.set(a1.name, EVAL(aste[2], env)); case "let*": auto a1 = verify_cast!MalSequential(aste[1]); @@ -111,7 +101,7 @@ MalType EVAL(MalType ast, Env env) { 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)); + let_env.set(var_name.name, EVAL(kv[1], let_env)); } ast = aste[2]; env = let_env; @@ -120,16 +110,14 @@ MalType EVAL(MalType ast, Env env) case "quote": return aste[1]; - case "quasiquoteexpand": - return quasiquote(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); + foreach (elt; aste[1..$-1]) { + EVAL(elt, env); + } ast = aste[$-1]; continue; // TCO @@ -156,13 +144,8 @@ MalType EVAL(MalType ast, Env env) 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..$]; + 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); @@ -180,6 +163,11 @@ MalType EVAL(MalType ast, Env env) } } } + else + { + return ast; + } + } } string PRINT(MalType ast) @@ -208,15 +196,15 @@ 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)); + 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(new MalSymbol("eval"), new MalBuiltinFunc(eval_func, "eval")); - repl_env.set(new MalSymbol("*ARGV*"), create_argv_list(args)); + 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); diff --git a/impls/d/step8_macros.d b/impls/d/step8_macros.d index a186e79579..9faf41aed7 100644 --- a/impls/d/step8_macros.d +++ b/impls/d/step8_macros.d @@ -34,7 +34,7 @@ MalType quasiquote(MalType ast) if (starts_with(ast, sym_unquote)) return aste[1]; - MalType res = new MalList([]);; + 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]); @@ -45,49 +45,25 @@ MalType quasiquote(MalType ast) return res; } -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) +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) { - return env.get(sym); - } - else if (auto lst = cast(MalList)ast) - { - auto el = array(lst.elements.map!(e => EVAL(e, env))); - return new MalList(el); + if (auto val = env.get(sym.name)) + return val; + else + throw new Exception("'" ~ sym.name ~ "' not found"); } else if (auto lst = cast(MalVector)ast) { @@ -103,29 +79,8 @@ MalType eval_ast(MalType ast, Env env) } return new MalHashmap(new_data); } - else - { - return ast; - } -} - -MalType EVAL(MalType ast, Env env) -{ - for (;;) + else if (auto ast_list = cast(MalList)ast) { - 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) { @@ -137,7 +92,7 @@ MalType EVAL(MalType ast, Env env) { case "def!": auto a1 = verify_cast!MalSymbol(aste[1]); - return env.set(a1, EVAL(aste[2], env)); + return env.set(a1.name, EVAL(aste[2], env)); case "let*": auto a1 = verify_cast!MalSequential(aste[1]); @@ -146,7 +101,7 @@ MalType EVAL(MalType ast, Env env) { 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)); + let_env.set(var_name.name, EVAL(kv[1], let_env)); } ast = aste[2]; env = let_env; @@ -155,9 +110,6 @@ MalType EVAL(MalType ast, Env env) case "quote": return aste[1]; - case "quasiquoteexpand": - return quasiquote(aste[1]); - case "quasiquote": ast = quasiquote(aste[1]); continue; // TCO @@ -167,14 +119,12 @@ MalType EVAL(MalType ast, Env env) 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, mac); - - case "macroexpand": - return macroexpand(aste[1], env); + return env.set(a1.name, mac); case "do": - auto all_but_last = new MalList(aste[1..$-1]); - eval_ast(all_but_last, env); + foreach (elt; aste[1..$-1]) { + EVAL(elt, env); + } ast = aste[$-1]; continue; // TCO @@ -201,15 +151,16 @@ MalType EVAL(MalType ast, Env env) 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..$]; + 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; @@ -217,6 +168,7 @@ MalType EVAL(MalType ast, Env env) } else if (auto builtinfuncobj = cast(MalBuiltinFunc)first) { + rest = array(rest.map!(e => EVAL(e, env))); return builtinfuncobj.fn(rest); } else @@ -225,6 +177,11 @@ MalType EVAL(MalType ast, Env env) } } } + else + { + return ast; + } + } } string PRINT(MalType ast) @@ -253,15 +210,15 @@ 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)); + 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(new MalSymbol("eval"), new MalBuiltinFunc(eval_func, "eval")); - repl_env.set(new MalSymbol("*ARGV*"), create_argv_list(args)); + 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); diff --git a/impls/d/step9_try.d b/impls/d/step9_try.d index 77da44b405..be38cfb754 100644 --- a/impls/d/step9_try.d +++ b/impls/d/step9_try.d @@ -34,7 +34,7 @@ MalType quasiquote(MalType ast) if (starts_with(ast, sym_unquote)) return aste[1]; - MalType res = new MalList([]);; + 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]); @@ -45,49 +45,25 @@ MalType quasiquote(MalType ast) return res; } -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) +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) { - return env.get(sym); - } - else if (auto lst = cast(MalList)ast) - { - auto el = array(lst.elements.map!(e => EVAL(e, env))); - return new MalList(el); + if (auto val = env.get(sym.name)) + return val; + else + throw new Exception("'" ~ sym.name ~ "' not found"); } else if (auto lst = cast(MalVector)ast) { @@ -103,29 +79,8 @@ MalType eval_ast(MalType ast, Env env) } return new MalHashmap(new_data); } - else - { - return ast; - } -} - -MalType EVAL(MalType ast, Env env) -{ - for (;;) + else if (auto ast_list = cast(MalList)ast) { - 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) { @@ -137,7 +92,7 @@ MalType EVAL(MalType ast, Env env) { case "def!": auto a1 = verify_cast!MalSymbol(aste[1]); - return env.set(a1, EVAL(aste[2], env)); + return env.set(a1.name, EVAL(aste[2], env)); case "let*": auto a1 = verify_cast!MalSequential(aste[1]); @@ -146,7 +101,7 @@ MalType EVAL(MalType ast, Env env) { 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)); + let_env.set(var_name.name, EVAL(kv[1], let_env)); } ast = aste[2]; env = let_env; @@ -155,9 +110,6 @@ MalType EVAL(MalType ast, Env env) case "quote": return aste[1]; - case "quasiquoteexpand": - return quasiquote(aste[1]); - case "quasiquote": ast = quasiquote(aste[1]); continue; // TCO @@ -167,10 +119,7 @@ MalType EVAL(MalType ast, Env env) 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, mac); - - case "macroexpand": - return macroexpand(aste[1], env); + return env.set(a1.name, mac); case "try*": if (aste.length < 2) return mal_nil; @@ -202,8 +151,9 @@ MalType EVAL(MalType ast, Env env) continue; // TCO case "do": - auto all_but_last = new MalList(aste[1..$-1]); - eval_ast(all_but_last, env); + foreach (elt; aste[1..$-1]) { + EVAL(elt, env); + } ast = aste[$-1]; continue; // TCO @@ -230,15 +180,16 @@ MalType EVAL(MalType ast, Env env) 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..$]; + 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; @@ -246,6 +197,7 @@ MalType EVAL(MalType ast, Env env) } else if (auto builtinfuncobj = cast(MalBuiltinFunc)first) { + rest = array(rest.map!(e => EVAL(e, env))); return builtinfuncobj.fn(rest); } else @@ -254,6 +206,11 @@ MalType EVAL(MalType ast, Env env) } } } + else + { + return ast; + } + } } string PRINT(MalType ast) @@ -282,15 +239,15 @@ 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)); + 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(new MalSymbol("eval"), new MalBuiltinFunc(eval_func, "eval")); - repl_env.set(new MalSymbol("*ARGV*"), create_argv_list(args)); + 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); diff --git a/impls/d/stepA_mal.d b/impls/d/stepA_mal.d index 1b6e490853..d354718bb2 100644 --- a/impls/d/stepA_mal.d +++ b/impls/d/stepA_mal.d @@ -35,7 +35,7 @@ MalType quasiquote(MalType ast) if (starts_with(ast, sym_unquote)) return aste[1]; - MalType res = new MalList([]);; + 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]); @@ -46,49 +46,25 @@ MalType quasiquote(MalType ast) return res; } -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) +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) { - return env.get(sym); - } - else if (auto lst = cast(MalList)ast) - { - auto el = array(lst.elements.map!(e => EVAL(e, env))); - return new MalList(el); + if (auto val = env.get(sym.name)) + return val; + else + throw new Exception("'" ~ sym.name ~ "' not found"); } else if (auto lst = cast(MalVector)ast) { @@ -104,29 +80,8 @@ MalType eval_ast(MalType ast, Env env) } return new MalHashmap(new_data); } - else - { - return ast; - } -} - -MalType EVAL(MalType ast, Env env) -{ - for (;;) + else if (auto ast_list = cast(MalList)ast) { - 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) { @@ -138,7 +93,7 @@ MalType EVAL(MalType ast, Env env) { case "def!": auto a1 = verify_cast!MalSymbol(aste[1]); - return env.set(a1, EVAL(aste[2], env)); + return env.set(a1.name, EVAL(aste[2], env)); case "let*": auto a1 = verify_cast!MalSequential(aste[1]); @@ -147,7 +102,7 @@ MalType EVAL(MalType ast, Env env) { 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)); + let_env.set(var_name.name, EVAL(kv[1], let_env)); } ast = aste[2]; env = let_env; @@ -156,9 +111,6 @@ MalType EVAL(MalType ast, Env env) case "quote": return aste[1]; - case "quasiquoteexpand": - return quasiquote(aste[1]); - case "quasiquote": ast = quasiquote(aste[1]); continue; // TCO @@ -168,10 +120,7 @@ MalType EVAL(MalType ast, Env env) 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, mac); - - case "macroexpand": - return macroexpand(aste[1], env); + return env.set(a1.name, mac); case "try*": if (aste.length < 2) return mal_nil; @@ -203,8 +152,9 @@ MalType EVAL(MalType ast, Env env) continue; // TCO case "do": - auto all_but_last = new MalList(aste[1..$-1]); - eval_ast(all_but_last, env); + foreach (elt; aste[1..$-1]) { + EVAL(elt, env); + } ast = aste[$-1]; continue; // TCO @@ -231,15 +181,16 @@ MalType EVAL(MalType ast, Env env) 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..$]; + 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; @@ -247,6 +198,7 @@ MalType EVAL(MalType ast, Env env) } else if (auto builtinfuncobj = cast(MalBuiltinFunc)first) { + rest = array(rest.map!(e => EVAL(e, env))); return builtinfuncobj.fn(rest); } else @@ -255,6 +207,11 @@ MalType EVAL(MalType ast, Env env) } } } + else + { + return ast; + } + } } string PRINT(MalType ast) @@ -283,15 +240,15 @@ 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)); + 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(new MalSymbol("eval"), new MalBuiltinFunc(eval_func, "eval")); - repl_env.set(new MalSymbol("*ARGV*"), create_argv_list(args)); + 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); diff --git a/impls/dart/core.dart b/impls/dart/core.dart index a8ac4b897d..e5620f4691 100644 --- a/impls/dart/core.dart +++ b/impls/dart/core.dart @@ -4,108 +4,108 @@ import 'printer.dart'; import 'reader.dart' as reader; import 'types.dart'; -Map ns = { - new MalSymbol('+'): new MalBuiltin((List args) { +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 MalSymbol('-'): new MalBuiltin((List args) { + '-': new MalBuiltin((List args) { var a = args[0] as MalInt; var b = args[1] as MalInt; return new MalInt(a.value - b.value); }), - new MalSymbol('*'): new MalBuiltin((List args) { + '*': new MalBuiltin((List args) { var a = args[0] as MalInt; var b = args[1] as MalInt; return new MalInt(a.value * b.value); }), - new MalSymbol('/'): new MalBuiltin((List args) { + '/': new MalBuiltin((List args) { var a = args[0] as MalInt; var b = args[1] as MalInt; return new MalInt(a.value ~/ b.value); }), - new MalSymbol('list'): + 'list': new MalBuiltin((List args) => new MalList(args.toList())), - new MalSymbol('list?'): new MalBuiltin( + 'list?': new MalBuiltin( (List args) => new MalBool(args.single is MalList)), - new MalSymbol('empty?'): new MalBuiltin((List args) { + 'empty?': new MalBuiltin((List args) { var a = args.single as MalIterable; return new MalBool(a.elements.isEmpty); }), - new MalSymbol('count'): new MalBuiltin((List args) { + 'count': new MalBuiltin((List args) { var a = args.first as MalIterable; return new MalInt(a.elements.length); }), - new MalSymbol('='): new MalBuiltin((List args) { + '=': new MalBuiltin((List args) { var a = args[0]; var b = args[1]; return new MalBool(a == b); }), - new MalSymbol('<'): new MalBuiltin((List args) { + '<': new MalBuiltin((List args) { var a = args[0] as MalInt; var b = args[1] as MalInt; return new MalBool(a.value < b.value); }), - new MalSymbol('<='): new MalBuiltin((List args) { + '<=': new MalBuiltin((List args) { var a = args[0] as MalInt; var b = args[1] as MalInt; return new MalBool(a.value <= b.value); }), - new MalSymbol('>'): new MalBuiltin((List args) { + '>': new MalBuiltin((List args) { var a = args[0] as MalInt; var b = args[1] as MalInt; return new MalBool(a.value > b.value); }), - new MalSymbol('>='): new MalBuiltin((List args) { + '>=': new MalBuiltin((List args) { var a = args[0] as MalInt; var b = args[1] as MalInt; return new MalBool(a.value >= b.value); }), - new MalSymbol('pr-str'): new MalBuiltin((List args) { + 'pr-str': new MalBuiltin((List args) { return new MalString( args.map((a) => pr_str(a, print_readably: true)).join(' ')); }), - new MalSymbol('str'): new MalBuiltin((List args) { + 'str': new MalBuiltin((List args) { return new MalString( args.map((a) => pr_str(a, print_readably: false)).join()); }), - new MalSymbol('prn'): new MalBuiltin((List args) { + 'prn': new MalBuiltin((List args) { print(args.map((a) => pr_str(a, print_readably: true)).join(' ')); return new MalNil(); }), - new MalSymbol('println'): new MalBuiltin((List args) { + 'println': new MalBuiltin((List args) { print(args.map((a) => pr_str(a, print_readably: false)).join(' ')); return new MalNil(); }), - new MalSymbol('read-string'): new MalBuiltin((List args) { + 'read-string': new MalBuiltin((List args) { var code = args.single as MalString; return reader.read_str(code.value); }), - new MalSymbol('slurp'): new MalBuiltin((List args) { + 'slurp': new MalBuiltin((List args) { var fileName = args.single as MalString; var file = new File(fileName.value); return new MalString(file.readAsStringSync()); }), - new MalSymbol('atom'): new MalBuiltin((List args) { + 'atom': new MalBuiltin((List args) { var value = args.single; return new MalAtom(value); }), - new MalSymbol('atom?'): new MalBuiltin((List args) { + 'atom?': new MalBuiltin((List args) { var value = args.single; return new MalBool(value is MalAtom); }), - new MalSymbol('deref'): new MalBuiltin((List args) { + 'deref': new MalBuiltin((List args) { var atom = args.single as MalAtom; return atom.value; }), - new MalSymbol('reset!'): new MalBuiltin((List args) { + 'reset!': new MalBuiltin((List args) { var atom = args[0] as MalAtom; var newValue = args[1]; atom.value = newValue; return newValue; }), - new MalSymbol('swap!'): new MalBuiltin((List args) { + '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)); @@ -113,26 +113,26 @@ Map ns = { atom.value = result; return result; }), - new MalSymbol('cons'): new MalBuiltin((List args) { + 'cons': new MalBuiltin((List args) { var x = args[0]; var xs = args[1] as MalIterable; return new MalList([x]..addAll(xs)); }), - new MalSymbol('concat'): new MalBuiltin((List args) { + 'concat': new MalBuiltin((List args) { var results = []; for (MalIterable element in args) { results.addAll(element); } return new MalList(results); }), - new MalSymbol('vec'): new MalBuiltin((List args) { + '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].elements); + if (args[0] is MalList) return new MalVector((args[0] as MalList).elements); } throw new MalException(new MalString("vec: wrong arguments")); }), - new MalSymbol('nth'): new MalBuiltin((List args) { + 'nth': new MalBuiltin((List args) { var indexable = args[0] as MalIterable; var index = args[1] as MalInt; try { @@ -141,70 +141,70 @@ Map ns = { throw new MalException(new MalString(e.toString())); } }), - new MalSymbol('first'): new MalBuiltin((List args) { + 'first': new MalBuiltin((List args) { var list = args.first as MalIterable; if (list.isEmpty) return new MalNil(); return list.first; }), - new MalSymbol('rest'): new MalBuiltin((List args) { + 'rest': new MalBuiltin((List args) { var list = args.first as MalIterable; if (list.isEmpty) return new MalList([]); return new MalList(list.sublist(1)); }), - new MalSymbol('throw'): new MalBuiltin((List args) { + 'throw': new MalBuiltin((List args) { throw new MalException(args.first); }), - new MalSymbol('nil?'): new MalBuiltin((List args) { + 'nil?': new MalBuiltin((List args) { return new MalBool(args.first is MalNil); }), - new MalSymbol('true?'): new MalBuiltin((List args) { + 'true?': new MalBuiltin((List args) { return new MalBool(args.first is MalBool && (args.first as MalBool).value); }), - new MalSymbol('false?'): new MalBuiltin((List args) { + 'false?': new MalBuiltin((List args) { return new MalBool(args.first is MalBool && !(args.first as MalBool).value); }), - new MalSymbol('symbol'): new MalBuiltin((List args) { + 'symbol': new MalBuiltin((List args) { return new MalSymbol((args.first as MalString).value); }), - new MalSymbol('symbol?'): new MalBuiltin((List args) { + 'symbol?': new MalBuiltin((List args) { return new MalBool(args.first is MalSymbol); }), - new MalSymbol('keyword'): new MalBuiltin((List args) { + 'keyword': new MalBuiltin((List args) { if (args.first is MalKeyword) return args.first; return new MalKeyword((args.first as MalString).value); }), - new MalSymbol('keyword?'): new MalBuiltin((List args) { + 'keyword?': new MalBuiltin((List args) { return new MalBool(args.first is MalKeyword); }), - new MalSymbol('number?'): new MalBuiltin((List args) { + 'number?': new MalBuiltin((List args) { return new MalBool(args.first is MalInt); }), - new MalSymbol('fn?'): new MalBuiltin((List args) { + 'fn?': new MalBuiltin((List args) { return new MalBool(args.first is MalCallable && !(args.first.isMacro)); }), - new MalSymbol('macro?'): new MalBuiltin((List args) { + 'macro?': new MalBuiltin((List args) { return new MalBool(args.first is MalCallable && args.first.isMacro); }), - new MalSymbol('vector'): new MalBuiltin((List args) { + 'vector': new MalBuiltin((List args) { return new MalVector(args); }), - new MalSymbol('vector?'): new MalBuiltin((List args) { + 'vector?': new MalBuiltin((List args) { return new MalBool(args.first is MalVector); }), - new MalSymbol('hash-map'): new MalBuiltin((List args) { + 'hash-map': new MalBuiltin((List args) { return new MalHashMap.fromSequence(args); }), - new MalSymbol('map?'): new MalBuiltin((List args) { + 'map?': new MalBuiltin((List args) { return new MalBool(args.first is MalHashMap); }), - new MalSymbol('assoc'): new MalBuiltin((List args) { + '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); }), - new MalSymbol('dissoc'): new MalBuiltin((List args) { + '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)) { @@ -212,38 +212,38 @@ Map ns = { } return new MalHashMap(newMap); }), - new MalSymbol('get'): new MalBuiltin((List args) { + '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(); }), - new MalSymbol('contains?'): new MalBuiltin((List args) { + 'contains?': new MalBuiltin((List args) { var map = args[0] as MalHashMap; var key = args[1]; return new MalBool(map.value.containsKey(key)); }), - new MalSymbol('keys'): new MalBuiltin((List args) { + 'keys': new MalBuiltin((List args) { return new MalList((args.first as MalHashMap).value.keys.toList()); }), - new MalSymbol('vals'): new MalBuiltin((List args) { + 'vals': new MalBuiltin((List args) { return new MalList((args.first as MalHashMap).value.values.toList()); }), - new MalSymbol('sequential?'): new MalBuiltin((List args) { + 'sequential?': new MalBuiltin((List args) { return new MalBool(args.first is MalList || args.first is MalVector); }), - new MalSymbol('readline'): new MalBuiltin((List args) { + '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); }), - new MalSymbol('time-ms'): new MalBuiltin((List args) { + 'time-ms': new MalBuiltin((List args) { assert(args.isEmpty); return new MalInt(new DateTime.now().millisecondsSinceEpoch); }), - new MalSymbol('conj'): new MalBuiltin((List args) { + 'conj': new MalBuiltin((List args) { var collection = args.first; var elements = args.sublist(1); if (collection is MalList) { @@ -255,10 +255,10 @@ Map ns = { } throw new MalException(new MalString('"conj" takes a list or vector')); }), - new MalSymbol('string?'): new MalBuiltin((List args) { + 'string?': new MalBuiltin((List args) { return new MalBool(args.first is MalString); }), - new MalSymbol('seq'): new MalBuiltin((List args) { + '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(); @@ -274,7 +274,7 @@ Map ns = { } throw new MalException(new MalString('bad argument to "seq"')); }), - new MalSymbol('map'): new MalBuiltin((List args) { + 'map': new MalBuiltin((List args) { var fn = args[0] as MalCallable; var list = args[1] as MalIterable; var newList = []; @@ -283,18 +283,18 @@ Map ns = { } return new MalList(newList); }), - new MalSymbol('apply'): new MalBuiltin((List args) { + '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); }), - new MalSymbol('meta'): new MalBuiltin((List args) { + 'meta': new MalBuiltin((List args) { var arg = args.first; return arg.meta ?? new MalNil(); }), - new MalSymbol('with-meta'): new MalBuiltin((List args) { + 'with-meta': new MalBuiltin((List args) { var evaled = args.first; var evaledWithMeta = evaled.clone(); evaledWithMeta.meta = args[1]; diff --git a/impls/dart/env.dart b/impls/dart/env.dart index 122d377838..75f54c47e5 100644 --- a/impls/dart/env.dart +++ b/impls/dart/env.dart @@ -3,7 +3,7 @@ import 'types.dart'; class Env { final Env outer; - final data = {}; + final data = {}; Env([this.outer, List binds, List exprs]) { if (binds == null) { @@ -12,36 +12,29 @@ class Env { assert(exprs != null && (binds.length == exprs.length || binds.contains(new MalSymbol('&')))); for (var i = 0; i < binds.length; i++) { - if (binds[i] == new MalSymbol('&')) { - set(binds[i + 1], new MalList(exprs.sublist(i))); + if (binds[i].value == '&') { + set(binds[i + 1].value, new MalList(exprs.sublist(i))); break; } - set(binds[i], exprs[i]); + set(binds[i].value, exprs[i]); } } } - void set(MalSymbol key, MalType value) { + void set(String key, MalType value) { data[key] = value; } - Env find(MalSymbol key) { - if (data[key] != null) { - return this; + MalType get(String key) { + var value = data[key]; + if (value != null) { + return value; } if (outer != null) { - return outer.find(key); + return outer.get(key); } return null; } - - MalType get(MalSymbol key) { - var env = find(key); - if (env != null) { - return env.data[key]; - } - throw new NotFoundException(key.value); - } } class NotFoundException implements Exception { diff --git a/impls/dart/step2_eval.dart b/impls/dart/step2_eval.dart index 820c8d769f..b8efdb14d5 100644 --- a/impls/dart/step2_eval.dart +++ b/impls/dart/step2_eval.dart @@ -4,11 +4,27 @@ import 'printer.dart' as printer; import 'reader.dart' as reader; import 'types.dart'; -final Map replEnv = { - new MalSymbol('+'): (MalInt a, MalInt b) => new MalInt(a.value + b.value), - new MalSymbol('-'): (MalInt a, MalInt b) => new MalInt(a.value - b.value), - new MalSymbol('*'): (MalInt a, MalInt b) => new MalInt(a.value * b.value), - new MalSymbol('/'): (MalInt a, MalInt b) => new MalInt(a.value ~/ b.value), +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); @@ -20,19 +36,21 @@ class NotFoundException implements Exception { NotFoundException(this.value); } -eval_ast(MalType ast, Map env) { +MalType EVAL(MalType ast, Map env) { + // stdout.writeln("EVAL: ${printer.pr_str(ast)}"); + if (ast is MalSymbol) { - var result = env[ast]; + var result = env[ast.value]; if (result == null) { throw new NotFoundException(ast.value); } return result; } else if (ast is MalList) { - return new MalList(ast.elements.map((x) => EVAL(x, env)).toList()); + // 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); + var newMap = new Map.from(ast.value); for (var key in newMap.keys) { newMap[key] = EVAL(newMap[key], env); } @@ -40,21 +58,15 @@ eval_ast(MalType ast, Map env) { } else { return ast; } -} - -EVAL(MalType ast, Map env) { - if (ast is! MalList) { - return eval_ast(ast, env); - } else { - if ((ast as MalList).elements.isEmpty) { + // ast is a list. todo: indent left. + var forms = (ast as MalList).elements; + if (forms.isEmpty) { return ast; } else { - var newAst = eval_ast(ast, env) as MalList; - Function f = newAst.elements.first; - var args = newAst.elements.sublist(1); - return Function.apply(f, args); + 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); diff --git a/impls/dart/step3_env.dart b/impls/dart/step3_env.dart index 0c1a0af963..f08f9c728e 100644 --- a/impls/dart/step3_env.dart +++ b/impls/dart/step3_env.dart @@ -8,22 +8,22 @@ import 'types.dart'; final Env replEnv = new Env(); void setupEnv() { - replEnv.set(new MalSymbol('+'), new MalBuiltin((List args) { + 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 MalSymbol('-'), new MalBuiltin((List args) { + 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 MalSymbol('*'), new MalBuiltin((List args) { + 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 MalSymbol('/'), new MalBuiltin((List args) { + 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); @@ -32,19 +32,25 @@ void setupEnv() { MalType READ(String x) => reader.read_str(x); -MalType eval_ast(MalType ast, Env env) { +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); + var result = env.get(ast.value); if (result == null) { throw new NotFoundException(ast.value); } return result; } else if (ast is MalList) { - return new MalList(ast.elements.map((x) => EVAL(x, env)).toList()); + // 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); + var newMap = new Map.from(ast.value); for (var key in newMap.keys) { newMap[key] = EVAL(newMap[key], env); } @@ -52,12 +58,7 @@ MalType eval_ast(MalType ast, Env env) { } else { return ast; } -} - -MalType EVAL(MalType ast, Env env) { - if (ast is! MalList) { - return eval_ast(ast, env); - } else { + // ast is a list. todo: indent left. if ((ast as MalList).elements.isEmpty) { return ast; } else { @@ -68,7 +69,7 @@ MalType EVAL(MalType ast, Env env) { if (symbol.value == "def!") { MalSymbol key = args.first; MalType value = EVAL(args[1], env); - env.set(key, value); + env.set(key.value, value); return value; } else if (symbol.value == "let*") { // TODO(het): If elements.length is not even, give helpful error @@ -83,17 +84,15 @@ MalType EVAL(MalType ast, Env env) { for (var pair in pairs(bindings.elements)) { MalSymbol key = pair[0]; MalType value = EVAL(pair[1], newEnv); - newEnv.set(key, value); + newEnv.set(key.value, value); } return EVAL(args[1], newEnv); } } - var newAst = eval_ast(ast, env) as MalList; - MalBuiltin f = newAst.elements.first; - var args = newAst.elements.sublist(1); + 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); diff --git a/impls/dart/step4_if_fn_do.dart b/impls/dart/step4_if_fn_do.dart index 7559da64d2..1ba094eed1 100644 --- a/impls/dart/step4_if_fn_do.dart +++ b/impls/dart/step4_if_fn_do.dart @@ -16,19 +16,25 @@ void setupEnv() { MalType READ(String x) => reader.read_str(x); -MalType eval_ast(MalType ast, Env env) { +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); + var result = env.get(ast.value); if (result == null) { throw new NotFoundException(ast.value); } return result; } else if (ast is MalList) { - return new MalList(ast.elements.map((x) => EVAL(x, env)).toList()); + // 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); + var newMap = new Map.from(ast.value); for (var key in newMap.keys) { newMap[key] = EVAL(newMap[key], env); } @@ -36,12 +42,7 @@ MalType eval_ast(MalType ast, Env env) { } else { return ast; } -} - -MalType EVAL(MalType ast, Env env) { - if (ast is! MalList) { - return eval_ast(ast, env); - } else { + // ast is a list. todo: indent left. if ((ast as MalList).elements.isEmpty) { return ast; } else { @@ -52,7 +53,7 @@ MalType EVAL(MalType ast, Env env) { if (symbol.value == "def!") { MalSymbol key = args.first; MalType value = EVAL(args[1], env); - env.set(key, value); + env.set(key.value, value); return value; } else if (symbol.value == "let*") { // TODO(het): If elements.length is not even, give helpful error @@ -67,7 +68,7 @@ MalType EVAL(MalType ast, Env env) { for (var pair in pairs(bindings.elements)) { MalSymbol key = pair[0]; MalType value = EVAL(pair[1], newEnv); - newEnv.set(key, value); + newEnv.set(key.value, value); } return EVAL(args[1], newEnv); } else if (symbol.value == "do") { @@ -98,15 +99,14 @@ MalType EVAL(MalType ast, Env env) { EVAL(args[1], new Env(env, params, funcArgs))); } } - var newAst = eval_ast(ast, env) as MalList; - var f = newAst.elements.first; + 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(newAst.elements.sublist(1)); + return f.call(args); } else { throw 'bad!'; } } - } } String PRINT(MalType x) => printer.pr_str(x); diff --git a/impls/dart/step5_tco.dart b/impls/dart/step5_tco.dart index b2733a028e..2b3088ba23 100644 --- a/impls/dart/step5_tco.dart +++ b/impls/dart/step5_tco.dart @@ -16,19 +16,27 @@ void setupEnv() { MalType READ(String x) => reader.read_str(x); -MalType eval_ast(MalType ast, Env env) { +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); + var result = env.get(ast.value); if (result == null) { throw new NotFoundException(ast.value); } return result; } else if (ast is MalList) { - return new MalList(ast.elements.map((x) => EVAL(x, env)).toList()); + // 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); + var newMap = new Map.from(ast.value); for (var key in newMap.keys) { newMap[key] = EVAL(newMap[key], env); } @@ -36,13 +44,7 @@ MalType eval_ast(MalType ast, Env env) { } else { return ast; } -} - -MalType EVAL(MalType ast, Env env) { - while (true) { - if (ast is! MalList) { - return eval_ast(ast, env); - } else { + // ast is a list. todo: indent left. if ((ast as MalList).elements.isEmpty) { return ast; } else { @@ -53,7 +55,7 @@ MalType EVAL(MalType ast, Env env) { if (symbol.value == "def!") { MalSymbol key = args.first; MalType value = EVAL(args[1], env); - env.set(key, value); + env.set(key.value, value); return value; } else if (symbol.value == "let*") { // TODO(het): If elements.length is not even, give helpful error @@ -68,14 +70,14 @@ MalType EVAL(MalType ast, Env env) { for (var pair in pairs(bindings.elements)) { MalSymbol key = pair[0]; MalType value = EVAL(pair[1], newEnv); - newEnv.set(key, value); + newEnv.set(key.value, value); } ast = args[1]; env = newEnv; continue; } else if (symbol.value == "do") { - for (var element in args.sublist(0, args.length - 1)) { - eval_ast(element, env); + for (var elt in args.sublist(0, args.length - 1)) { + EVAL(elt, env); } ast = args.last; continue; @@ -107,9 +109,8 @@ MalType EVAL(MalType ast, Env env) { EVAL(args[1], new Env(env, params, funcArgs))); } } - var newAst = eval_ast(ast, env) as MalList; - var f = newAst.elements.first; - var args = newAst.elements.sublist(1); + 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) { @@ -120,7 +121,6 @@ MalType EVAL(MalType ast, Env env) { throw 'bad!'; } } - } } } diff --git a/impls/dart/step6_file.dart b/impls/dart/step6_file.dart index 3fee92d31d..156443186e 100644 --- a/impls/dart/step6_file.dart +++ b/impls/dart/step6_file.dart @@ -12,10 +12,10 @@ void setupEnv(List argv) { // TODO(het): use replEnv#set once generalized tearoffs are implemented ns.forEach((sym, fun) => replEnv.set(sym, fun)); - replEnv.set(new MalSymbol('eval'), + replEnv.set('eval', new MalBuiltin((List args) => EVAL(args.single, replEnv))); - replEnv.set(new MalSymbol('*ARGV*'), + replEnv.set('*ARGV*', new MalList(argv.map((s) => new MalString(s)).toList())); rep('(def! not (fn* (a) (if a false true)))'); @@ -25,15 +25,23 @@ void setupEnv(List argv) { MalType READ(String x) => reader.read_str(x); -MalType eval_ast(MalType ast, Env env) { +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); + var result = env.get(ast.value); if (result == null) { throw new NotFoundException(ast.value); } return result; } else if (ast is MalList) { - return new MalList(ast.elements.map((x) => EVAL(x, env)).toList()); + // Exit this switch. } else if (ast is MalVector) { return new MalVector(ast.elements.map((x) => EVAL(x, env)).toList()); } else if (ast is MalHashMap) { @@ -45,13 +53,7 @@ MalType eval_ast(MalType ast, Env env) { } else { return ast; } -} - -MalType EVAL(MalType ast, Env env) { - while (true) { - if (ast is! MalList) { - return eval_ast(ast, env); - } else { + // ast is a list. todo: indent left. if ((ast as MalList).elements.isEmpty) { return ast; } else { @@ -62,7 +64,7 @@ MalType EVAL(MalType ast, Env env) { if (symbol.value == "def!") { MalSymbol key = args.first; MalType value = EVAL(args[1], env); - env.set(key, value); + env.set(key.value, value); return value; } else if (symbol.value == "let*") { // TODO(het): If elements.length is not even, give helpful error @@ -77,13 +79,15 @@ MalType EVAL(MalType ast, Env env) { for (var pair in pairs(bindings.elements)) { MalSymbol key = pair[0]; MalType value = EVAL(pair[1], newEnv); - newEnv.set(key, value); + newEnv.set(key.value, value); } ast = args[1]; env = newEnv; continue; } else if (symbol.value == "do") { - eval_ast(new MalList(args.sublist(0, args.length - 1)), env); + for (var elt in args.sublist(0, args.length - 1)) { + EVAL(elt, env); + } ast = args.last; continue; } else if (symbol.value == "if") { @@ -114,9 +118,8 @@ MalType EVAL(MalType ast, Env env) { EVAL(args[1], new Env(env, params, funcArgs))); } } - var newAst = eval_ast(ast, env) as MalList; - var f = newAst.elements.first; - var args = newAst.elements.sublist(1); + 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) { @@ -127,7 +130,6 @@ MalType EVAL(MalType ast, Env env) { throw 'bad!'; } } - } } } diff --git a/impls/dart/step7_quote.dart b/impls/dart/step7_quote.dart index c8fd399ce6..10cc424310 100644 --- a/impls/dart/step7_quote.dart +++ b/impls/dart/step7_quote.dart @@ -12,10 +12,10 @@ void setupEnv(List argv) { // TODO(het): use replEnv#set once generalized tearoffs are implemented ns.forEach((sym, fun) => replEnv.set(sym, fun)); - replEnv.set(new MalSymbol('eval'), + replEnv.set('eval', new MalBuiltin((List args) => EVAL(args.single, replEnv))); - replEnv.set(new MalSymbol('*ARGV*'), + replEnv.set('*ARGV*', new MalList(argv.map((s) => new MalString(s)).toList())); rep('(def! not (fn* (a) (if a false true)))'); @@ -55,15 +55,23 @@ MalType quasiquote(MalType ast) { MalType READ(String x) => reader.read_str(x); -MalType eval_ast(MalType ast, Env env) { +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); + var result = env.get(ast.value); if (result == null) { throw new NotFoundException(ast.value); } return result; } else if (ast is MalList) { - return new MalList(ast.elements.map((x) => EVAL(x, env)).toList()); + // Exit this switch. } else if (ast is MalVector) { return new MalVector(ast.elements.map((x) => EVAL(x, env)).toList()); } else if (ast is MalHashMap) { @@ -75,13 +83,7 @@ MalType eval_ast(MalType ast, Env env) { } else { return ast; } -} - -MalType EVAL(MalType ast, Env env) { - while (true) { - if (ast is! MalList) { - return eval_ast(ast, env); - } else { + // ast is a list. todo: indent left. if ((ast as MalList).elements.isEmpty) { return ast; } else { @@ -92,7 +94,7 @@ MalType EVAL(MalType ast, Env env) { if (symbol.value == "def!") { MalSymbol key = args.first; MalType value = EVAL(args[1], env); - env.set(key, value); + env.set(key.value, value); return value; } else if (symbol.value == "let*") { // TODO(het): If elements.length is not even, give helpful error @@ -107,13 +109,15 @@ MalType EVAL(MalType ast, Env env) { for (var pair in pairs(bindings.elements)) { MalSymbol key = pair[0]; MalType value = EVAL(pair[1], newEnv); - newEnv.set(key, value); + newEnv.set(key.value, value); } ast = args[1]; env = newEnv; continue; } else if (symbol.value == "do") { - eval_ast(new MalList(args.sublist(0, args.length - 1)), env); + for (var elt in args.sublist(0, args.length - 1)) { + EVAL(elt, env); + } ast = args.last; continue; } else if (symbol.value == "if") { @@ -144,16 +148,13 @@ MalType EVAL(MalType ast, Env env) { EVAL(args[1], new Env(env, params, funcArgs))); } else if (symbol.value == "quote") { return args.single; - } else if (symbol.value == "quasiquoteexpand") { - return quasiquote(args.first); } else if (symbol.value == "quasiquote") { ast = quasiquote(args.first); continue; } } - var newAst = eval_ast(ast, env) as MalList; - var f = newAst.elements.first; - var args = newAst.elements.sublist(1); + 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) { @@ -164,7 +165,6 @@ MalType EVAL(MalType ast, Env env) { throw 'bad!'; } } - } } } diff --git a/impls/dart/step8_macros.dart b/impls/dart/step8_macros.dart index 20a564a10f..ad884411d1 100644 --- a/impls/dart/step8_macros.dart +++ b/impls/dart/step8_macros.dart @@ -11,10 +11,10 @@ final Env replEnv = new Env(); void setupEnv(List argv) { ns.forEach((sym, fun) => replEnv.set(sym, fun)); - replEnv.set(new MalSymbol('eval'), + replEnv.set('eval', new MalBuiltin((List args) => EVAL(args.single, replEnv))); - replEnv.set(new MalSymbol('*ARGV*'), + replEnv.set('*ARGV*', new MalList(argv.map((s) => new MalString(s)).toList())); rep('(def! not (fn* (a) (if a false true)))'); @@ -29,35 +29,6 @@ void setupEnv(List argv) { " (cons 'cond (rest (rest xs)))))))"); } -/// Returns `true` if [ast] is a macro call. -/// -/// This checks that [ast] is a list whose first element is a symbol that refers -/// to a function in the current [env] that is a macro. -bool isMacroCall(MalType ast, Env env) { - if (ast is MalList) { - if (ast.isNotEmpty && ast.first is MalSymbol) { - try { - var value = env.get(ast.first); - if (value is MalCallable) { - return value.isMacro; - } - } on NotFoundException { - return false; - } - } - } - return false; -} - -MalType macroexpand(MalType ast, Env env) { - while (isMacroCall(ast, env)) { - var macroSymbol = (ast as MalList).first; - var macro = env.get(macroSymbol) as MalCallable; - ast = macro((ast as MalList).sublist(1)); - } - return ast; -} - bool starts_with(MalType ast, String sym) { return ast is MalList && ast.length == 2 && ast.first == new MalSymbol(sym); } @@ -90,11 +61,23 @@ MalType quasiquote(MalType ast) { MalType READ(String x) => reader.read_str(x); -MalType eval_ast(MalType ast, Env env) { +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) { - return env.get(ast); + var result = env.get(ast.value); + if (result == null) { + throw new NotFoundException(ast.value); + } + return result; } else if (ast is MalList) { - return new MalList(ast.elements.map((x) => EVAL(x, env)).toList()); + // Exit this switch. } else if (ast is MalVector) { return new MalVector(ast.elements.map((x) => EVAL(x, env)).toList()); } else if (ast is MalHashMap) { @@ -106,18 +89,7 @@ MalType eval_ast(MalType ast, Env env) { } else { return ast; } -} - -MalType EVAL(MalType ast, Env env) { - while (true) { - if (ast is! MalList) { - return eval_ast(ast, env); - } else { - if ((ast as MalList).elements.isEmpty) { - return ast; - } else { - ast = macroexpand(ast, env); - if (ast is! MalList) return eval_ast(ast, env); + // ast is a list. todo: indent left. if ((ast as MalList).isEmpty) return ast; var list = ast as MalList; @@ -128,13 +100,13 @@ MalType EVAL(MalType ast, Env env) { if (symbol.value == "def!") { MalSymbol key = args.first; MalType value = EVAL(args[1], env); - env.set(key, value); + env.set(key.value, value); return value; } else if (symbol.value == "defmacro!") { MalSymbol key = args.first; - MalClosure macro = EVAL(args[1], env) as MalClosure; + MalClosure macro = (EVAL(args[1], env) as MalClosure).clone(); macro.isMacro = true; - env.set(key, macro); + env.set(key.value, macro); return macro; } else if (symbol.value == "let*") { // TODO(het): If elements.length is not even, give helpful error @@ -149,13 +121,15 @@ MalType EVAL(MalType ast, Env env) { for (var pair in pairs(bindings.elements)) { MalSymbol key = pair[0]; MalType value = EVAL(pair[1], newEnv); - newEnv.set(key, value); + newEnv.set(key.value, value); } ast = args[1]; env = newEnv; continue; } else if (symbol.value == "do") { - eval_ast(new MalList(args.sublist(0, args.length - 1)), env); + for (var elt in args.sublist(0, args.length - 1)) { + EVAL(elt, env); + } ast = args.last; continue; } else if (symbol.value == "if") { @@ -186,18 +160,17 @@ MalType EVAL(MalType ast, Env env) { EVAL(args[1], new Env(env, params, funcArgs))); } else if (symbol.value == "quote") { return args.single; - } else if (symbol.value == "quasiquoteexpand") { - return quasiquote(args.first); } else if (symbol.value == "quasiquote") { ast = quasiquote(args.first); continue; - } else if (symbol.value == 'macroexpand') { - return macroexpand(args.first, env); } } - var newAst = eval_ast(ast, env) as MalList; - var f = newAst.elements.first; - var args = newAst.elements.sublist(1); + 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) { @@ -207,8 +180,6 @@ MalType EVAL(MalType ast, Env env) { } else { throw 'bad!'; } - } - } } } diff --git a/impls/dart/step9_try.dart b/impls/dart/step9_try.dart index 5bd894bc86..7504d601d6 100644 --- a/impls/dart/step9_try.dart +++ b/impls/dart/step9_try.dart @@ -11,10 +11,10 @@ final Env replEnv = new Env(); void setupEnv(List argv) { ns.forEach((sym, fun) => replEnv.set(sym, fun)); - replEnv.set(new MalSymbol('eval'), + replEnv.set('eval', new MalBuiltin((List args) => EVAL(args.single, replEnv))); - replEnv.set(new MalSymbol('*ARGV*'), + replEnv.set('*ARGV*', new MalList(argv.map((s) => new MalString(s)).toList())); rep('(def! not (fn* (a) (if a false true)))'); @@ -29,35 +29,6 @@ void setupEnv(List argv) { " (cons 'cond (rest (rest xs)))))))"); } -/// Returns `true` if [ast] is a macro call. -/// -/// This checks that [ast] is a list whose first element is a symbol that refers -/// to a function in the current [env] that is a macro. -bool isMacroCall(MalType ast, Env env) { - if (ast is MalList) { - if (ast.isNotEmpty && ast.first is MalSymbol) { - try { - var value = env.get(ast.first); - if (value is MalCallable) { - return value.isMacro; - } - } on NotFoundException { - return false; - } - } - } - return false; -} - -MalType macroexpand(MalType ast, Env env) { - while (isMacroCall(ast, env)) { - var macroSymbol = (ast as MalList).first; - var macro = env.get(macroSymbol) as MalCallable; - ast = macro((ast as MalList).sublist(1)); - } - return ast; -} - bool starts_with(MalType ast, String sym) { return ast is MalList && ast.length == 2 && ast.first == new MalSymbol(sym); } @@ -90,11 +61,23 @@ MalType quasiquote(MalType ast) { MalType READ(String x) => reader.read_str(x); -MalType eval_ast(MalType ast, Env env) { +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) { - return env.get(ast); + var result = env.get(ast.value); + if (result == null) { + throw new NotFoundException(ast.value); + } + return result; } else if (ast is MalList) { - return new MalList(ast.elements.map((x) => EVAL(x, env)).toList()); + // Exit this switch. } else if (ast is MalVector) { return new MalVector(ast.elements.map((x) => EVAL(x, env)).toList()); } else if (ast is MalHashMap) { @@ -106,18 +89,7 @@ MalType eval_ast(MalType ast, Env env) { } else { return ast; } -} - -MalType EVAL(MalType ast, Env env) { - while (true) { - if (ast is! MalList) { - return eval_ast(ast, env); - } else { - if ((ast as MalList).elements.isEmpty) { - return ast; - } else { - ast = macroexpand(ast, env); - if (ast is! MalList) return eval_ast(ast, env); + // ast is a list. todo: indent left. if ((ast as MalList).isEmpty) return ast; var list = ast as MalList; @@ -128,13 +100,13 @@ MalType EVAL(MalType ast, Env env) { if (symbol.value == "def!") { MalSymbol key = args.first; MalType value = EVAL(args[1], env); - env.set(key, value); + env.set(key.value, value); return value; } else if (symbol.value == "defmacro!") { MalSymbol key = args.first; - MalClosure macro = EVAL(args[1], env) as MalClosure; + MalClosure macro = (EVAL(args[1], env) as MalClosure).clone(); macro.isMacro = true; - env.set(key, macro); + env.set(key.value, macro); return macro; } else if (symbol.value == "let*") { // TODO(het): If elements.length is not even, give helpful error @@ -149,13 +121,15 @@ MalType EVAL(MalType ast, Env env) { for (var pair in pairs(bindings.elements)) { MalSymbol key = pair[0]; MalType value = EVAL(pair[1], newEnv); - newEnv.set(key, value); + newEnv.set(key.value, value); } ast = args[1]; env = newEnv; continue; } else if (symbol.value == "do") { - eval_ast(new MalList(args.sublist(0, args.length - 1)), env); + for (var elt in args.sublist(0, args.length - 1)) { + EVAL(elt, env); + } ast = args.last; continue; } else if (symbol.value == "if") { @@ -186,13 +160,9 @@ MalType EVAL(MalType ast, Env env) { EVAL(args[1], new Env(env, params, funcArgs))); } else if (symbol.value == "quote") { return args.single; - } else if (symbol.value == "quasiquoteexpand") { - return quasiquote(args.first); } else if (symbol.value == "quasiquote") { ast = quasiquote(args.first); continue; - } else if (symbol.value == 'macroexpand') { - return macroexpand(args.first, env); } else if (symbol.value == 'try*') { var body = args.first; if (args.length < 2) { @@ -220,9 +190,12 @@ MalType EVAL(MalType ast, Env env) { continue; } } - var newAst = eval_ast(ast, env) as MalList; - var f = newAst.elements.first; - var args = newAst.elements.sublist(1); + 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) { @@ -232,8 +205,6 @@ MalType EVAL(MalType ast, Env env) { } else { throw 'bad!'; } - } - } } } diff --git a/impls/dart/stepA_mal.dart b/impls/dart/stepA_mal.dart index 72bc20159c..fb9a5fb082 100644 --- a/impls/dart/stepA_mal.dart +++ b/impls/dart/stepA_mal.dart @@ -11,13 +11,13 @@ final Env replEnv = new Env(); void setupEnv(List argv) { ns.forEach((sym, fun) => replEnv.set(sym, fun)); - replEnv.set(new MalSymbol('eval'), + replEnv.set('eval', new MalBuiltin((List args) => EVAL(args.single, replEnv))); - replEnv.set(new MalSymbol('*ARGV*'), + replEnv.set('*ARGV*', new MalList(argv.map((s) => new MalString(s)).toList())); - replEnv.set(new MalSymbol('*host-language*'), new MalString('dart')); + replEnv.set('*host-language*', new MalString('dart')); rep('(def! not (fn* (a) (if a false true)))'); rep("(def! load-file " @@ -31,35 +31,6 @@ void setupEnv(List argv) { " (cons 'cond (rest (rest xs)))))))"); } -/// Returns `true` if [ast] is a macro call. -/// -/// This checks that [ast] is a list whose first element is a symbol that refers -/// to a function in the current [env] that is a macro. -bool isMacroCall(MalType ast, Env env) { - if (ast is MalList) { - if (ast.isNotEmpty && ast.first is MalSymbol) { - try { - var value = env.get(ast.first); - if (value is MalCallable) { - return value.isMacro; - } - } on NotFoundException { - return false; - } - } - } - return false; -} - -MalType macroexpand(MalType ast, Env env) { - while (isMacroCall(ast, env)) { - var macroSymbol = (ast as MalList).first; - var macro = env.get(macroSymbol) as MalCallable; - ast = macro((ast as MalList).sublist(1)); - } - return ast; -} - bool starts_with(MalType ast, String sym) { return ast is MalList && ast.length == 2 && ast.first == new MalSymbol(sym); } @@ -92,11 +63,23 @@ MalType quasiquote(MalType ast) { MalType READ(String x) => reader.read_str(x); -MalType eval_ast(MalType ast, Env env) { +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) { - return env.get(ast); + var result = env.get(ast.value); + if (result == null) { + throw new NotFoundException(ast.value); + } + return result; } else if (ast is MalList) { - return new MalList(ast.elements.map((x) => EVAL(x, env)).toList()); + // Exit this switch. } else if (ast is MalVector) { return new MalVector(ast.elements.map((x) => EVAL(x, env)).toList()); } else if (ast is MalHashMap) { @@ -108,18 +91,7 @@ MalType eval_ast(MalType ast, Env env) { } else { return ast; } -} - -MalType EVAL(MalType ast, Env env) { - while (true) { - if (ast is! MalList) { - return eval_ast(ast, env); - } else { - if ((ast as MalList).elements.isEmpty) { - return ast; - } else { - ast = macroexpand(ast, env); - if (ast is! MalList) return eval_ast(ast, env); + // ast is a list. todo: indent left. if ((ast as MalList).isEmpty) return ast; var list = ast as MalList; @@ -130,13 +102,13 @@ MalType EVAL(MalType ast, Env env) { if (symbol.value == "def!") { MalSymbol key = args.first; MalType value = EVAL(args[1], env); - env.set(key, value); + env.set(key.value, value); return value; } else if (symbol.value == "defmacro!") { MalSymbol key = args.first; - MalClosure macro = EVAL(args[1], env) as MalClosure; + MalClosure macro = (EVAL(args[1], env) as MalClosure).clone(); macro.isMacro = true; - env.set(key, macro); + env.set(key.value, macro); return macro; } else if (symbol.value == "let*") { // TODO(het): If elements.length is not even, give helpful error @@ -151,13 +123,15 @@ MalType EVAL(MalType ast, Env env) { for (var pair in pairs(bindings.elements)) { MalSymbol key = pair[0]; MalType value = EVAL(pair[1], newEnv); - newEnv.set(key, value); + newEnv.set(key.value, value); } ast = args[1]; env = newEnv; continue; } else if (symbol.value == "do") { - eval_ast(new MalList(args.sublist(0, args.length - 1)), env); + for (var elt in args.sublist(0, args.length - 1)) { + EVAL(elt, env); + } ast = args.last; continue; } else if (symbol.value == "if") { @@ -188,13 +162,9 @@ MalType EVAL(MalType ast, Env env) { EVAL(args[1], new Env(env, params, funcArgs))); } else if (symbol.value == "quote") { return args.single; - } else if (symbol.value == "quasiquoteexpand") { - return quasiquote(args.first); } else if (symbol.value == "quasiquote") { ast = quasiquote(args.first); continue; - } else if (symbol.value == 'macroexpand') { - return macroexpand(args.first, env); } else if (symbol.value == 'try*') { var body = args.first; if (args.length < 2) { @@ -222,9 +192,12 @@ MalType EVAL(MalType ast, Env env) { continue; } } - var newAst = eval_ast(ast, env) as MalList; - var f = newAst.elements.first; - var args = newAst.elements.sublist(1); + 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) { @@ -234,8 +207,6 @@ MalType EVAL(MalType ast, Env env) { } else { throw 'bad!'; } - } - } } } diff --git a/impls/elisp/mal/env.el b/impls/elisp/mal/env.el index f03902976c..94f6d3e717 100644 --- a/impls/elisp/mal/env.el +++ b/impls/elisp/mal/env.el @@ -16,19 +16,13 @@ (let ((data (aref (aref env 1) 0))) (puthash key value data))) -(defun mal-env-find (env key) +(defun mal-env-get (env key) (let* ((data (aref (aref env 1) 0)) (value (gethash key data))) - (if (not value) + (or 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))) + (if outer + (mal-env-get outer key) + nil))))) (provide 'mal/env) diff --git a/impls/elisp/step2_eval.el b/impls/elisp/step2_eval.el index a27cbd6c4d..6b76b75d7b 100644 --- a/impls/elisp/step2_eval.el +++ b/impls/elisp/step2_eval.el @@ -12,32 +12,30 @@ (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*))) + ;; (println "EVAL: %s\n" (PRINT ast)) + (cl-case (mal-type ast) + (list + (let ((a (mal-value ast))) + (if a + (let* ((fn (EVAL (car a) env)) + (args (mapcar (lambda (x) (EVAL x env)) (cdr a)))) (apply fn args)) - (eval-ast ast env))) - -(defun eval-ast (ast env) - (let ((value (mal-value ast))) - (cl-case (mal-type ast) + ast))) (symbol - (let ((definition (gethash value env))) + (let ((definition (gethash (mal-value ast) env))) (or definition (error "Definition not found")))) - (list - (mal-list (mapcar (lambda (item) (EVAL item env)) value))) (vector - (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) + (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) + (mal-value ast))))) (map - (let ((map (copy-hash-table value))) + (let ((map (copy-hash-table (mal-value ast)))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) (mal-map map))) (t ;; return as is - ast)))) + ast))) (defun PRINT (input) (pr-str input t)) diff --git a/impls/elisp/step3_env.el b/impls/elisp/step3_env.el index f05c178b21..a003e55144 100644 --- a/impls/elisp/step3_env.el +++ b/impls/elisp/step3_env.el @@ -13,20 +13,27 @@ (read-str input)) (defun EVAL (ast env) - (if (and (mal-list-p ast) (mal-value ast)) + (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) + (if (and dbgeval + (not (member (mal-type dbgeval) '(false nil)))) + (println "EVAL: %s\n" (PRINT ast)))) + + (cl-case (mal-type ast) + (list (let* ((a (mal-value ast)) (a1 (cadr a)) - (a1* (mal-value a1)) (a2 (nth 2 a))) + (if a (cl-case (mal-value (car a)) (def! - (let ((identifier a1*) + (let ((identifier (mal-value a1)) (value (EVAL a2 env))) (mal-env-set env identifier value))) (let* - (let ((env* (mal-env env)) - (bindings (if (vectorp a1*) (append a1* nil) a1*)) - (form a2)) + (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*))) @@ -34,31 +41,26 @@ (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 ((value (mal-value ast))) - (cl-case (mal-type ast) + (let ((fn (EVAL (car a) env)) + (args (mapcar (lambda (x) (EVAL x env)) (cdr a)))) + (apply fn args)))) + ast))) (symbol - (let ((definition (mal-env-get env value))) - (or definition (error "Definition not found")))) - (list - (mal-list (mapcar (lambda (item) (EVAL item env)) value))) + (let ((key (mal-value ast))) + (or (mal-env-get env key) + (error "'%s' not found" key)))) (vector - (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) + (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) + (mal-value ast))))) (map - (let ((map (copy-hash-table value))) + (let ((map (copy-hash-table (mal-value ast)))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) (mal-map map))) (t ;; return as is - ast)))) + ast))) (defun PRINT (input) (pr-str input t)) diff --git a/impls/elisp/step4_if_fn_do.el b/impls/elisp/step4_if_fn_do.el index f4f2142e3f..d0a9f96072 100644 --- a/impls/elisp/step4_if_fn_do.el +++ b/impls/elisp/step4_if_fn_do.el @@ -17,11 +17,18 @@ (read-str input)) (defun EVAL (ast env) - (if (and (mal-list-p ast) (mal-value ast)) + (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) + (if (and dbgeval + (not (member (mal-type dbgeval) '(false nil)))) + (println "EVAL: %s\n" (PRINT ast)))) + + (cl-case (mal-type ast) + (list (let* ((a (mal-value ast)) (a1 (cadr a)) (a2 (nth 2 a)) (a3 (nth 3 a))) + (if a (cl-case (mal-value (car a)) (def! (let ((identifier (mal-value a1)) @@ -37,7 +44,11 @@ (mal-env-set env* key value))) (EVAL form env*))) (do - (car (last (mal-value (eval-ast (mal-list (cdr a)) env))))) + (let* ((a0... (cdr a)) + (butlast (butlast a0...)) + (last (car (last a0...)))) + (mapcar (lambda (item) (EVAL item env)) butlast) + (EVAL last env))) (if (let* ((condition (EVAL a1 env)) (condition-type (mal-type condition)) @@ -58,31 +69,26 @@ (EVAL body env*)))))) (t ;; not a special form - (let* ((ast* (mal-value (eval-ast ast env))) - (fn* (mal-value (car ast*))) - (args (cdr ast*))) - (apply fn* args))))) - (eval-ast ast env))) - -(defun eval-ast (ast env) - (let ((value (mal-value ast))) - (cl-case (mal-type ast) + (let ((fn* (mal-value (EVAL (car a) env))) + (args (mapcar (lambda (x) (EVAL x env)) (cdr a)))) + (apply fn* args)))) + ast))) (symbol - (let ((definition (mal-env-get env value))) - (or definition (error "Definition not found")))) - (list - (mal-list (mapcar (lambda (item) (EVAL item env)) value))) + (let ((key (mal-value ast))) + (or (mal-env-get env key) + (error "'%s' not found" key)))) (vector - (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) + (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) + (mal-value ast))))) (map - (let ((map (copy-hash-table value))) + (let ((map (copy-hash-table (mal-value ast)))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) (mal-map map))) (t ;; return as is - ast)))) + ast))) (defun PRINT (input) (pr-str input t)) diff --git a/impls/elisp/step5_tco.el b/impls/elisp/step5_tco.el index 315cfa4605..2acffcff0d 100644 --- a/impls/elisp/step5_tco.el +++ b/impls/elisp/step5_tco.el @@ -21,11 +21,20 @@ (defun EVAL (ast env) (catch 'return (while t - (if (and (mal-list-p ast) (mal-value ast)) + + (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) + (if (and dbgeval + (not (member (mal-type dbgeval) '(false nil)))) + (println "EVAL: %s\n" (PRINT ast)))) + + (cl-case (mal-type ast) + + (list (let* ((a (mal-value ast)) (a1 (cadr a)) (a2 (nth 2 a)) (a3 (nth 3 a))) + (unless a (throw 'return ast)) (cl-case (mal-value (car a)) (def! (let ((identifier (mal-value a1)) @@ -45,8 +54,7 @@ (let* ((a0... (cdr a)) (butlast (butlast a0...)) (last (car (last a0...)))) - (when butlast - (eval-ast (mal-list butlast) env)) + (mapcar (lambda (item) (EVAL item env)) butlast) (setq ast last))) ; TCO (if (let* ((condition (EVAL a1 env)) @@ -69,38 +77,34 @@ (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*))) + (let ((fn (EVAL (car a) env)) + (args (mapcar (lambda (x) (EVAL x env)) (cdr a)))) (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 ((value (mal-value ast))) - (cl-case (mal-type ast) + (throw 'return (apply fn* args))))))))) (symbol - (let ((definition (mal-env-get env value))) - (or definition (error "Definition not found")))) - (list - (mal-list (mapcar (lambda (item) (EVAL item env)) value))) + (let ((key (mal-value ast))) + (throw 'return (or (mal-env-get env key) + (error "'%s' not found" key))))) (vector - (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) + (throw 'return + (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) + (mal-value ast)))))) (map - (let ((map (copy-hash-table value))) + (let ((map (copy-hash-table (mal-value ast)))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) - (mal-map map))) + (throw 'return (mal-map map)))) (t ;; return as is - ast)))) + (throw 'return ast)))))) (defun PRINT (input) (pr-str input t)) diff --git a/impls/elisp/step6_file.el b/impls/elisp/step6_file.el index 88d09d0e12..4c4ea269b8 100644 --- a/impls/elisp/step6_file.el +++ b/impls/elisp/step6_file.el @@ -20,11 +20,20 @@ (defun EVAL (ast env) (catch 'return (while t - (if (and (mal-list-p ast) (mal-value ast)) + + (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) + (if (and dbgeval + (not (member (mal-type dbgeval) '(false nil)))) + (println "EVAL: %s\n" (PRINT ast)))) + + (cl-case (mal-type ast) + + (list (let* ((a (mal-value ast)) (a1 (cadr a)) (a2 (nth 2 a)) (a3 (nth 3 a))) + (unless a (throw 'return ast)) (cl-case (mal-value (car a)) (def! (let ((identifier (mal-value a1)) @@ -44,8 +53,7 @@ (let* ((a0... (cdr a)) (butlast (butlast a0...)) (last (car (last a0...)))) - (when butlast - (eval-ast (mal-list butlast) env)) + (mapcar (lambda (item) (EVAL item env)) butlast) (setq ast last))) ; TCO (if (let* ((condition (EVAL a1 env)) @@ -68,9 +76,8 @@ (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*))) + (let ((fn (EVAL (car a) env)) + (args (mapcar (lambda (x) (EVAL x env)) (cdr a)))) (if (mal-func-p fn) (let ((env* (mal-env (mal-func-env fn) (mal-func-params fn) @@ -79,28 +86,24 @@ 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 ((value (mal-value ast))) - (cl-case (mal-type ast) + (throw 'return (apply fn* args))))))))) (symbol - (let ((definition (mal-env-get env value))) - (or definition (error "Definition not found")))) - (list - (mal-list (mapcar (lambda (item) (EVAL item env)) value))) + (let ((key (mal-value ast))) + (throw 'return (or (mal-env-get env key) + (error "'%s' not found" key))))) (vector - (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) + (throw 'return + (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) + (mal-value ast)))))) (map - (let ((map (copy-hash-table value))) + (let ((map (copy-hash-table (mal-value ast)))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) - (mal-map map))) + (throw 'return (mal-map map)))) (t ;; return as is - ast)))) + (throw 'return 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)))) diff --git a/impls/elisp/step7_quote.el b/impls/elisp/step7_quote.el index 726fbee90f..4ec792c137 100644 --- a/impls/elisp/step7_quote.el +++ b/impls/elisp/step7_quote.el @@ -46,11 +46,20 @@ (defun EVAL (ast env) (catch 'return (while t - (if (and (mal-list-p ast) (mal-value ast)) + + (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) + (if (and dbgeval + (not (member (mal-type dbgeval) '(false nil)))) + (println "EVAL: %s\n" (PRINT ast)))) + + (cl-case (mal-type ast) + + (list (let* ((a (mal-value ast)) (a1 (cadr a)) (a2 (nth 2 a)) (a3 (nth 3 a))) + (unless a (throw 'return ast)) (cl-case (mal-value (car a)) (def! (let ((identifier (mal-value a1)) @@ -68,16 +77,13 @@ ast form))) ; TCO (quote (throw 'return a1)) - (quasiquoteexpand - (throw 'return (quasiquote a1))) (quasiquote (setq ast (quasiquote a1))) ; TCO (do (let* ((a0... (cdr a)) (butlast (butlast a0...)) (last (car (last a0...)))) - (when butlast - (eval-ast (mal-list butlast) env)) + (mapcar (lambda (item) (EVAL item env)) butlast) (setq ast last))) ; TCO (if (let* ((condition (EVAL a1 env)) @@ -100,9 +106,8 @@ (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*))) + (let ((fn (EVAL (car a) env)) + (args (mapcar (lambda (x) (EVAL x env)) (cdr a)))) (if (mal-func-p fn) (let ((env* (mal-env (mal-func-env fn) (mal-func-params fn) @@ -111,28 +116,24 @@ 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 ((value (mal-value ast))) - (cl-case (mal-type ast) + (throw 'return (apply fn* args))))))))) (symbol - (let ((definition (mal-env-get env value))) - (or definition (error "Definition not found")))) - (list - (mal-list (mapcar (lambda (item) (EVAL item env)) value))) + (let ((key (mal-value ast))) + (throw 'return (or (mal-env-get env key) + (error "'%s' not found" key))))) (vector - (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) + (throw 'return + (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) + (mal-value ast)))))) (map - (let ((map (copy-hash-table value))) + (let ((map (copy-hash-table (mal-value ast)))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) - (mal-map map))) + (throw 'return (mal-map map)))) (t ;; return as is - ast)))) + (throw 'return 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)))) diff --git a/impls/elisp/step8_macros.el b/impls/elisp/step8_macros.el index 5462d87ca1..04c442dbcb 100644 --- a/impls/elisp/step8_macros.el +++ b/impls/elisp/step8_macros.el @@ -16,9 +16,11 @@ (mal-env-set repl-env symbol fn))) (defun starts-with-p (ast sym) - (let ((s (car (mal-value ast)))) - (and (mal-symbol-p s) - (eq (mal-value s) sym)))) + (let ((l (mal-value ast))) + (and l + (let ((s (car l))) + (and (mal-symbol-p s) + (eq (mal-value s) sym)))))) (defun qq-reducer (elt acc) (mal-list (if (and (mal-list-p elt) @@ -38,35 +40,26 @@ ((map symbol) (mal-list (list (mal-symbol 'quote) ast))) (t ast))) -(defun MACROEXPAND (ast env) - (let (a a0 macro) - (while (and (mal-list-p ast) - (setq a (mal-value ast)) - (setq a0 (car a)) - (mal-symbol-p a0) - (setq macro (mal-env-find env (mal-value a0))) - (mal-func-p macro) - (mal-func-macro-p macro)) - (setq ast (apply (mal-value (mal-func-fn macro)) (cdr a))))) - 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 ((dbgeval (mal-env-get env 'DEBUG-EVAL))) + (if (and dbgeval + (not (member (mal-type dbgeval) '(false nil)))) + (println "EVAL: %s\n" (PRINT ast)))) + + (cl-case (mal-type ast) + (list (let* ((a (mal-value ast)) (a1 (cadr a)) (a2 (nth 2 a)) (a3 (nth 3 a))) + (unless a (throw 'return ast)) (cl-case (mal-value (car a)) (def! (let ((identifier (mal-value a1)) @@ -84,22 +77,17 @@ ast form))) ; TCO (quote (throw 'return a1)) - (quasiquoteexpand - (throw 'return (quasiquote a1))) (quasiquote (setq ast (quasiquote a1))) ; TCO (defmacro! (let ((identifier (mal-value a1)) (value (mal-macro (EVAL a2 env)))) (throw 'return (mal-env-set env identifier value)))) - (macroexpand - (throw 'return (MACROEXPAND a1 env))) (do (let* ((a0... (cdr a)) (butlast (butlast a0...)) (last (car (last a0...)))) - (when butlast - (eval-ast (mal-list butlast) env)) + (mapcar (lambda (item) (EVAL item env)) butlast) (setq ast last))) ; TCO (if (let* ((condition (EVAL a1 env)) @@ -122,38 +110,37 @@ (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*))) + (let ((fn (EVAL (car a) env)) + (args (cdr a))) (if (mal-func-p fn) + (if (mal-func-macro-p fn) + (setq ast (apply (mal-value (mal-func-fn fn)) args)) ; TCO (let ((env* (mal-env (mal-func-env fn) (mal-func-params fn) - args))) + (mapcar (lambda (x) (EVAL x env)) args)))) (setq env env* - ast (mal-func-ast fn))) ; TCO + 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 ((value (mal-value ast))) - (cl-case (mal-type ast) + (throw 'return (apply fn* (mapcar (lambda (x) (EVAL x env)) + args)))))))))) (symbol - (let ((definition (mal-env-get env value))) - (or definition (error "Definition not found")))) - (list - (mal-list (mapcar (lambda (item) (EVAL item env)) value))) + (let ((key (mal-value ast))) + (throw 'return (or (mal-env-get env key) + (error "'%s' not found" key))))) (vector - (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) + (throw 'return + (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) + (mal-value ast)))))) (map - (let ((map (copy-hash-table value))) + (let ((map (copy-hash-table (mal-value ast)))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) - (mal-map map))) + (throw 'return (mal-map map)))) (t ;; return as is - ast)))) + (throw 'return 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)))) diff --git a/impls/elisp/step9_try.el b/impls/elisp/step9_try.el index 84fbc6038d..b381dd4070 100644 --- a/impls/elisp/step9_try.el +++ b/impls/elisp/step9_try.el @@ -16,9 +16,11 @@ (mal-env-set repl-env symbol fn))) (defun starts-with-p (ast sym) - (let ((s (car (mal-value ast)))) - (and (mal-symbol-p s) - (eq (mal-value s) sym)))) + (let ((l (mal-value ast))) + (and l + (let ((s (car l))) + (and (mal-symbol-p s) + (eq (mal-value s) sym)))))) (defun qq-reducer (elt acc) (mal-list (if (and (mal-list-p elt) @@ -38,35 +40,26 @@ ((map symbol) (mal-list (list (mal-symbol 'quote) ast))) (t ast))) -(defun MACROEXPAND (ast env) - (let (a a0 macro) - (while (and (mal-list-p ast) - (setq a (mal-value ast)) - (setq a0 (car a)) - (mal-symbol-p a0) - (setq macro (mal-env-find env (mal-value a0))) - (mal-func-p macro) - (mal-func-macro-p macro)) - (setq ast (apply (mal-value (mal-func-fn macro)) (cdr a))))) - 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 ((dbgeval (mal-env-get env 'DEBUG-EVAL))) + (if (and dbgeval + (not (member (mal-type dbgeval) '(false nil)))) + (println "EVAL: %s\n" (PRINT ast)))) + + (cl-case (mal-type ast) + (list (let* ((a (mal-value ast)) (a1 (cadr a)) (a2 (nth 2 a)) (a3 (nth 3 a))) + (unless a (throw 'return ast)) (cl-case (mal-value (car a)) (def! (let ((identifier (mal-value a1)) @@ -84,16 +77,12 @@ ast form))) ; TCO (quote (throw 'return a1)) - (quasiquoteexpand - (throw 'return (quasiquote a1))) (quasiquote (setq ast (quasiquote a1))) ; TCO (defmacro! (let ((identifier (mal-value a1)) (value (mal-macro (EVAL a2 env)))) (throw 'return (mal-env-set env identifier value)))) - (macroexpand - (throw 'return (MACROEXPAND a1 env))) (try* (condition-case err (throw 'return (EVAL a1 env)) @@ -114,8 +103,7 @@ (let* ((a0... (cdr a)) (butlast (butlast a0...)) (last (car (last a0...)))) - (when butlast - (eval-ast (mal-list butlast) env)) + (mapcar (lambda (item) (EVAL item env)) butlast) (setq ast last))) ; TCO (if (let* ((condition (EVAL a1 env)) @@ -138,38 +126,37 @@ (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*))) + (let ((fn (EVAL (car a) env)) + (args (cdr a))) (if (mal-func-p fn) + (if (mal-func-macro-p fn) + (setq ast (apply (mal-value (mal-func-fn fn)) args)) ; TCO (let ((env* (mal-env (mal-func-env fn) (mal-func-params fn) - args))) + (mapcar (lambda (x) (EVAL x env)) args)))) (setq env env* - ast (mal-func-ast fn))) ; TCO + 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 ((value (mal-value ast))) - (cl-case (mal-type ast) + (throw 'return (apply fn* (mapcar (lambda (x) (EVAL x env)) + args)))))))))) (symbol - (let ((definition (mal-env-get env value))) - (or definition (error "Definition not found")))) - (list - (mal-list (mapcar (lambda (item) (EVAL item env)) value))) + (let ((key (mal-value ast))) + (throw 'return (or (mal-env-get env key) + (error "'%s' not found" key))))) (vector - (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) + (throw 'return + (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) + (mal-value ast)))))) (map - (let ((map (copy-hash-table value))) + (let ((map (copy-hash-table (mal-value ast)))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) - (mal-map map))) + (throw 'return (mal-map map)))) (t ;; return as is - ast)))) + (throw 'return 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)))) diff --git a/impls/elisp/stepA_mal.el b/impls/elisp/stepA_mal.el index 34c53c683d..5ceb4d6dcd 100644 --- a/impls/elisp/stepA_mal.el +++ b/impls/elisp/stepA_mal.el @@ -16,9 +16,11 @@ (mal-env-set repl-env symbol fn))) (defun starts-with-p (ast sym) - (let ((s (car (mal-value ast)))) - (and (mal-symbol-p s) - (eq (mal-value s) sym)))) + (let ((l (mal-value ast))) + (and l + (let ((s (car l))) + (and (mal-symbol-p s) + (eq (mal-value s) sym)))))) (defun qq-reducer (elt acc) (mal-list (if (and (mal-list-p elt) @@ -38,35 +40,26 @@ ((map symbol) (mal-list (list (mal-symbol 'quote) ast))) (t ast))) -(defun MACROEXPAND (ast env) - (let (a a0 macro) - (while (and (mal-list-p ast) - (setq a (mal-value ast)) - (setq a0 (car a)) - (mal-symbol-p a0) - (setq macro (mal-env-find env (mal-value a0))) - (mal-func-p macro) - (mal-func-macro-p macro)) - (setq ast (apply (mal-value (mal-func-fn macro)) (cdr a))))) - 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 ((dbgeval (mal-env-get env 'DEBUG-EVAL))) + (if (and dbgeval + (not (member (mal-type dbgeval) '(false nil)))) + (println "EVAL: %s\n" (PRINT ast)))) + + (cl-case (mal-type ast) + (list (let* ((a (mal-value ast)) (a1 (cadr a)) (a2 (nth 2 a)) (a3 (nth 3 a))) + (unless a (throw 'return ast)) (cl-case (mal-value (car a)) (def! (let ((identifier (mal-value a1)) @@ -84,16 +77,12 @@ ast form))) ; TCO (quote (throw 'return a1)) - (quasiquoteexpand - (throw 'return (quasiquote a1))) (quasiquote (setq ast (quasiquote a1))) ; TCO (defmacro! (let ((identifier (mal-value a1)) (value (mal-macro (EVAL a2 env)))) (throw 'return (mal-env-set env identifier value)))) - (macroexpand - (throw 'return (MACROEXPAND a1 env))) (try* (condition-case err (throw 'return (EVAL a1 env)) @@ -114,8 +103,7 @@ (let* ((a0... (cdr a)) (butlast (butlast a0...)) (last (car (last a0...)))) - (when butlast - (eval-ast (mal-list butlast) env)) + (mapcar (lambda (item) (EVAL item env)) butlast) (setq ast last))) ; TCO (if (let* ((condition (EVAL a1 env)) @@ -138,38 +126,37 @@ (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*))) + (let ((fn (EVAL (car a) env)) + (args (cdr a))) (if (mal-func-p fn) + (if (mal-func-macro-p fn) + (setq ast (apply (mal-value (mal-func-fn fn)) args)) ; TCO (let ((env* (mal-env (mal-func-env fn) (mal-func-params fn) - args))) + (mapcar (lambda (x) (EVAL x env)) args)))) (setq env env* - ast (mal-func-ast fn))) ; TCO + 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 ((value (mal-value ast))) - (cl-case (mal-type ast) + (throw 'return (apply fn* (mapcar (lambda (x) (EVAL x env)) + args)))))))))) (symbol - (let ((definition (mal-env-get env value))) - (or definition (error "Definition not found")))) - (list - (mal-list (mapcar (lambda (item) (EVAL item env)) value))) + (let ((key (mal-value ast))) + (throw 'return (or (mal-env-get env key) + (error "'%s' not found" key))))) (vector - (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) + (throw 'return + (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) + (mal-value ast)))))) (map - (let ((map (copy-hash-table value))) + (let ((map (copy-hash-table (mal-value ast)))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) - (mal-map map))) + (throw 'return (mal-map map)))) (t ;; return as is - ast)))) + (throw 'return 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)))) diff --git a/impls/elixir/lib/mix/tasks/step2_eval.ex b/impls/elixir/lib/mix/tasks/step2_eval.ex index 8a1d68ac26..b4cb23a284 100644 --- a/impls/elixir/lib/mix/tasks/step2_eval.ex +++ b/impls/elixir/lib/mix/tasks/step2_eval.ex @@ -18,7 +18,7 @@ defmodule Mix.Tasks.Step2Eval 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 @@ -46,15 +46,19 @@ defmodule Mix.Tasks.Step2Eval 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(ast, env) do + # IO.puts("EVAL: #{Mal.Printer.print_str(ast)}") + eval_ast(ast, 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/impls/elixir/lib/mix/tasks/step3_env.ex b/impls/elixir/lib/mix/tasks/step3_env.ex index 1f13424176..786861f399 100644 --- a/impls/elixir/lib/mix/tasks/step3_env.ex +++ b/impls/elixir/lib/mix/tasks/step3_env.ex @@ -22,7 +22,7 @@ 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 @@ -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/impls/elixir/lib/mix/tasks/step4_if_fn_do.ex b/impls/elixir/lib/mix/tasks/step4_if_fn_do.ex index ece1f0b858..c0c5232b1a 100644 --- a/impls/elixir/lib/mix/tasks/step4_if_fn_do.ex +++ b/impls/elixir/lib/mix/tasks/step4_if_fn_do.ex @@ -31,7 +31,7 @@ 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 @@ -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/impls/elixir/lib/mix/tasks/step5_tco.ex b/impls/elixir/lib/mix/tasks/step5_tco.ex index eaf69d2554..8ad7d9be33 100644 --- a/impls/elixir/lib/mix/tasks/step5_tco.ex +++ b/impls/elixir/lib/mix/tasks/step5_tco.ex @@ -31,7 +31,7 @@ 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 @@ -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/impls/elixir/lib/mix/tasks/step6_file.ex b/impls/elixir/lib/mix/tasks/step6_file.ex index f0bdc5de59..0503ea32ac 100644 --- a/impls/elixir/lib/mix/tasks/step6_file.ex +++ b/impls/elixir/lib/mix/tasks/step6_file.ex @@ -54,7 +54,7 @@ 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 @@ -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 index bffad9e465..75a31abad8 100644 --- a/impls/elixir/lib/mix/tasks/step7_quote.ex +++ b/impls/elixir/lib/mix/tasks/step7_quote.ex @@ -54,7 +54,7 @@ defmodule Mix.Tasks.Step7Quote 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 @@ -105,9 +105,15 @@ defmodule Mix.Tasks.Step7Quote do 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({: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) @@ -124,8 +130,7 @@ defmodule Mix.Tasks.Step7Quote 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 @@ -156,20 +161,19 @@ defmodule Mix.Tasks.Step7Quote do defp eval_list([{:symbol, "quote"}, arg], _env, _), do: arg - defp eval_list([{:symbol, "quasiquoteexpand"}, ast], _, _) do - quasiquote(ast) - end - defp eval_list([{:symbol, "quasiquote"}, ast], env, _) do ast |> quasiquote |> eval(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) 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/step8_macros.ex b/impls/elixir/lib/mix/tasks/step8_macros.ex index 4152deb1bf..1cb777d71b 100644 --- a/impls/elixir/lib/mix/tasks/step8_macros.ex +++ b/impls/elixir/lib/mix/tasks/step8_macros.ex @@ -66,7 +66,7 @@ defmodule Mix.Tasks.Step8Macros 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 @@ -117,38 +117,15 @@ defmodule Mix.Tasks.Step8Macros do 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 macro_call?({:list, [{:symbol, key} | _tail], _}, env) do - case Mal.Env.get(env, key) do - {:ok, %Function{macro: true}} -> true - _ -> false + 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 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) @@ -165,8 +142,7 @@ defmodule Mix.Tasks.Step8Macros 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 @@ -203,20 +179,21 @@ defmodule Mix.Tasks.Step8Macros do defp eval_list([{:symbol, "quote"}, arg], _env, _), do: arg - defp eval_list([{:symbol, "quasiquoteexpand"}, ast], _, _) do - quasiquote(ast) - end - defp eval_list([{:symbol, "quasiquote"}, ast], env, _) do ast |> quasiquote |> eval(env) end - defp eval_list(ast, env, meta) do - {:list, [func | args], _} = eval_ast({:list, ast, meta}, env) - func.value.(args) + 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 diff --git a/impls/elixir/lib/mix/tasks/step9_try.ex b/impls/elixir/lib/mix/tasks/step9_try.ex index 366b06d8f1..d72d2b632d 100644 --- a/impls/elixir/lib/mix/tasks/step9_try.ex +++ b/impls/elixir/lib/mix/tasks/step9_try.ex @@ -66,7 +66,7 @@ defmodule Mix.Tasks.Step9Try 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 @@ -117,38 +117,15 @@ defmodule Mix.Tasks.Step9Try do 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 macro_call?({:list, [{:symbol, key} | _tail], _}, env) do - case Mal.Env.get(env, key) do - {:ok, %Function{macro: true}} -> true - _ -> false + 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 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) @@ -165,8 +142,7 @@ defmodule Mix.Tasks.Step9Try 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 @@ -203,10 +179,6 @@ defmodule Mix.Tasks.Step9Try do defp eval_list([{:symbol, "quote"}, arg], _env, _), do: arg - defp eval_list([{:symbol, "quasiquoteexpand"}, ast], _, _) do - quasiquote(ast) - end - defp eval_list([{:symbol, "quasiquote"}, ast], env, _) do ast |> quasiquote |> eval(env) @@ -223,11 +195,16 @@ defmodule Mix.Tasks.Step9Try 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) + 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 diff --git a/impls/elixir/lib/mix/tasks/stepA_mal.ex b/impls/elixir/lib/mix/tasks/stepA_mal.ex index 3df0e41899..f85cd2444a 100644 --- a/impls/elixir/lib/mix/tasks/stepA_mal.ex +++ b/impls/elixir/lib/mix/tasks/stepA_mal.ex @@ -75,7 +75,7 @@ defmodule Mix.Tasks.StepAMal 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 @@ -126,38 +126,15 @@ defmodule Mix.Tasks.StepAMal do 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 macro_call?({:list, [{:symbol, key} | _tail], _}, env) do - case Mal.Env.get(env, key) do - {:ok, %Function{macro: true}} -> true - _ -> false + 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 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) @@ -174,8 +151,7 @@ defmodule Mix.Tasks.StepAMal 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 @@ -212,10 +188,6 @@ defmodule Mix.Tasks.StepAMal do defp eval_list([{:symbol, "quote"}, arg], _env, _), do: arg - defp eval_list([{:symbol, "quasiquoteexpand"}, ast], _, _) do - quasiquote(ast) - end - defp eval_list([{:symbol, "quasiquote"}, ast], env, _) do ast |> quasiquote |> eval(env) @@ -232,11 +204,16 @@ defmodule Mix.Tasks.StepAMal 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) + 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 diff --git a/impls/erlang/src/step2_eval.erl b/impls/erlang/src/step2_eval.erl index 39dfd6942c..f51c925b2c 100644 --- a/impls/erlang/src/step2_eval.erl +++ b/impls/erlang/src/step2_eval.erl @@ -46,32 +46,22 @@ read(String) -> 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]); +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(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. +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 diff --git a/impls/erlang/src/step3_env.erl b/impls/erlang/src/step3_env.erl index 2abfbea88a..1a01fa85ec 100644 --- a/impls/erlang/src/step3_env.erl +++ b/impls/erlang/src/step3_env.erl @@ -32,34 +32,47 @@ read(Input) -> {error, Reason} -> error(Reason) end. -eval({list, [], _Meta}=AST, _Env) -> +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, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) -> +eval_list({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) -> +eval_list({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) -> error("def! called with non-symbol"); -eval({list, [{symbol, "def!"}|_], _Meta}, _Env) -> +eval_list({list, [{symbol, "def!"}|_], _Meta}, _Env) -> error("def! requires exactly two arguments"); -eval({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> +eval_list({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> NewEnv = env:new(Env), let_star(NewEnv, A1), eval(A2, NewEnv); -eval({list, [{symbol, "let*"}|_], _Meta}, _Env) -> +eval_list({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_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({Type, Seq, _Meta}, Env) when Type == list orelse Type == vector -> - {Type, lists:map(fun(Elem) -> eval(Elem, Env) end, Seq), nil}; +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) -> diff --git a/impls/erlang/src/step4_if_fn_do.erl b/impls/erlang/src/step4_if_fn_do.erl index df8e82d3b7..dc19319592 100644 --- a/impls/erlang/src/step4_if_fn_do.erl +++ b/impls/erlang/src/step4_if_fn_do.erl @@ -35,26 +35,37 @@ read(Input) -> {error, Reason} -> error(Reason) end. -eval({list, [], _Meta}=AST, _Env) -> +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, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) -> +eval_list({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) -> +eval_list({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) -> error("def! called with non-symbol"); -eval({list, [{symbol, "def!"}|_], _Meta}, _Env) -> +eval_list({list, [{symbol, "def!"}|_], _Meta}, _Env) -> error("def! requires exactly two arguments"); -eval({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> +eval_list({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> NewEnv = env:new(Env), let_star(NewEnv, A1), eval(A2, NewEnv); -eval({list, [{symbol, "let*"}|_], _Meta}, _Env) -> +eval_list({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) -> +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 @@ -64,32 +75,35 @@ eval({list, [{symbol, "if"}, Test, Consequent|Alternate], _Meta}, Env) -> end; _ -> eval(Consequent, Env) end; -eval({list, [{symbol, "if"}|_], _Meta}, _Env) -> +eval_list({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) -> +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, [{symbol, "fn*"}|_], _Meta}, _Env) -> +eval_list({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} -> +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); - {list, [{function, F, _MF}|A], _M4} -> erlang:apply(F, [A]); - _ -> error("expected a list") - end; -eval(Value, Env) -> - eval_ast(Value, Env). + {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({Type, Seq, _Meta}, Env) when Type == list orelse Type == vector -> - {Type, lists:map(fun(Elem) -> eval(Elem, Env) end, Seq), nil}; +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) -> diff --git a/impls/erlang/src/step5_tco.erl b/impls/erlang/src/step5_tco.erl index 933d7450e6..462628880d 100644 --- a/impls/erlang/src/step5_tco.erl +++ b/impls/erlang/src/step5_tco.erl @@ -35,26 +35,37 @@ read(Input) -> {error, Reason} -> error(Reason) end. -eval({list, [], _Meta}=AST, _Env) -> +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, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) -> +eval_list({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) -> +eval_list({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) -> error("def! called with non-symbol"); -eval({list, [{symbol, "def!"}|_], _Meta}, _Env) -> +eval_list({list, [{symbol, "def!"}|_], _Meta}, _Env) -> error("def! requires exactly two arguments"); -eval({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> +eval_list({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> NewEnv = env:new(Env), let_star(NewEnv, A1), eval(A2, NewEnv); -eval({list, [{symbol, "let*"}|_], _Meta}, _Env) -> +eval_list({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_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, [{symbol, "if"}, Test, Consequent|Alternate], _Meta}, 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 @@ -64,32 +75,35 @@ eval({list, [{symbol, "if"}, Test, Consequent|Alternate], _Meta}, Env) -> end; _ -> eval(Consequent, Env) end; -eval({list, [{symbol, "if"}|_], _Meta}, _Env) -> +eval_list({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) -> +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, [{symbol, "fn*"}|_], _Meta}, _Env) -> +eval_list({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} -> +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); - {list, [{function, F, _MF}|A], _M4} -> erlang:apply(F, [A]); - _ -> error("expected a list") - end; -eval(Value, Env) -> - eval_ast(Value, Env). + {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({Type, Seq, _Meta}, Env) when Type == list orelse Type == vector -> - {Type, lists:map(fun(Elem) -> eval(Elem, Env) end, Seq), nil}; +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) -> diff --git a/impls/erlang/src/step6_file.erl b/impls/erlang/src/step6_file.erl index 0a37f26c69..94bc24c328 100644 --- a/impls/erlang/src/step6_file.erl +++ b/impls/erlang/src/step6_file.erl @@ -45,26 +45,37 @@ read(Input) -> {error, Reason} -> error(Reason) end. -eval({list, [], _Meta}=AST, _Env) -> +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, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) -> +eval_list({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) -> +eval_list({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) -> error("def! called with non-symbol"); -eval({list, [{symbol, "def!"}|_], _Meta}, _Env) -> +eval_list({list, [{symbol, "def!"}|_], _Meta}, _Env) -> error("def! requires exactly two arguments"); -eval({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> +eval_list({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> NewEnv = env:new(Env), let_star(NewEnv, A1), eval(A2, NewEnv); -eval({list, [{symbol, "let*"}|_], _Meta}, _Env) -> +eval_list({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_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, [{symbol, "if"}, Test, Consequent|Alternate], _Meta}, 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 @@ -74,39 +85,41 @@ eval({list, [{symbol, "if"}, Test, Consequent|Alternate], _Meta}, Env) -> end; _ -> eval(Consequent, Env) end; -eval({list, [{symbol, "if"}|_], _Meta}, _Env) -> +eval_list({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) -> +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, [{symbol, "fn*"}|_], _Meta}, _Env) -> +eval_list({list, [{symbol, "fn*"}|_], _Meta}, _Env) -> error("fn* requires 2 arguments"); -eval({list, [{symbol, "eval"}, AST], _Meta}, Env) -> +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, [{symbol, "eval"}|_], _Meta}, _Env) -> +eval_list({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} -> +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); - {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). + {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({Type, Seq, _Meta}, Env) when Type == list orelse Type == vector -> - {Type, lists:map(fun(Elem) -> eval(Elem, Env) end, Seq), nil}; +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) -> diff --git a/impls/erlang/src/step7_quote.erl b/impls/erlang/src/step7_quote.erl index 8588afbd0d..82664c33b8 100644 --- a/impls/erlang/src/step7_quote.erl +++ b/impls/erlang/src/step7_quote.erl @@ -45,26 +45,37 @@ read(Input) -> {error, Reason} -> error(Reason) end. -eval({list, [], _Meta}=AST, _Env) -> +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, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) -> +eval_list({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) -> +eval_list({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) -> error("def! called with non-symbol"); -eval({list, [{symbol, "def!"}|_], _Meta}, _Env) -> +eval_list({list, [{symbol, "def!"}|_], _Meta}, _Env) -> error("def! requires exactly two arguments"); -eval({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> +eval_list({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> NewEnv = env:new(Env), let_star(NewEnv, A1), eval(A2, NewEnv); -eval({list, [{symbol, "let*"}|_], _Meta}, _Env) -> +eval_list({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_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, [{symbol, "if"}, Test, Consequent|Alternate], _Meta}, 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 @@ -74,51 +85,49 @@ eval({list, [{symbol, "if"}, Test, Consequent|Alternate], _Meta}, Env) -> end; _ -> eval(Consequent, Env) end; -eval({list, [{symbol, "if"}|_], _Meta}, _Env) -> +eval_list({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) -> +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, [{symbol, "fn*"}|_], _Meta}, _Env) -> +eval_list({list, [{symbol, "fn*"}|_], _Meta}, _Env) -> error("fn* requires 2 arguments"); -eval({list, [{symbol, "eval"}, AST], _Meta}, Env) -> +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, [{symbol, "eval"}|_], _Meta}, _Env) -> +eval_list({list, [{symbol, "eval"}|_], _Meta}, _Env) -> error("eval requires 1 argument"); -eval({list, [{symbol, "quote"}, AST], _Meta}, _Env) -> +eval_list({list, [{symbol, "quote"}, AST], _Meta}, _Env) -> AST; -eval({list, [{symbol, "quote"}|_], _Meta}, _Env) -> +eval_list({list, [{symbol, "quote"}|_], _Meta}, _Env) -> error("quote requires 1 argument"); -eval({list, [{symbol, "quasiquoteexpand"}, AST], _Meta}, Env) -> - quasiquote(AST); -eval({list, [{symbol, "quasiquoteexpand"}|_], _Meta}, _Env) -> - error("quasiquoteexpand requires 1 argument"); -eval({list, [{symbol, "quasiquote"}, AST], _Meta}, Env) -> +eval_list({list, [{symbol, "quasiquote"}, AST], _Meta}, Env) -> eval(quasiquote(AST), Env); -eval({list, [{symbol, "quasiquote"}|_], _Meta}, _Env) -> +eval_list({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} -> +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); - {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). + {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({Type, Seq, _Meta}, Env) when Type == list orelse Type == vector -> - {Type, lists:map(fun(Elem) -> eval(Elem, Env) end, Seq), nil}; +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) -> diff --git a/impls/erlang/src/step8_macros.erl b/impls/erlang/src/step8_macros.erl index 1e024f73c3..e940442b9f 100644 --- a/impls/erlang/src/step8_macros.erl +++ b/impls/erlang/src/step8_macros.erl @@ -46,14 +46,15 @@ read(Input) -> 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. + 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; @@ -76,7 +77,7 @@ eval_list({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> 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), + 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 @@ -106,10 +107,6 @@ 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, "quasiquoteexpand"}, AST], _Meta}, Env) -> - quasiquote(AST); -eval_list({list, [{symbol, "quasiquoteexpand"}|_], _Meta}, _Env) -> - error("quasiquoteexpand requires 1 argument"); eval_list({list, [{symbol, "quasiquote"}, AST], _Meta}, Env) -> eval(quasiquote(AST), Env); eval_list({list, [{symbol, "quasiquote"}|_], _Meta}, _Env) -> @@ -127,27 +124,32 @@ 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} -> +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); - {list, [{function, F, _MF}|A], _M2} -> erlang:apply(F, [A]); - {list, [{error, Reason}], _M3} -> {error, Reason}; - _ -> error("expected a list") + {function, F, _MF} -> + A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), + erlang:apply(F, [A]); + {macro, 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({Type, Seq, _Meta}, Env) when Type == list orelse Type == vector -> - {Type, lists:map(fun(Elem) -> eval(Elem, Env) end, Seq), nil}; +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) -> @@ -206,27 +208,3 @@ quasiquote({map, _Map, _Meta} = Arg) -> {list, [{symbol, "quote"}, Arg], nil}; quasiquote(Arg) -> Arg. - -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/impls/erlang/src/step9_try.erl b/impls/erlang/src/step9_try.erl index 7bf67834f0..d053eccbf3 100644 --- a/impls/erlang/src/step9_try.erl +++ b/impls/erlang/src/step9_try.erl @@ -47,14 +47,15 @@ read(Input) -> 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. + 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; @@ -77,7 +78,7 @@ eval_list({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> 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), + 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 @@ -107,10 +108,6 @@ 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, "quasiquoteexpand"}, AST], _Meta}, Env) -> - quasiquote(AST); -eval_list({list, [{symbol, "quasiquoteexpand"}|_], _Meta}, _Env) -> - error("quasiquoteexpand requires 1 argument"); eval_list({list, [{symbol, "quasiquote"}, AST], _Meta}, Env) -> eval(quasiquote(AST), Env); eval_list({list, [{symbol, "quasiquote"}|_], _Meta}, _Env) -> @@ -128,10 +125,6 @@ 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 @@ -149,23 +142,32 @@ 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, List, Meta}, Env) -> - case eval_ast({list, List, Meta}, Env) of - {list, [{closure, _Eval, Binds, Body, CE, _MC}|A], _M1} -> +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); - {list, [{function, F, _MF}|A], _M2} -> erlang:apply(F, [A]); - {list, [{error, Reason}], _M3} -> {error, Reason}; - _ -> error("expected a list") + {function, F, _MF} -> + A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), + erlang:apply(F, [A]); + {macro, 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({Type, Seq, _Meta}, Env) when Type == list orelse Type == vector -> - {Type, lists:map(fun(Elem) -> eval(Elem, Env) end, Seq), nil}; +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) -> @@ -224,27 +226,3 @@ quasiquote({map, _Map, _Meta} = Arg) -> {list, [{symbol, "quote"}, Arg], nil}; quasiquote(Arg) -> Arg. - -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/impls/erlang/src/stepA_mal.erl b/impls/erlang/src/stepA_mal.erl index 4a32120ccb..ffc39d3526 100644 --- a/impls/erlang/src/stepA_mal.erl +++ b/impls/erlang/src/stepA_mal.erl @@ -49,14 +49,15 @@ read(Input) -> 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. + 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; @@ -79,7 +80,7 @@ eval_list({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> 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), + 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 @@ -109,10 +110,6 @@ 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, "quasiquoteexpand"}, AST], _Meta}, Env) -> - quasiquote(AST); -eval_list({list, [{symbol, "quasiquoteexpand"}|_], _Meta}, _Env) -> - error("quasiquoteexpand requires 1 argument"); eval_list({list, [{symbol, "quasiquote"}, AST], _Meta}, Env) -> eval(quasiquote(AST), Env); eval_list({list, [{symbol, "quasiquote"}|_], _Meta}, _Env) -> @@ -130,10 +127,6 @@ 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 @@ -151,23 +144,32 @@ 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, List, Meta}, Env) -> - case eval_ast({list, List, Meta}, Env) of - {list, [{closure, _Eval, Binds, Body, CE, _MC}|A], _M2} -> +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); - {list, [{function, F, _MF}|A], _M3} -> erlang:apply(F, [A]); - {list, [{error, Reason}], _M4} -> {error, Reason}; - _ -> error("expected a list") + {function, F, _MF} -> + A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), + erlang:apply(F, [A]); + {macro, 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({Type, Seq, _Meta}, Env) when Type == list orelse Type == vector -> - {Type, lists:map(fun(Elem) -> eval(Elem, Env) end, Seq), nil}; +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) -> @@ -226,27 +228,3 @@ quasiquote({map, _Map, _Meta} = Arg) -> {list, [{symbol, "quote"}, Arg], nil}; quasiquote(Arg) -> Arg. - -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/impls/es6/step2_eval.mjs b/impls/es6/step2_eval.mjs index e4a7977e5a..110664cb7e 100644 --- a/impls/es6/step2_eval.mjs +++ b/impls/es6/step2_eval.mjs @@ -1,6 +1,6 @@ import rl from './node_readline.js' const readline = rl.readline -import { _list_Q } from './types' +import { _list_Q, Vector } from './types' import { BlankException, read_str } from './reader' import { pr_str } from './printer' @@ -8,29 +8,28 @@ import { pr_str } from './printer' const READ = str => read_str(str) // eval -const eval_ast = (ast, env) => { +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 Array) { + } 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 { + } else if (!_list_Q(ast)) { 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) + const [f, ...args] =ast.map(x => EVAL(x, env)) return f(...args) } diff --git a/impls/es6/step3_env.mjs b/impls/es6/step3_env.mjs index 9faa93d6d1..d9810b9dcc 100644 --- a/impls/es6/step3_env.mjs +++ b/impls/es6/step3_env.mjs @@ -1,6 +1,6 @@ import rl from './node_readline.js' const readline = rl.readline -import { _list_Q } from './types' +import { _list_Q, Vector } from './types' import { BlankException, read_str } from './reader' import { pr_str } from './printer' import { new_env, env_set, env_get } from './env' @@ -9,23 +9,28 @@ import { new_env, env_set, env_get } from './env' const READ = str => read_str(str) // eval -const eval_ast = (ast, env) => { +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 Array) { + } 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 { + } else if (!_list_Q(ast)) { 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 @@ -39,7 +44,7 @@ const EVAL = (ast, env) => { } return EVAL(a2, let_env) default: - let [f, ...args] = eval_ast(ast, env) + const [f, ...args] = ast.map(x => EVAL(x, env)) return f(...args) } } diff --git a/impls/es6/step4_if_fn_do.mjs b/impls/es6/step4_if_fn_do.mjs index 5e64a93273..6ade0502ae 100644 --- a/impls/es6/step4_if_fn_do.mjs +++ b/impls/es6/step4_if_fn_do.mjs @@ -1,6 +1,6 @@ import rl from './node_readline.js' const readline = rl.readline -import { _list_Q } from './types' +import { _list_Q, Vector } from './types' import { BlankException, read_str } from './reader' import { pr_str } from './printer' import { new_env, env_set, env_get } from './env' @@ -10,23 +10,28 @@ import { core_ns } from './core' const READ = str => read_str(str) // eval -const eval_ast = (ast, env) => { +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 Array) { + } 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 { + } else if (!_list_Q(ast)) { 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 @@ -40,7 +45,7 @@ const EVAL = (ast, env) => { } return EVAL(a2, let_env) case 'do': - return eval_ast(ast.slice(1), env)[ast.length-2] + return ast.slice(1).map(x => EVAL(x, env))[ast.length-2] case 'if': let cond = EVAL(a1, env) if (cond === null || cond === false) { @@ -51,7 +56,7 @@ const EVAL = (ast, env) => { case 'fn*': return (...args) => EVAL(a2, new_env(env, a1, args)) default: - let [f, ...args] = eval_ast(ast, env) + const [f, ...args] = ast.map(x => EVAL(x, env)) return f(...args) } } diff --git a/impls/es6/step5_tco.mjs b/impls/es6/step5_tco.mjs index cf78e77f37..0f3d2c08a6 100644 --- a/impls/es6/step5_tco.mjs +++ b/impls/es6/step5_tco.mjs @@ -1,6 +1,6 @@ import rl from './node_readline.js' const readline = rl.readline -import { _list_Q, _malfunc, _malfunc_Q } from './types' +import { _list_Q, _malfunc, _malfunc_Q, Vector } from './types' import { BlankException, read_str } from './reader' import { pr_str } from './printer' import { new_env, env_set, env_get } from './env' @@ -10,24 +10,29 @@ import { core_ns } from './core' const READ = str => read_str(str) // eval -const eval_ast = (ast, env) => { +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 Array) { + } 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 { + } else if (!_list_Q(ast)) { 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 @@ -43,7 +48,7 @@ const EVAL = (ast, env) => { ast = a2 break // continue TCO loop case 'do': - eval_ast(ast.slice(1,-1), env) + ast.slice(1, -1).map(x => EVAL(x, env)) ast = ast[ast.length-1] break // continue TCO loop case 'if': @@ -58,7 +63,7 @@ const EVAL = (ast, env) => { return _malfunc((...args) => EVAL(a2, new_env(env, a1, args)), a2, env, a1) default: - let [f, ...args] = eval_ast(ast, env) + const [f, ...args] = ast.map(x => EVAL(x, env)) if (_malfunc_Q(f)) { env = new_env(f.env, f.params, args) ast = f.ast diff --git a/impls/es6/step6_file.mjs b/impls/es6/step6_file.mjs index 0ae7da764e..b8fd26ec26 100644 --- a/impls/es6/step6_file.mjs +++ b/impls/es6/step6_file.mjs @@ -1,6 +1,6 @@ import rl from './node_readline.js' const readline = rl.readline -import { _list_Q, _malfunc, _malfunc_Q } from './types' +import { _list_Q, _malfunc, _malfunc_Q, Vector } from './types' import { BlankException, read_str } from './reader' import { pr_str } from './printer' import { new_env, env_set, env_get } from './env' @@ -10,24 +10,29 @@ import { core_ns } from './core' const READ = str => read_str(str) // eval -const eval_ast = (ast, env) => { +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 Array) { + } 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 { + } else if (!_list_Q(ast)) { 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 @@ -43,7 +48,7 @@ const EVAL = (ast, env) => { ast = a2 break // continue TCO loop case 'do': - eval_ast(ast.slice(1,-1), env) + ast.slice(1, -1).map(x => EVAL(x, env)) ast = ast[ast.length-1] break // continue TCO loop case 'if': @@ -58,7 +63,7 @@ const EVAL = (ast, env) => { return _malfunc((...args) => EVAL(a2, new_env(env, a1, args)), a2, env, a1) default: - let [f, ...args] = eval_ast(ast, env) + const [f, ...args] = ast.map(x => EVAL(x, env)) if (_malfunc_Q(f)) { env = new_env(f.env, f.params, args) ast = f.ast diff --git a/impls/es6/step7_quote.mjs b/impls/es6/step7_quote.mjs index 9a7e9c1d8f..349cdd516c 100644 --- a/impls/es6/step7_quote.mjs +++ b/impls/es6/step7_quote.mjs @@ -33,24 +33,30 @@ const quasiquote = ast => { return ast } } -const eval_ast = (ast, env) => { + +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 Array) { + } 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 { + } else if (!_list_Q(ast)) { 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 @@ -67,13 +73,11 @@ const EVAL = (ast, env) => { break // continue TCO loop case 'quote': return a1 - case 'quasiquoteexpand': - return quasiquote(a1) case 'quasiquote': ast = quasiquote(a1) break // continue TCO loop case 'do': - eval_ast(ast.slice(1,-1), env) + ast.slice(1, -1).map(x => EVAL(x, env)) ast = ast[ast.length-1] break // continue TCO loop case 'if': @@ -88,7 +92,7 @@ const EVAL = (ast, env) => { return _malfunc((...args) => EVAL(a2, new_env(env, a1, args)), a2, env, a1) default: - let [f, ...args] = eval_ast(ast, env) + const [f, ...args] = ast.map(x => EVAL(x, env)) if (_malfunc_Q(f)) { env = new_env(f.env, f.params, args) ast = f.ast diff --git a/impls/es6/step8_macros.mjs b/impls/es6/step8_macros.mjs index 2b22eb96a4..e60a2d6f44 100644 --- a/impls/es6/step8_macros.mjs +++ b/impls/es6/step8_macros.mjs @@ -34,37 +34,29 @@ const quasiquote = ast => { } } -function macroexpand(ast, env) { - while (_list_Q(ast) && typeof ast[0] === 'symbol' && ast[0] in env) { - let f = env_get(env, ast[0]) - if (!f.ismacro) { break } - ast = f(...ast.slice(1)) - } - 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)) + } + } -const eval_ast = (ast, env) => { if (typeof ast === 'symbol') { return env_get(env, ast) - } else if (ast instanceof Array) { + } 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 { + } else if (!_list_Q(ast)) { 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 @@ -81,8 +73,6 @@ const EVAL = (ast, env) => { break // continue TCO loop case 'quote': return a1 - case 'quasiquoteexpand': - return quasiquote(a1) case 'quasiquote': ast = quasiquote(a1) break // continue TCO loop @@ -90,10 +80,8 @@ const EVAL = (ast, env) => { let func = _clone(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.slice(1, -1).map(x => EVAL(x, env)) ast = ast[ast.length-1] break // continue TCO loop case 'if': @@ -108,7 +96,12 @@ const EVAL = (ast, env) => { return _malfunc((...args) => EVAL(a2, new_env(env, a1, args)), a2, env, a1) default: - let [f, ...args] = eval_ast(ast, env) + 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 diff --git a/impls/es6/step9_try.mjs b/impls/es6/step9_try.mjs index ad35ac2bce..c58ca89754 100644 --- a/impls/es6/step9_try.mjs +++ b/impls/es6/step9_try.mjs @@ -34,37 +34,29 @@ const quasiquote = ast => { } } -function macroexpand(ast, env) { - while (_list_Q(ast) && typeof ast[0] === 'symbol' && ast[0] in env) { - let f = env_get(env, ast[0]) - if (!f.ismacro) { break } - ast = f(...ast.slice(1)) - } - 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)) + } + } -const eval_ast = (ast, env) => { if (typeof ast === 'symbol') { return env_get(env, ast) - } else if (ast instanceof Array) { + } 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 { + } else if (!_list_Q(ast)) { 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 @@ -81,8 +73,6 @@ const EVAL = (ast, env) => { break // continue TCO loop case 'quote': return a1 - case 'quasiquoteexpand': - return quasiquote(a1) case 'quasiquote': ast = quasiquote(a1) break // continue TCO loop @@ -90,8 +80,6 @@ const EVAL = (ast, env) => { let func = _clone(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) @@ -104,7 +92,7 @@ const EVAL = (ast, env) => { } } case 'do': - eval_ast(ast.slice(1,-1), env) + ast.slice(1, -1).map(x => EVAL(x, env)) ast = ast[ast.length-1] break // continue TCO loop case 'if': @@ -119,7 +107,12 @@ const EVAL = (ast, env) => { return _malfunc((...args) => EVAL(a2, new_env(env, a1, args)), a2, env, a1) default: - let [f, ...args] = eval_ast(ast, env) + 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 diff --git a/impls/es6/stepA_mal.mjs b/impls/es6/stepA_mal.mjs index 80261fbdc5..f6dacc3d68 100644 --- a/impls/es6/stepA_mal.mjs +++ b/impls/es6/stepA_mal.mjs @@ -34,37 +34,29 @@ const quasiquote = ast => { } } -function macroexpand(ast, env) { - while (_list_Q(ast) && typeof ast[0] === 'symbol' && ast[0] in env) { - let f = env_get(env, ast[0]) - if (!f.ismacro) { break } - ast = f(...ast.slice(1)) - } - 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)) + } + } -const eval_ast = (ast, env) => { if (typeof ast === 'symbol') { return env_get(env, ast) - } else if (ast instanceof Array) { + } 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 { + } else if (!_list_Q(ast)) { 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 @@ -81,8 +73,6 @@ const EVAL = (ast, env) => { break // continue TCO loop case 'quote': return a1 - case 'quasiquoteexpand': - return quasiquote(a1) case 'quasiquote': ast = quasiquote(a1) break // continue TCO loop @@ -90,8 +80,6 @@ const EVAL = (ast, env) => { let func = _clone(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) @@ -104,7 +92,7 @@ const EVAL = (ast, env) => { } } case 'do': - eval_ast(ast.slice(1,-1), env) + ast.slice(1, -1).map(x => EVAL(x, env)) ast = ast[ast.length-1] break // continue TCO loop case 'if': @@ -119,7 +107,12 @@ const EVAL = (ast, env) => { return _malfunc((...args) => EVAL(a2, new_env(env, a1, args)), a2, env, a1) default: - let [f, ...args] = eval_ast(ast, env) + 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 diff --git a/impls/factor/step2_eval/step2_eval.factor b/impls/factor/step2_eval/step2_eval.factor index 8b73333126..d883752438 100755 --- a/impls/factor/step2_eval/step2_eval.factor +++ b/impls/factor/step2_eval/step2_eval.factor @@ -1,8 +1,8 @@ ! 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 ; +continuations fry hashtables io kernel math lib.printer lib.reader lib.types +quotations readline sequences vectors ; IN: step2_eval CONSTANT: repl-env H{ @@ -14,21 +14,26 @@ CONSTANT: repl-env H{ DEFER: EVAL -GENERIC# eval-ast 1 ( ast env -- ast ) -M: malsymbol eval-ast - [ name>> ] dip ?at [ "no variable " prepend throw ] unless ; -M: sequence eval-ast '[ _ EVAL ] map ; -M: assoc eval-ast '[ _ EVAL ] assoc-map ; -M: object eval-ast drop ; - : 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-ast dup { [ array? ] [ empty? not ] } 1&& [ - unclip - dup quotation? [ "not a fn" throw ] unless - with-datastack first - ] when ; + ! "EVAL: " pick pr-str append print flush + EVAL-switch ; : PRINT ( maltype -- str ) pr-str ; diff --git a/impls/factor/step3_env/step3_env.factor b/impls/factor/step3_env/step3_env.factor index 742c3f59f2..13f177319c 100755 --- a/impls/factor/step3_env/step3_env.factor +++ b/impls/factor/step3_env/step3_env.factor @@ -1,8 +1,8 @@ ! 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 ; +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{ @@ -16,12 +16,6 @@ SYMBOL: repl-env DEFER: EVAL -GENERIC# eval-ast 1 ( ast env -- ast ) -M: malsymbol eval-ast env-get ; -M: sequence eval-ast '[ _ EVAL ] map ; -M: assoc eval-ast '[ _ EVAL ] assoc-map ; -M: object eval-ast drop ; - :: eval-def! ( key value env -- maltype ) value env EVAL [ key env env-set ] keep ; @@ -32,22 +26,33 @@ M: object eval-ast drop ; : 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 - ] +: 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 - ] [ - env 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 ; : PRINT ( maltype -- str ) pr-str ; 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 index 37076e98f2..2c4a444fbb 100755 --- a/impls/factor/step4_if_fn_do/step4_if_fn_do.factor +++ b/impls/factor/step4_if_fn_do/step4_if_fn_do.factor @@ -3,19 +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: step4_if_fn_do SYMBOL: repl-env DEFER: EVAL -GENERIC# eval-ast 1 ( ast env -- ast ) -M: malsymbol eval-ast env-get ; -M: sequence eval-ast '[ _ EVAL ] map ; -M: assoc eval-ast '[ _ EVAL ] assoc-map ; -M: object eval-ast drop ; - :: eval-def! ( key value env -- maltype ) value env EVAL [ key env env-set ] keep ; @@ -52,19 +46,31 @@ 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 ] +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 - ] [ - env 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 ; : PRINT ( maltype -- str ) pr-str ; diff --git a/impls/factor/step5_tco/step5_tco.factor b/impls/factor/step5_tco/step5_tco.factor index aff1b9cf37..91598b667e 100755 --- a/impls/factor/step5_tco/step5_tco.factor +++ b/impls/factor/step5_tco/step5_tco.factor @@ -3,19 +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 -GENERIC# eval-ast 1 ( ast env -- ast ) -M: malsymbol eval-ast env-get ; -M: sequence eval-ast '[ _ EVAL ] map ; -M: assoc eval-ast '[ _ EVAL ] assoc-map ; -M: object eval-ast drop ; - :: eval-def! ( key value env -- maltype ) value env EVAL [ key env env-set ] keep ; @@ -28,7 +22,7 @@ M: object eval-ast drop ; 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 ) @@ -59,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* ] } @@ -68,10 +63,21 @@ 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 ; diff --git a/impls/factor/step6_file/step6_file.factor b/impls/factor/step6_file/step6_file.factor index 290ee83333..8bcb8af6d3 100755 --- a/impls/factor/step6_file/step6_file.factor +++ b/impls/factor/step6_file/step6_file.factor @@ -3,19 +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 -GENERIC# eval-ast 1 ( ast env -- ast ) -M: malsymbol eval-ast env-get ; -M: sequence eval-ast '[ _ EVAL ] map ; -M: assoc eval-ast '[ _ EVAL ] assoc-map ; -M: object eval-ast drop ; - :: eval-def! ( key value env -- maltype ) value env EVAL [ key env env-set ] keep ; @@ -28,7 +22,7 @@ M: object eval-ast drop ; 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 ) @@ -59,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* ] } @@ -69,9 +64,20 @@ 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 diff --git a/impls/factor/step7_quote/step7_quote.factor b/impls/factor/step7_quote/step7_quote.factor index eae1cc5de1..2f530255ff 100755 --- a/impls/factor/step7_quote/step7_quote.factor +++ b/impls/factor/step7_quote/step7_quote.factor @@ -11,12 +11,6 @@ SYMBOL: repl-env DEFER: EVAL -GENERIC# eval-ast 1 ( ast env -- ast ) -M: malsymbol eval-ast env-get ; -M: sequence eval-ast '[ _ EVAL ] map ; -M: assoc eval-ast '[ _ EVAL ] assoc-map ; -M: object eval-ast drop ; - :: eval-def! ( key value env -- maltype ) value env EVAL [ key env env-set ] keep ; @@ -29,7 +23,7 @@ M: object eval-ast drop ; 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 ) @@ -49,7 +43,7 @@ M: object eval-ast drop ; swapd [ over length cut [ zip ] dip ] dip [ swap 2array suffix ] [ drop ] if* >hashtable ; -GENERIC# apply 0 ( args fn -- maltype newenv/f ) +GENERIC: apply ( args fn -- maltype newenv/f ) M: malfn apply [ exprs>> nip ] @@ -86,13 +80,14 @@ M: array quasiquote [ second ] [ qq_foldr ] if ; M: vector quasiquote qq_foldr "vec" swap 2array ; M: malsymbol quasiquote "quote" swap 2array ; -M: assoc quasiquote "quote" swap 2array ; +M: hashtable quasiquote "quote" swap 2array ; M: object quasiquote ; : 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* ] } @@ -100,13 +95,23 @@ M: object quasiquote ; { "if" [ [ rest ] dip eval-if ] } { "fn*" [ [ rest ] dip eval-fn* f ] } { "quote" [ drop second f ] } - { "quasiquoteexpand" [ drop second quasiquote f ] } { "quasiquote" [ [ second quasiquote ] dip ] } [ 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 diff --git a/impls/factor/step8_macros/step8_macros.factor b/impls/factor/step8_macros/step8_macros.factor index f6c7db7cdd..ef5cd08220 100755 --- a/impls/factor/step8_macros/step8_macros.factor +++ b/impls/factor/step8_macros/step8_macros.factor @@ -11,12 +11,6 @@ SYMBOL: repl-env DEFER: EVAL -GENERIC# eval-ast 1 ( ast env -- ast ) -M: malsymbol eval-ast env-get ; -M: sequence eval-ast '[ _ EVAL ] map ; -M: assoc eval-ast '[ _ EVAL ] assoc-map ; -M: object eval-ast drop ; - :: eval-def! ( key value env -- maltype ) value env EVAL [ key env env-set ] keep ; @@ -32,7 +26,7 @@ M: object eval-ast drop ; 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 ) @@ -52,7 +46,7 @@ M: object eval-ast drop ; swapd [ over length cut [ zip ] dip ] dip [ swap 2array suffix ] [ drop ] if* >hashtable ; -GENERIC# apply 0 ( args fn -- maltype newenv/f ) +GENERIC: apply ( args fn -- maltype newenv/f ) M: malfn apply [ exprs>> nip ] @@ -89,23 +83,14 @@ M: array quasiquote [ second ] [ qq_foldr ] if ; M: vector quasiquote qq_foldr "vec" swap 2array ; M: malsymbol quasiquote "quote" swap 2array ; -M: assoc quasiquote "quote" swap 2array ; +M: hashtable quasiquote "quote" swap 2array ; M: object quasiquote ; -:: 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? [ +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 ] } @@ -114,17 +99,33 @@ M: object quasiquote ; { "if" [ [ rest ] dip eval-if ] } { "fn*" [ [ rest ] dip eval-fn* f ] } { "quote" [ drop second f ] } - { "quasiquoteexpand" [ drop second quasiquote f ] } { "quasiquote" [ [ second quasiquote ] dip ] } - { "macroexpand" [ [ second ] dip macro-expand f ] } - [ drop '[ _ EVAL ] map unclip apply ] + [ 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* - ] [ - eval-ast - ] if - ] [ - 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 diff --git a/impls/factor/step9_try/step9_try.factor b/impls/factor/step9_try/step9_try.factor index cf0119e813..db98a9d308 100755 --- a/impls/factor/step9_try/step9_try.factor +++ b/impls/factor/step9_try/step9_try.factor @@ -11,12 +11,6 @@ SYMBOL: repl-env DEFER: EVAL -GENERIC# eval-ast 1 ( ast env -- ast ) -M: malsymbol eval-ast env-get ; -M: sequence eval-ast '[ _ EVAL ] map ; -M: assoc eval-ast '[ _ EVAL ] assoc-map ; -M: object eval-ast drop ; - :: eval-def! ( key value env -- maltype ) value env EVAL [ key env env-set ] keep ; @@ -32,7 +26,7 @@ M: object eval-ast drop ; 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 ) @@ -63,7 +57,7 @@ M: object eval-ast drop ; swapd [ over length cut [ zip ] dip ] dip [ swap 2array suffix ] [ drop ] if* >hashtable ; -GENERIC# apply 0 ( args fn -- maltype newenv/f ) +GENERIC: apply ( args fn -- maltype newenv/f ) M: malfn apply [ exprs>> nip ] @@ -100,23 +94,14 @@ M: array quasiquote [ second ] [ qq_foldr ] if ; M: vector quasiquote qq_foldr "vec" swap 2array ; M: malsymbol quasiquote "quote" swap 2array ; -M: assoc quasiquote "quote" swap 2array ; +M: hashtable quasiquote "quote" swap 2array ; M: object quasiquote ; -:: 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? [ +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 ] } @@ -125,18 +110,34 @@ M: object quasiquote ; { "if" [ [ rest ] dip eval-if ] } { "fn*" [ [ rest ] dip eval-fn* f ] } { "quote" [ drop second f ] } - { "quasiquoteexpand" [ drop second quasiquote f ] } { "quasiquote" [ [ second quasiquote ] dip ] } - { "macroexpand" [ [ second ] dip macro-expand f ] } { "try*" [ [ rest ] dip eval-try* f ] } - [ drop '[ _ EVAL ] map unclip apply ] + [ 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* - ] [ - eval-ast - ] if - ] [ - 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 diff --git a/impls/factor/stepA_mal/stepA_mal.factor b/impls/factor/stepA_mal/stepA_mal.factor index 0a2bb84694..230407a841 100755 --- a/impls/factor/stepA_mal/stepA_mal.factor +++ b/impls/factor/stepA_mal/stepA_mal.factor @@ -11,12 +11,6 @@ SYMBOL: repl-env DEFER: EVAL -GENERIC# eval-ast 1 ( ast env -- ast ) -M: malsymbol eval-ast env-get ; -M: sequence eval-ast '[ _ EVAL ] map ; -M: assoc eval-ast '[ _ EVAL ] assoc-map ; -M: object eval-ast drop ; - :: eval-def! ( key value env -- maltype ) value env EVAL [ key env env-set ] keep ; @@ -32,7 +26,7 @@ M: object eval-ast drop ; 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 ) @@ -63,7 +57,7 @@ M: object eval-ast drop ; swapd [ over length cut [ zip ] dip ] dip [ swap 2array suffix ] [ drop ] if* >hashtable ; -GENERIC# apply 0 ( args fn -- maltype newenv/f ) +GENERIC: apply ( args fn -- maltype newenv/f ) M: malfn apply [ exprs>> nip ] @@ -100,23 +94,14 @@ M: array quasiquote [ second ] [ qq_foldr ] if ; M: vector quasiquote qq_foldr "vec" swap 2array ; M: malsymbol quasiquote "quote" swap 2array ; -M: assoc quasiquote "quote" swap 2array ; +M: hashtable quasiquote "quote" swap 2array ; M: object quasiquote ; -:: 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? [ +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 ] } @@ -125,18 +110,34 @@ M: object quasiquote ; { "if" [ [ rest ] dip eval-if ] } { "fn*" [ [ rest ] dip eval-fn* f ] } { "quote" [ drop second f ] } - { "quasiquoteexpand" [ drop second quasiquote f ] } { "quasiquote" [ [ second quasiquote ] dip ] } - { "macroexpand" [ [ second ] dip macro-expand f ] } { "try*" [ [ rest ] dip eval-try* f ] } - [ drop '[ _ EVAL ] map unclip apply ] + [ 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* - ] [ - eval-ast - ] if - ] [ - 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 diff --git a/impls/fennel/env.fnl b/impls/fennel/env.fnl index 995231bf5b..e3f601110c 100644 --- a/impls/fennel/env.fnl +++ b/impls/fennel/env.fnl @@ -37,25 +37,12 @@ val-ast) env) -(fn env-find - [env sym-ast] - (let [inner-env (. env :data) - val-ast (. inner-env (t.get-value sym-ast))] - (if val-ast - env - (let [outer (. env :outer)] - (when outer - (env-find outer sym-ast)))))) - (fn env-get - [env sym-ast] - (let [target-env (env-find env sym-ast)] - (if target-env - (. (. target-env :data) - (t.get-value sym-ast)) - (u.throw* - (t.make-string (.. "'" (t.get-value sym-ast) "'" - " not found")))))) + [env key] + (or (. env :data key) + (let [outer (. env :outer)] + (when outer + (env-get outer key))))) (comment @@ -65,8 +52,6 @@ (t.make-symbol "fun") (t.make-number 1)) - (env-find test-env (t.make-symbol "fun")) - (env-get test-env (t.make-symbol "fun")) (local test-env-2 (make-env nil)) @@ -75,8 +60,6 @@ (t.make-symbol "smile") (t.make-keyword ":yay")) - (env-find test-env-2 (t.make-symbol "smile")) - (env-get test-env-2 (t.make-symbol "smile")) (local test-env-3 (make-env nil)) @@ -87,13 +70,10 @@ (t.make-number (+ (t.get-value ast-1) (t.get-value ast-2))))) - (env-find test-env-3 (t.make-symbol "+")) - (env-get test-env-3 (t.make-symbol "+")) ) {:make-env make-env :env-set env-set - :env-find env-find :env-get env-get} diff --git a/impls/fennel/step2_eval.fnl b/impls/fennel/step2_eval.fnl index 93d536eafe..58e3b592ed 100644 --- a/impls/fennel/step2_eval.fnl +++ b/impls/fennel/step2_eval.fnl @@ -21,19 +21,12 @@ [code-str] (reader.read_str code-str)) -;; forward declaration -(var EVAL 1) - -(fn eval_ast +(fn EVAL [ast env] + ;; (print (.. "EVAL: " (printer.pr_str ast true))) (if (t.symbol?* ast) (. env (t.get-value ast)) ;; - (t.list?* ast) - (t.make-list (u.map (fn [elt-ast] - (EVAL elt-ast env)) - (t.get-value ast))) - ;; (t.vector?* ast) (t.make-vector (u.map (fn [elt-ast] (EVAL elt-ast env)) @@ -44,20 +37,13 @@ (EVAL elt-ast env)) (t.get-value ast))) ;; - ast)) - -(set EVAL - (fn [ast env] - (if (not (t.list?* ast)) - (eval_ast ast env) - ;; - (t.empty?* ast) + (or (not (t.list?* ast)) (t.empty?* ast)) ast ;; - (let [eval-list (eval_ast ast env) - f (u.first (t.get-value eval-list)) - args (u.slice (t.get-value eval-list) 2 -1)] - (f (table.unpack args)))))) + (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] diff --git a/impls/fennel/step3_env.fnl b/impls/fennel/step3_env.fnl index 8e07c440fe..d85dcdb400 100644 --- a/impls/fennel/step3_env.fnl +++ b/impls/fennel/step3_env.fnl @@ -27,18 +27,17 @@ [arg] (reader.read_str arg)) -;; forward declaration -(var EVAL 1) - -(fn eval_ast +(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) - (e.env-get env ast) - ;; - (t.list?* ast) - (t.make-list (u.map (fn [elt-ast] - (EVAL elt-ast env)) - (t.get-value 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] @@ -50,14 +49,7 @@ (EVAL elt-ast env)) (t.get-value ast))) ;; - ast)) - -(set EVAL - (fn [ast env] - (if (not (t.list?* ast)) - (eval_ast ast env) - ;; - (t.empty?* ast) + (or (not (t.list?* ast)) (t.empty?* ast)) ast ;; (let [ast-elts (t.get-value ast) @@ -81,10 +73,10 @@ b-name b-val))) (EVAL (. ast-elts 3) new-env)) ;; - (let [eval-list (t.get-value (eval_ast ast 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)))))))) + (f (table.unpack args))))))) (fn PRINT [ast] diff --git a/impls/fennel/step4_if_fn_do.fnl b/impls/fennel/step4_if_fn_do.fnl index 0e909f877d..cb65a5d0cb 100644 --- a/impls/fennel/step4_if_fn_do.fnl +++ b/impls/fennel/step4_if_fn_do.fnl @@ -17,18 +17,17 @@ [code-str] (reader.read_str code-str)) -;; forward declaration -(var EVAL 1) - -(fn eval_ast +(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) - (e.env-get env ast) - ;; - (t.list?* ast) - (t.make-list (u.map (fn [elt-ast] - (EVAL elt-ast env)) - (t.get-value 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] @@ -40,14 +39,7 @@ (EVAL elt-ast env)) (t.get-value ast))) ;; - ast)) - -(set EVAL - (fn [ast env] - (if (not (t.list?* ast)) - (eval_ast ast env) - ;; - (t.empty?* ast) + (or (not (t.list?* ast)) (t.empty?* ast)) ast ;; (let [ast-elts (t.get-value ast) @@ -72,10 +64,7 @@ (EVAL (. ast-elts 3) new-env)) ;; (= "do" head-name) - (let [do-body-evaled (eval_ast (t.make-list - (u.slice ast-elts 2 -1)) - env)] - (u.last (t.get-value do-body-evaled))) + (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)] @@ -94,10 +83,10 @@ (EVAL body (e.make-env env args params))))) ;; - (let [eval-list (t.get-value (eval_ast ast env)) + (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))))))) + ((t.get-value f) args)))))) (fn PRINT [ast] diff --git a/impls/fennel/step5_tco.fnl b/impls/fennel/step5_tco.fnl index c623375441..d3b9701c67 100644 --- a/impls/fennel/step5_tco.fnl +++ b/impls/fennel/step5_tco.fnl @@ -17,41 +17,32 @@ [code-str] (reader.read_str code-str)) -;; forward declaration -(var EVAL 1) - -(fn eval_ast - [ast env] - (if (t.symbol?* ast) - (e.env-get env ast) - ;; - (t.list?* ast) - (t.make-list (u.map (fn [elt-ast] - (EVAL elt-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))) - ;; - ast)) - -(set EVAL - (fn [ast-param env-param] +(fn EVAL + [ast-param env-param] (var ast ast-param) (var env env-param) (var result nil) (while (not result) - (if (not (t.list?* ast)) - (set result (eval_ast 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)] + (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)))) ;; - (t.empty?* ast) + (or (not (t.list?* ast)) (t.empty?* ast)) (set result ast) ;; (let [ast-elts (t.get-value ast) @@ -80,7 +71,7 @@ (= "do" head-name) (let [most-forms (u.slice ast-elts 2 -2) ;; XXX last-body-form (u.last ast-elts) - res-ast (eval_ast (t.make-list most-forms) env)] + res-ast (u.map (fn [x] (EVAL x env)) most-forms)] ;; tco (set ast last-body-form)) ;; @@ -106,18 +97,17 @@ (e.make-env env params args))) body params env))) ;; - (let [eval-list (t.get-value (eval_ast ast env)) - f (. eval-list 1) - args (u.slice eval-list 2 -1)] - (let [body (t.get-ast f)] ;; tco + (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)) + ((t.get-value f) args)))))))) + result) (fn PRINT [ast] diff --git a/impls/fennel/step6_file.fnl b/impls/fennel/step6_file.fnl index ae3f964728..4a239e4e1c 100644 --- a/impls/fennel/step6_file.fnl +++ b/impls/fennel/step6_file.fnl @@ -17,41 +17,32 @@ [code-str] (reader.read_str code-str)) -;; forward declaration -(var EVAL 1) - -(fn eval_ast - [ast env] - (if (t.symbol?* ast) - (e.env-get env ast) - ;; - (t.list?* ast) - (t.make-list (u.map (fn [elt-ast] - (EVAL elt-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))) - ;; - ast)) - -(set EVAL - (fn [ast-param env-param] +(fn EVAL + [ast-param env-param] (var ast ast-param) (var env env-param) (var result nil) (while (not result) - (if (not (t.list?* ast)) - (set result (eval_ast 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)] + (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)))) ;; - (t.empty?* ast) + (or (not (t.list?* ast)) (t.empty?* ast)) (set result ast) ;; (let [ast-elts (t.get-value ast) @@ -80,7 +71,7 @@ (= "do" head-name) (let [most-forms (u.slice ast-elts 2 -2) ;; XXX last-body-form (u.last ast-elts) - res-ast (eval_ast (t.make-list most-forms) env)] + res-ast (u.map (fn [x] (EVAL x env)) most-forms)] ;; tco (set ast last-body-form)) ;; @@ -106,18 +97,17 @@ (e.make-env env params args))) body params env))) ;; - (let [eval-list (t.get-value (eval_ast ast env)) - f (. eval-list 1) - args (u.slice eval-list 2 -1)] - (let [body (t.get-ast f)] ;; tco + (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)) + ((t.get-value f) args)))))))) + result) (fn PRINT [ast] diff --git a/impls/fennel/step7_quote.fnl b/impls/fennel/step7_quote.fnl index 32e424996d..a4ff7591bf 100644 --- a/impls/fennel/step7_quote.fnl +++ b/impls/fennel/step7_quote.fnl @@ -17,31 +17,6 @@ [code-str] (reader.read_str code-str)) -;; forward declaration -(var EVAL 1) - -(fn eval_ast - [ast env] - (if (t.symbol?* ast) - (e.env-get env ast) - ;; - (t.list?* ast) - (t.make-list (u.map (fn [elt-ast] - (EVAL elt-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))) - ;; - ast)) - (fn starts-with [ast name] (when (and (t.list?* ast) @@ -84,16 +59,32 @@ ;; ast))) -(set EVAL - (fn [ast-param env-param] +(fn EVAL + [ast-param env-param] (var ast ast-param) (var env env-param) (var result nil) (while (not result) - (if (not (t.list?* ast)) - (set result (eval_ast 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)] + (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.empty?* 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) @@ -123,10 +114,6 @@ ;; tco (set result (. ast-elts 2)) ;; - (= "quasiquoteexpand" head-name) - ;; tco - (set result (quasiquote* (. ast-elts 2))) - ;; (= "quasiquote" head-name) ;; tco (set ast (quasiquote* (. ast-elts 2))) @@ -134,7 +121,7 @@ (= "do" head-name) (let [most-forms (u.slice ast-elts 2 -2) ;; XXX last-body-form (u.last ast-elts) - res-ast (eval_ast (t.make-list most-forms) env)] + res-ast (u.map (fn [x] (EVAL x env)) most-forms)] ;; tco (set ast last-body-form)) ;; @@ -160,18 +147,17 @@ (e.make-env env params args))) body params env))) ;; - (let [eval-list (t.get-value (eval_ast ast env)) - f (. eval-list 1) - args (u.slice eval-list 2 -1)] - (let [body (t.get-ast f)] ;; tco + (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)) + ((t.get-value f) args)))))))) + result) (fn PRINT [ast] diff --git a/impls/fennel/step8_macros.fnl b/impls/fennel/step8_macros.fnl index 98b24ef07e..539341b69a 100644 --- a/impls/fennel/step8_macros.fnl +++ b/impls/fennel/step8_macros.fnl @@ -17,52 +17,6 @@ [code-str] (reader.read_str code-str)) -(fn is_macro_call - [ast env] - (when (and (t.list?* ast) - (not (t.empty?* ast))) - (let [head-ast (. (t.get-value ast) 1)] - (when (and (t.symbol?* head-ast) - (e.env-find env head-ast)) - (let [target-ast (e.env-get env head-ast)] - (t.macro?* target-ast)))))) - -(fn macroexpand - [ast env] - (var ast-var ast) - (while (is_macro_call ast-var env) - (let [inner-asts (t.get-value ast-var) - head-ast (. inner-asts 1) - macro-fn (t.get-value (e.env-get env head-ast)) - args (u.slice inner-asts 2 -1)] - (set ast-var (macro-fn args)))) - ast-var) - -;; forward declaration -(var EVAL 1) - -(fn eval_ast - [ast env] - (if (t.symbol?* ast) - (e.env-get env ast) - ;; - (t.list?* ast) - (t.make-list (u.map (fn [elt-ast] - (EVAL elt-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))) - ;; - ast)) - (fn starts-with [ast name] (when (and (t.list?* ast) @@ -105,20 +59,34 @@ ;; ast))) -(set EVAL - (fn [ast-param env-param] +(fn EVAL + [ast-param env-param] (var ast ast-param) (var env env-param) (var result nil) (while (not result) - (if (not (t.list?* ast)) - (set result (eval_ast ast env)) - (do - (set ast (macroexpand ast env)) - (if (not (t.list?* ast)) - (set result (eval_ast ast env)) - (if (t.empty?* ast) + (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... @@ -137,9 +105,6 @@ def-name macro-ast) (set result macro-ast)) ;; - (= "macroexpand" head-name) - (set result (macroexpand (. ast-elts 2) env)) - ;; (= "let*" head-name) (let [new-env (e.make-env env) bindings (t.get-value (. ast-elts 2)) @@ -159,10 +124,6 @@ ;; tco (set result (. ast-elts 2)) ;; - (= "quasiquoteexpand" head-name) - ;; tco - (set result (quasiquote* (. ast-elts 2))) - ;; (= "quasiquote" head-name) ;; tco (set ast (quasiquote* (. ast-elts 2))) @@ -170,8 +131,7 @@ (= "do" head-name) (let [most-forms (u.slice ast-elts 2 -2) ;; XXX last-body-form (u.last ast-elts) - res-ast (eval_ast - (t.make-list most-forms) env)] + res-ast (u.map (fn [x] (EVAL x env)) most-forms)] ;; tco (set ast last-body-form)) ;; @@ -198,10 +158,12 @@ (e.make-env env params args))) body params env false))) ;; - (let [eval-list (t.get-value (eval_ast ast env)) - f (. eval-list 1) - args (u.slice eval-list 2 -1)] - (let [body (t.get-ast f)] ;; tco + (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) @@ -210,8 +172,8 @@ (t.get-params f) args))) (set result - ((t.get-value f) args)))))))))))) - result)) + ((t.get-value f) args)))))))))) + result) (fn PRINT [ast] diff --git a/impls/fennel/step9_try.fnl b/impls/fennel/step9_try.fnl index 601e9cc827..f6b34d3f8d 100644 --- a/impls/fennel/step9_try.fnl +++ b/impls/fennel/step9_try.fnl @@ -17,52 +17,6 @@ [code-str] (reader.read_str code-str)) -(fn is_macro_call - [ast env] - (when (and (t.list?* ast) - (not (t.empty?* ast))) - (let [head-ast (. (t.get-value ast) 1)] - (when (and (t.symbol?* head-ast) - (e.env-find env head-ast)) - (let [target-ast (e.env-get env head-ast)] - (t.macro?* target-ast)))))) - -(fn macroexpand - [ast env] - (var ast-var ast) - (while (is_macro_call ast-var env) - (let [inner-asts (t.get-value ast-var) - head-ast (. inner-asts 1) - macro-fn (t.get-value (e.env-get env head-ast)) - args (u.slice inner-asts 2 -1)] - (set ast-var (macro-fn args)))) - ast-var) - -;; forward declaration -(var EVAL 1) - -(fn eval_ast - [ast env] - (if (t.symbol?* ast) - (e.env-get env ast) - ;; - (t.list?* ast) - (t.make-list (u.map (fn [elt-ast] - (EVAL elt-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))) - ;; - ast)) - (fn starts-with [ast name] (when (and (t.list?* ast) @@ -105,20 +59,34 @@ ;; ast))) -(set EVAL - (fn [ast-param env-param] +(fn EVAL + [ast-param env-param] (var ast ast-param) (var env env-param) (var result nil) (while (not result) - (if (not (t.list?* ast)) - (set result (eval_ast ast env)) - (do - (set ast (macroexpand ast env)) - (if (not (t.list?* ast)) - (set result (eval_ast ast env)) - (if (t.empty?* ast) + (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... @@ -137,9 +105,6 @@ def-name macro-ast) (set result macro-ast)) ;; - (= "macroexpand" head-name) - (set result (macroexpand (. ast-elts 2) env)) - ;; (= "let*" head-name) (let [new-env (e.make-env env) bindings (t.get-value (. ast-elts 2)) @@ -159,10 +124,6 @@ ;; tco (set result (. ast-elts 2)) ;; - (= "quasiquoteexpand" head-name) - ;; tco - (set result (quasiquote* (. ast-elts 2))) - ;; (= "quasiquote" head-name) ;; tco (set ast (quasiquote* (. ast-elts 2))) @@ -203,8 +164,7 @@ (= "do" head-name) (let [most-forms (u.slice ast-elts 2 -2) ;; XXX last-body-form (u.last ast-elts) - res-ast (eval_ast - (t.make-list most-forms) env)] + res-ast (u.map (fn [x] (EVAL x env)) most-forms)] ;; tco (set ast last-body-form)) ;; @@ -231,10 +191,12 @@ (e.make-env env params args))) body params env false))) ;; - (let [eval-list (t.get-value (eval_ast ast env)) - f (. eval-list 1) - args (u.slice eval-list 2 -1)] - (let [body (t.get-ast f)] ;; tco + (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) @@ -243,8 +205,8 @@ (t.get-params f) args))) (set result - ((t.get-value f) args)))))))))))) - result)) + ((t.get-value f) args)))))))))) + result) (fn PRINT [ast] diff --git a/impls/fennel/stepA_mal.fnl b/impls/fennel/stepA_mal.fnl index 9623fa38bf..417328d02b 100644 --- a/impls/fennel/stepA_mal.fnl +++ b/impls/fennel/stepA_mal.fnl @@ -17,52 +17,6 @@ [code-str] (reader.read_str code-str)) -(fn is_macro_call - [ast env] - (when (and (t.list?* ast) - (not (t.empty?* ast))) - (let [head-ast (. (t.get-value ast) 1)] - (when (and (t.symbol?* head-ast) - (e.env-find env head-ast)) - (let [target-ast (e.env-get env head-ast)] - (t.macro?* target-ast)))))) - -(fn macroexpand - [ast env] - (var ast-var ast) - (while (is_macro_call ast-var env) - (let [inner-asts (t.get-value ast-var) - head-ast (. inner-asts 1) - macro-fn (t.get-value (e.env-get env head-ast)) - args (u.slice inner-asts 2 -1)] - (set ast-var (macro-fn args)))) - ast-var) - -;; forward declaration -(var EVAL 1) - -(fn eval_ast - [ast env] - (if (t.symbol?* ast) - (e.env-get env ast) - ;; - (t.list?* ast) - (t.make-list (u.map (fn [elt-ast] - (EVAL elt-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))) - ;; - ast)) - (fn starts-with [ast name] (when (and (t.list?* ast) @@ -105,20 +59,34 @@ ;; ast))) -(set EVAL - (fn [ast-param env-param] +(fn EVAL + [ast-param env-param] (var ast ast-param) (var env env-param) (var result nil) (while (not result) - (if (not (t.list?* ast)) - (set result (eval_ast ast env)) - (do - (set ast (macroexpand ast env)) - (if (not (t.list?* ast)) - (set result (eval_ast ast env)) - (if (t.empty?* ast) + (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... @@ -137,9 +105,6 @@ def-name macro-ast) (set result macro-ast)) ;; - (= "macroexpand" head-name) - (set result (macroexpand (. ast-elts 2) env)) - ;; (= "let*" head-name) (let [new-env (e.make-env env) bindings (t.get-value (. ast-elts 2)) @@ -159,10 +124,6 @@ ;; tco (set result (. ast-elts 2)) ;; - (= "quasiquoteexpand" head-name) - ;; tco - (set result (quasiquote* (. ast-elts 2))) - ;; (= "quasiquote" head-name) ;; tco (set ast (quasiquote* (. ast-elts 2))) @@ -203,8 +164,7 @@ (= "do" head-name) (let [most-forms (u.slice ast-elts 2 -2) ;; XXX last-body-form (u.last ast-elts) - res-ast (eval_ast - (t.make-list most-forms) env)] + res-ast (u.map (fn [x] (EVAL x env)) most-forms)] ;; tco (set ast last-body-form)) ;; @@ -231,10 +191,12 @@ (e.make-env env params args))) body params env false nil))) ;; - (let [eval-list (t.get-value (eval_ast ast env)) - f (. eval-list 1) - args (u.slice eval-list 2 -1)] - (let [body (t.get-ast f)] ;; tco + (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) @@ -243,8 +205,8 @@ (t.get-params f) args))) (set result - ((t.get-value f) args)))))))))))) - result)) + ((t.get-value f) args)))))))))) + result) (fn PRINT [ast] diff --git a/impls/forth/step2_eval.fs b/impls/forth/step2_eval.fs index ba8f30b52d..39a60ad01e 100644 --- a/impls/forth/step2_eval.fs +++ b/impls/forth/step2_eval.fs @@ -17,7 +17,9 @@ MalMap/Empty constant repl-env : read read-str ; -: eval ( env obj ) mal-eval ; +: eval ( env obj ) + \ ." EVAL: " dup pr-str safe-type cr + mal-eval ; : print \ ." Type: " dup mal-type @ type-name safe-type cr pr-str ; diff --git a/impls/forth/step3_env.fs b/impls/forth/step3_env.fs index 939afce4da..bed70bccd6 100644 --- a/impls/forth/step3_env.fs +++ b/impls/forth/step3_env.fs @@ -14,7 +14,14 @@ s" *" MalSymbol. :noname args-as-native * MalInt. ; MalNativeFn. repl-env env/ s" /" MalSymbol. :noname args-as-native / MalInt. ; MalNativeFn. repl-env env/set : read read-str ; -: eval ( env obj ) mal-eval ; +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 ; diff --git a/impls/forth/step4_if_fn_do.fs b/impls/forth/step4_if_fn_do.fs index 72b8ac1615..bd92f7b463 100644 --- a/impls/forth/step4_if_fn_do.fs +++ b/impls/forth/step4_if_fn_do.fs @@ -5,7 +5,14 @@ require core.fs core MalEnv. constant repl-env : read read-str ; -: eval ( env obj ) mal-eval ; +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 ; diff --git a/impls/forth/step5_tco.fs b/impls/forth/step5_tco.fs index 835f717411..88ef6d4ce1 100644 --- a/impls/forth/step5_tco.fs +++ b/impls/forth/step5_tco.fs @@ -7,9 +7,14 @@ core MalEnv. constant repl-env 99999999 constant TCO-eval : read read-str ; +s" DEBUG-EVAL" MalSymbol. constant debug-eval-sym : eval ( env obj ) begin - \ ." eval-> " dup pr-str safe-type cr + 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 diff --git a/impls/forth/step6_file.fs b/impls/forth/step6_file.fs index 5f7e0dad9c..e30264ab3a 100644 --- a/impls/forth/step6_file.fs +++ b/impls/forth/step6_file.fs @@ -7,9 +7,14 @@ core MalEnv. constant repl-env 99999999 constant TCO-eval : read read-str ; +s" DEBUG-EVAL" MalSymbol. constant debug-eval-sym : eval ( env obj ) begin - \ ." eval-> " dup pr-str safe-type cr + 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 diff --git a/impls/forth/step7_quote.fs b/impls/forth/step7_quote.fs index 3198ef33f6..3dd4e067c9 100644 --- a/impls/forth/step7_quote.fs +++ b/impls/forth/step7_quote.fs @@ -7,9 +7,14 @@ core MalEnv. constant repl-env 99999999 constant TCO-eval : read read-str ; +s" DEBUG-EVAL" MalSymbol. constant debug-eval-sym : eval ( env obj ) begin - \ ." eval-> " dup pr-str safe-type cr + 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 @@ -132,9 +137,6 @@ defer quasiquote endcase ; ' quasiquote0 is quasiquote -defspecial quasiquoteexpand ( env list -- form ) - nip MalList/start @ cell+ @ quasiquote ;; - defspecial quasiquote ( env list ) MalList/start @ cell+ @ ( ast ) quasiquote TCO-eval ;; diff --git a/impls/forth/step8_macros.fs b/impls/forth/step8_macros.fs index 0ea32523a1..ba4b1456c1 100644 --- a/impls/forth/step8_macros.fs +++ b/impls/forth/step8_macros.fs @@ -7,9 +7,14 @@ core MalEnv. constant repl-env 99999999 constant TCO-eval : read read-str ; +s" DEBUG-EVAL" MalSymbol. constant debug-eval-sym : eval ( env obj ) begin - \ ." eval-> " dup pr-str safe-type cr + 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 @@ -132,9 +137,6 @@ defer quasiquote endcase ; ' quasiquote0 is quasiquote -defspecial quasiquoteexpand ( env list -- form ) - nip MalList/start @ cell+ @ quasiquote ;; - defspecial quasiquote ( env list ) MalList/start @ cell+ @ ( ast ) quasiquote TCO-eval ;; @@ -148,8 +150,8 @@ defspecial def! { env list -- val } defspecial defmacro! { env list -- val } list MalList/start @ cell+ { arg0 } arg0 @ ( key ) - env arg0 cell+ @ eval { val } - true val MalUserFn/is-macro? ! + env arg0 cell+ @ eval + asMacro { val } val env env/set val ;; @@ -251,14 +253,6 @@ defspecial fn* { env list -- val } 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 diff --git a/impls/forth/step9_try.fs b/impls/forth/step9_try.fs index ab39fd56a3..6fe9ca6bcd 100644 --- a/impls/forth/step9_try.fs +++ b/impls/forth/step9_try.fs @@ -7,9 +7,14 @@ core MalEnv. constant repl-env 99999999 constant TCO-eval : read read-str ; +s" DEBUG-EVAL" MalSymbol. constant debug-eval-sym : eval ( env obj ) begin - \ ." eval-> " dup pr-str safe-type cr + 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 @@ -141,9 +146,6 @@ defer quasiquote endcase ; ' quasiquote0 is quasiquote -defspecial quasiquoteexpand ( env list -- form ) - nip MalList/start @ cell+ @ quasiquote ;; - defspecial quasiquote ( env list ) MalList/start @ cell+ @ ( ast ) quasiquote TCO-eval ;; @@ -157,8 +159,8 @@ defspecial def! { env list -- val } defspecial defmacro! { env list -- val } list MalList/start @ cell+ { arg0 } arg0 @ ( key ) - env arg0 cell+ @ eval { val } - true val MalUserFn/is-macro? ! + env arg0 cell+ @ eval + asMacro { val } val env env/set val ;; @@ -260,14 +262,6 @@ defspecial fn* { env list -- val } 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 } diff --git a/impls/forth/stepA_mal.fs b/impls/forth/stepA_mal.fs index bcf08ff460..ec0fc2b31e 100644 --- a/impls/forth/stepA_mal.fs +++ b/impls/forth/stepA_mal.fs @@ -7,9 +7,14 @@ core MalEnv. constant repl-env 99999999 constant TCO-eval : read read-str ; +s" DEBUG-EVAL" MalSymbol. constant debug-eval-sym : eval ( env obj ) begin - \ ." eval-> " dup pr-str safe-type cr + 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 @@ -141,9 +146,6 @@ defer quasiquote endcase ; ' quasiquote0 is quasiquote -defspecial quasiquoteexpand ( env list -- form ) - nip MalList/start @ cell+ @ quasiquote ;; - defspecial quasiquote ( env list ) MalList/start @ cell+ @ ( ast ) quasiquote TCO-eval ;; @@ -157,8 +159,8 @@ defspecial def! { env list -- val } defspecial defmacro! { env list -- val } list MalList/start @ cell+ { arg0 } arg0 @ ( key ) - env arg0 cell+ @ eval { val } - true val MalUserFn/is-macro? ! + env arg0 cell+ @ eval + asMacro { val } val env env/set val ;; @@ -260,14 +262,6 @@ defspecial fn* { env list -- val } 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 } diff --git a/impls/forth/types.fs b/impls/forth/types.fs index 5d3faec346..f5c823d8e5 100644 --- a/impls/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/env.fs b/impls/fsharp/env.fs index 07535dd4ad..f505ba5917 100644 --- a/impls/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 @@ -122,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/impls/fsharp/step2_eval.fs b/impls/fsharp/step2_eval.fs index 62bdc4299d..436afa1a92 100644 --- a/impls/fsharp/step2_eval.fs +++ b/impls/fsharp/step2_eval.fs @@ -3,21 +3,19 @@ module REPL open Node open Types - let rec eval_ast env = function - | Symbol(sym) -> Env.get env sym - | List(_, lst) -> lst |> List.map (eval env) |> makeList + 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 - | 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 + | List(_, (a0 :: rest)) -> + match eval env a0 with + | BuiltInFunc(_, _, f) -> List.map (eval env) rest |> f | _ -> raise <| Error.errExpectedX "func" - | node -> node |> eval_ast env + | _ -> ast let READ input = Reader.read_str input diff --git a/impls/fsharp/step3_env.fs b/impls/fsharp/step3_env.fs index db6408f4cd..62652008f6 100644 --- a/impls/fsharp/step3_env.fs +++ b/impls/fsharp/step3_env.fs @@ -10,14 +10,7 @@ module REPL | 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 + let rec defBang env = function | [sym; node] -> match sym with | Symbol(sym) -> @@ -44,16 +37,23 @@ module REPL eval newEnv form | _ -> raise <| Error.wrongArity () - and eval env = function - | List(_, []) as emptyList -> emptyList + 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(_, _) as node -> - let resolved = node |> eval_ast env - match resolved with - | List(_, BuiltInFunc(_, _, f)::rest) -> f rest + | List(_, (a0 :: rest)) -> + match eval env a0 with + | BuiltInFunc(_, _, f) -> List.map (eval env) rest |> f | _ -> raise <| Error.errExpectedX "func" - | node -> node |> eval_ast env + | _ -> ast let READ input = Reader.read_str input diff --git a/impls/fsharp/step4_if_fn_do.fs b/impls/fsharp/step4_if_fn_do.fs index 8b48f64b65..d673819727 100644 --- a/impls/fsharp/step4_if_fn_do.fs +++ b/impls/fsharp/step4_if_fn_do.fs @@ -10,14 +10,7 @@ module REPL | 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 + let rec defBangForm env = function | [sym; form] -> match sym with | Symbol(sym) -> @@ -74,22 +67,30 @@ module REPL | [_; _] -> raise <| Error.errExpectedX "bindings of list or vector" | _ -> raise <| Error.wrongArity () - and eval env = function - | List(_, []) as emptyList -> emptyList + 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(_, _) 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 + | 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" - | node -> node |> eval_ast env + | _ -> ast let READ input = Reader.read_str input diff --git a/impls/fsharp/step5_tco.fs b/impls/fsharp/step5_tco.fs index 1c82c67a93..c175206ffa 100644 --- a/impls/fsharp/step5_tco.fs +++ b/impls/fsharp/step5_tco.fs @@ -10,14 +10,7 @@ module REPL | 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 + let rec defBangForm env = function | [sym; form] -> match sym with | Symbol(sym) -> @@ -74,8 +67,16 @@ module REPL | [_; _] -> raise <| Error.errExpectedX "bindings of list or vector" | _ -> raise <| Error.wrongArity () - and eval env = function - | List(_, []) as emptyList -> emptyList + 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 @@ -83,15 +84,15 @@ module REPL | 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 + | 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" - | node -> node |> eval_ast env + | _ -> ast let READ input = Reader.read_str input diff --git a/impls/fsharp/step6_file.fs b/impls/fsharp/step6_file.fs index 92f2072fdd..181d12db70 100644 --- a/impls/fsharp/step6_file.fs +++ b/impls/fsharp/step6_file.fs @@ -10,14 +10,7 @@ module REPL | 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 + let rec defBangForm env = function | [sym; form] -> match sym with | Symbol(sym) -> @@ -74,8 +67,16 @@ module REPL | [_; _] -> raise <| Error.errExpectedX "bindings of list or vector" | _ -> raise <| Error.wrongArity () - and eval env = function - | List(_, []) as emptyList -> emptyList + 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 @@ -83,15 +84,15 @@ module REPL | 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 + | 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" - | node -> node |> eval_ast env + | _ -> ast let READ input = Reader.read_str input diff --git a/impls/fsharp/step7_quote.fs b/impls/fsharp/step7_quote.fs index 83fe274ba3..232bbc1f89 100644 --- a/impls/fsharp/step7_quote.fs +++ b/impls/fsharp/step7_quote.fs @@ -31,14 +31,7 @@ module REPL | [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 + let rec defBangForm env = function | [sym; form] -> match sym with | Symbol(sym) -> @@ -95,8 +88,16 @@ module REPL | [_; _] -> raise <| Error.errExpectedX "bindings of list or vector" | _ -> raise <| Error.wrongArity () - and eval env = function - | List(_, []) as emptyList -> emptyList + 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 @@ -105,19 +106,17 @@ module REPL | List(_, Symbol("do")::rest) -> doForm env rest |> eval env | List(_, Symbol("fn*")::rest) -> fnStarForm env rest | List(_, Symbol("quote")::rest) -> quoteForm rest - | List(_, [Symbol("quasiquoteexpand");form]) -> quasiquote form - | List(_, Symbol("quasiquoteexpand")::_) -> raise <| Error.wrongArity () | List(_, [Symbol("quasiquote");form]) -> eval env <| quasiquote form | List(_, Symbol("quasiquote")::_) -> raise <| Error.wrongArity () - | 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 + | 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" - | node -> node |> eval_ast env + | _ -> ast let READ input = Reader.read_str input diff --git a/impls/fsharp/step8_macros.fs b/impls/fsharp/step8_macros.fs index 95d2768005..1e5c1e781b 100644 --- a/impls/fsharp/step8_macros.fs +++ b/impls/fsharp/step8_macros.fs @@ -31,19 +31,7 @@ module REPL | [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 + let rec defBangForm env = function | [sym; form] -> match sym with | Symbol(sym) -> @@ -67,10 +55,6 @@ module REPL | _ -> 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 @@ -118,13 +102,18 @@ module REPL | [_; _] -> 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 + 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("macroexpand")::rest) -> macroExpandForm env rest | List(_, Symbol("let*")::rest) -> let inner, form = letStarForm env rest form |> eval inner @@ -132,20 +121,17 @@ module REPL | List(_, Symbol("do")::rest) -> doForm env rest |> eval env | List(_, Symbol("fn*")::rest) -> fnStarForm env rest | List(_, Symbol("quote")::rest) -> quoteForm rest - | List(_, [Symbol("quasiquoteexpand");form]) -> quasiquote form - | List(_, Symbol("quasiquoteexpand")::_) -> raise <| Error.wrongArity () | List(_, [Symbol("quasiquote");form]) -> eval env <| quasiquote form | List(_, Symbol("quasiquote")::_) -> raise <| Error.wrongArity () - | 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 + | 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" - | node -> node |> eval_ast env - | node -> node |> eval_ast env + | _ -> ast let READ input = Reader.read_str input diff --git a/impls/fsharp/step9_try.fs b/impls/fsharp/step9_try.fs index 68e7158813..ba8e1f37d2 100644 --- a/impls/fsharp/step9_try.fs +++ b/impls/fsharp/step9_try.fs @@ -31,19 +31,7 @@ module REPL | [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 + let rec defBangForm env = function | [sym; form] -> match sym with | Symbol(sym) -> @@ -67,10 +55,6 @@ module REPL | _ -> 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 @@ -137,13 +121,18 @@ module REPL | 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 + 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("macroexpand")::rest) -> macroExpandForm env rest | List(_, Symbol("let*")::rest) -> let inner, form = letStarForm env rest form |> eval inner @@ -151,21 +140,18 @@ module REPL | List(_, Symbol("do")::rest) -> doForm env rest |> eval env | List(_, Symbol("fn*")::rest) -> fnStarForm env rest | List(_, Symbol("quote")::rest) -> quoteForm rest - | List(_, [Symbol("quasiquoteexpand");form]) -> quasiquote form - | List(_, Symbol("quasiquoteexpand")::_) -> raise <| Error.wrongArity () | List(_, [Symbol("quasiquote");form]) -> eval env <| quasiquote form | List(_, Symbol("quasiquote")::_) -> raise <| Error.wrongArity () | 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 + | 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" - | node -> node |> eval_ast env - | node -> node |> eval_ast env + | _ -> ast let READ input = Reader.read_str input diff --git a/impls/fsharp/stepA_mal.fs b/impls/fsharp/stepA_mal.fs index 6417191ba5..af2f4b69a5 100644 --- a/impls/fsharp/stepA_mal.fs +++ b/impls/fsharp/stepA_mal.fs @@ -31,19 +31,7 @@ module REPL | [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 + let rec defBangForm env = function | [sym; form] -> match sym with | Symbol(sym) -> @@ -67,10 +55,6 @@ module REPL | _ -> 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 @@ -138,13 +122,18 @@ module REPL | 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 + 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("macroexpand")::rest) -> macroExpandForm env rest | List(_, Symbol("let*")::rest) -> let inner, form = letStarForm env rest form |> eval inner @@ -152,21 +141,18 @@ module REPL | List(_, Symbol("do")::rest) -> doForm env rest |> eval env | List(_, Symbol("fn*")::rest) -> fnStarForm env rest | List(_, Symbol("quote")::rest) -> quoteForm rest - | List(_, [Symbol("quasiquoteexpand");form]) -> quasiquote form - | List(_, Symbol("quasiquoteexpand")::_) -> raise <| Error.wrongArity () | List(_, [Symbol("quasiquote");form]) -> eval env <| quasiquote form | List(_, Symbol("quasiquote")::_) -> raise <| Error.wrongArity () | 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 + | 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" - | node -> node |> eval_ast env - | node -> node |> eval_ast env + | _ -> ast let READ input = Reader.read_str input diff --git a/impls/gnu-smalltalk/env.st b/impls/gnu-smalltalk/env.st index c62f871434..22607f07c8 100644 --- a/impls/gnu-smalltalk/env.st +++ b/impls/gnu-smalltalk/env.st @@ -30,24 +30,11 @@ Object subclass: Env [ data at: key put: value. ] - find: key [ + get: key [ ^data at: key ifAbsent: [ - outer notNil ifTrue: [ - outer find: key - ] ifFalse: [ - nil + outer isNil ifFalse: [ + outer get: key ] ] ] - - get: key [ - | value | - value := self find: key. - - value notNil ifTrue: [ - ^value - ] ifFalse: [ - ^MALUnknownSymbol new signal: key - ] - ] ] diff --git a/impls/gnu-smalltalk/step2_eval.st b/impls/gnu-smalltalk/step2_eval.st index 7682ccd9db..46daa312b7 100644 --- a/impls/gnu-smalltalk/step2_eval.st +++ b/impls/gnu-smalltalk/step2_eval.st @@ -18,43 +18,36 @@ Object subclass: MAL [ ^Reader readStr: input ] - MAL class >> evalAst: sexp env: env [ + 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 = #list ifTrue: [ - ^self evalList: sexp env: env class: MALList - ]. sexp type = #vector ifTrue: [ - ^self evalList: sexp env: env class: MALVector + ^MALVector new: (self evalList: sexp value env: env) ]. sexp type = #map ifTrue: [ - ^self evalList: sexp env: env class: MALMap + ^MALMap new: (self evalList: sexp value env: env) ]. - - ^sexp - ] - - MAL class >> evalList: sexp env: env class: aClass [ - | items | - items := sexp value collect: - [ :item | self EVAL: item env: env ]. - ^aClass new: items - ] - - MAL class >> EVAL: sexp env: env [ - | forms function args | sexp type ~= #list ifTrue: [ - ^self evalAst: sexp env: env + ^sexp ]. sexp value isEmpty ifTrue: [ ^sexp ]. - forms := (self evalAst: sexp env: env) value. + forms := self evalList: sexp value env: env. function := forms first. args := forms allButFirst asArray. ^function valueWithArguments: args diff --git a/impls/gnu-smalltalk/step3_env.st b/impls/gnu-smalltalk/step3_env.st index 9c51b7b238..bcabe1abfd 100644 --- a/impls/gnu-smalltalk/step3_env.st +++ b/impls/gnu-smalltalk/step3_env.st @@ -19,35 +19,38 @@ Object subclass: MAL [ ^Reader readStr: input ] - MAL class >> evalAst: sexp env: env [ - sexp type = #symbol ifTrue: [ - ^env get: sexp value + 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 = #list ifTrue: [ - ^self evalList: sexp env: env class: MALList + 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: [ - ^self evalList: sexp env: env class: MALVector + ^MALVector new: (self evalList: sexp value env: env) ]. sexp type = #map ifTrue: [ - ^self evalList: sexp env: env class: MALMap + ^MALMap new: (self evalList: sexp value env: env) ]. - - ^sexp - ] - - MAL class >> evalList: sexp env: env class: aClass [ - | items | - items := sexp value collect: - [ :item | self EVAL: item env: env ]. - ^aClass new: items - ] - - MAL class >> EVAL: sexp env: env [ - | ast a0_ a1_ a2 forms function args | sexp type ~= #list ifTrue: [ - ^self evalAst: sexp env: env + ^sexp ]. sexp value isEmpty ifTrue: [ ^sexp @@ -75,7 +78,7 @@ Object subclass: MAL [ ^self EVAL: a2 env: env_ ]. - forms := (self evalAst: sexp env: env) value. + forms := self evalList: sexp value env: env. function := forms first. args := forms allButFirst asArray. ^function valueWithArguments: args diff --git a/impls/gnu-smalltalk/step4_if_fn_do.st b/impls/gnu-smalltalk/step4_if_fn_do.st index b3cc590d42..592dadbdff 100644 --- a/impls/gnu-smalltalk/step4_if_fn_do.st +++ b/impls/gnu-smalltalk/step4_if_fn_do.st @@ -20,35 +20,37 @@ Object subclass: MAL [ ^Reader readStr: input ] - MAL class >> evalAst: sexp env: env [ - sexp type = #symbol ifTrue: [ - ^env get: sexp value + 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 = #list ifTrue: [ - ^self evalList: sexp env: env class: MALList + 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: [ - ^self evalList: sexp env: env class: MALVector + ^MALVector new: (self evalList: sexp value env: env) ]. sexp type = #map ifTrue: [ - ^self evalList: sexp env: env class: MALMap + ^MALMap new: (self evalList: sexp value env: env) ]. - - ^sexp - ] - - MAL class >> evalList: sexp env: env class: aClass [ - | items | - items := sexp value collect: - [ :item | self EVAL: item env: env ]. - ^aClass new: items - ] - - MAL class >> EVAL: sexp env: env [ - | ast a0_ a1 a1_ a1_n a2 a3 forms function args | sexp type ~= #list ifTrue: [ - ^self evalAst: sexp env: env + ^sexp ]. sexp value isEmpty ifTrue: [ ^sexp @@ -77,8 +79,7 @@ Object subclass: MAL [ ]. a0_ = #do ifTrue: [ - a1_n := ast allButFirst. - ^(a1_n collect: [ :item | self EVAL: item env: env]) last + ^(self evalList: ast allButFirst env: env) last ]. a0_ = #if ifTrue: [ @@ -104,7 +105,7 @@ Object subclass: MAL [ (Env new: env binds: binds exprs: args) ] ]. - forms := (self evalAst: sexp env: env) value. + forms := self evalList: sexp value env: env. function := forms first fn. args := forms allButFirst asArray. ^function value: args diff --git a/impls/gnu-smalltalk/step5_tco.st b/impls/gnu-smalltalk/step5_tco.st index 43c7381ca3..7c51c799db 100644 --- a/impls/gnu-smalltalk/step5_tco.st +++ b/impls/gnu-smalltalk/step5_tco.st @@ -21,29 +21,9 @@ Object subclass: MAL [ ^Reader readStr: input ] - MAL class >> evalAst: sexp env: env [ - sexp type = #symbol ifTrue: [ - ^env get: sexp value - ]. - - sexp type = #list ifTrue: [ - ^self evalList: sexp env: env class: MALList - ]. - sexp type = #vector ifTrue: [ - ^self evalList: sexp env: env class: MALVector - ]. - sexp type = #map ifTrue: [ - ^self evalList: sexp env: env class: MALMap - ]. - - ^sexp - ] - - MAL class >> evalList: sexp env: env class: aClass [ - | items | - items := sexp value collect: + MAL class >> evalList: list env: env [ + ^list collect: [ :item | self EVAL: item env: env ]. - ^aClass new: items ] MAL class >> EVAL: aSexp env: anEnv [ @@ -55,8 +35,31 @@ Object subclass: MAL [ [ [ :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: [ - ^self evalAst: sexp env: env + ^sexp ]. sexp value isEmpty ifTrue: [ ^sexp @@ -130,7 +133,7 @@ Object subclass: MAL [ ^Func new: a2 params: binds env: env fn: fn ]. - forms := (self evalAst: sexp env: env) value. + forms := self evalList: sexp value env: env. function := forms first. args := forms allButFirst asArray. diff --git a/impls/gnu-smalltalk/step6_file.st b/impls/gnu-smalltalk/step6_file.st index 237a88e722..5d1cd77dc8 100644 --- a/impls/gnu-smalltalk/step6_file.st +++ b/impls/gnu-smalltalk/step6_file.st @@ -21,29 +21,9 @@ Object subclass: MAL [ ^Reader readStr: input ] - MAL class >> evalAst: sexp env: env [ - sexp type = #symbol ifTrue: [ - ^env get: sexp value - ]. - - sexp type = #list ifTrue: [ - ^self evalList: sexp env: env class: MALList - ]. - sexp type = #vector ifTrue: [ - ^self evalList: sexp env: env class: MALVector - ]. - sexp type = #map ifTrue: [ - ^self evalList: sexp env: env class: MALMap - ]. - - ^sexp - ] - - MAL class >> evalList: sexp env: env class: aClass [ - | items | - items := sexp value collect: + MAL class >> evalList: list env: env [ + ^list collect: [ :item | self EVAL: item env: env ]. - ^aClass new: items ] MAL class >> EVAL: aSexp env: anEnv [ @@ -55,8 +35,31 @@ Object subclass: MAL [ [ [ :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: [ - ^self evalAst: sexp env: env + ^sexp ]. sexp value isEmpty ifTrue: [ ^sexp @@ -131,7 +134,7 @@ Object subclass: MAL [ ^Func new: a2 params: binds env: env fn: fn ]. - forms := (self evalAst: sexp env: env) value. + forms := self evalList: sexp value env: env. function := forms first. args := forms allButFirst asArray. diff --git a/impls/gnu-smalltalk/step7_quote.st b/impls/gnu-smalltalk/step7_quote.st index b0e02de39d..5f022afbc8 100644 --- a/impls/gnu-smalltalk/step7_quote.st +++ b/impls/gnu-smalltalk/step7_quote.st @@ -21,29 +21,9 @@ Object subclass: MAL [ ^Reader readStr: input ] - MAL class >> evalAst: sexp env: env [ - sexp type = #symbol ifTrue: [ - ^env get: sexp value - ]. - - sexp type = #list ifTrue: [ - ^self evalList: sexp env: env class: MALList - ]. - sexp type = #vector ifTrue: [ - ^self evalList: sexp env: env class: MALVector - ]. - sexp type = #map ifTrue: [ - ^self evalList: sexp env: env class: MALMap - ]. - - ^sexp - ] - - MAL class >> evalList: sexp env: env class: aClass [ - | items | - items := sexp value collect: + MAL class >> evalList: list env: env [ + ^list collect: [ :item | self EVAL: item env: env ]. - ^aClass new: items ] MAL class >> starts_with: ast sym: sym [ @@ -95,8 +75,31 @@ Object subclass: MAL [ [ [ :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: [ - ^self evalAst: sexp env: env + ^sexp ]. sexp value isEmpty ifTrue: [ ^sexp @@ -165,11 +168,6 @@ Object subclass: MAL [ ^a1 ]. - a0_ = #quasiquoteexpand ifTrue: [ - a1 := ast second. - ^self quasiquote: a1. - ]. - a0_ = #quasiquote ifTrue: [ | result | a1 := ast second. @@ -188,7 +186,7 @@ Object subclass: MAL [ ^Func new: a2 params: binds env: env fn: fn ]. - forms := (self evalAst: sexp env: env) value. + forms := self evalList: sexp value env: env. function := forms first. args := forms allButFirst asArray. diff --git a/impls/gnu-smalltalk/step8_macros.st b/impls/gnu-smalltalk/step8_macros.st index ecb07d1b33..16ddf292fe 100644 --- a/impls/gnu-smalltalk/step8_macros.st +++ b/impls/gnu-smalltalk/step8_macros.st @@ -21,29 +21,9 @@ Object subclass: MAL [ ^Reader readStr: input ] - MAL class >> evalAst: sexp env: env [ - sexp type = #symbol ifTrue: [ - ^env get: sexp value - ]. - - sexp type = #list ifTrue: [ - ^self evalList: sexp env: env class: MALList - ]. - sexp type = #vector ifTrue: [ - ^self evalList: sexp env: env class: MALVector - ]. - sexp type = #map ifTrue: [ - ^self evalList: sexp env: env class: MALMap - ]. - - ^sexp - ] - - MAL class >> evalList: sexp env: env class: aClass [ - | items | - items := sexp value collect: + MAL class >> evalList: list env: env [ + ^list collect: [ :item | self EVAL: item env: env ]. - ^aClass new: items ] MAL class >> starts_with: ast sym: sym [ @@ -86,41 +66,8 @@ Object subclass: MAL [ ^acc ] - MAL class >> isMacroCall: ast env: env [ - | a0 a0_ f | - ast type = #list ifTrue: [ - a0 := ast value first. - a0_ := a0 value. - a0 type = #symbol ifTrue: [ - f := env find: a0_. - (f notNil and: [ f type = #func ]) ifTrue: [ - ^f isMacro - ] - ] - ]. - ^false - ] - - MAL class >> macroexpand: aSexp env: env [ - | sexp | - - "NOTE: redefinition of method arguments is not allowed" - sexp := aSexp. - - [ self isMacroCall: sexp env: env ] whileTrue: [ - | ast a0_ macro rest | - ast := sexp value. - a0_ := ast first value. - macro := env find: a0_. - rest := ast allButFirst. - sexp := macro fn value: rest. - ]. - - ^sexp - ] - MAL class >> EVAL: aSexp env: anEnv [ - | sexp env ast a0 a0_ a1 a1_ a2 a3 forms function args | + | sexp env ast a0 a0_ a1 a1_ a2 a3 function args | "NOTE: redefinition of method arguments is not allowed" sexp := aSexp. @@ -128,18 +75,36 @@ Object subclass: MAL [ [ [ :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: [ - ^self evalAst: sexp env: env + ^sexp ]. sexp value isEmpty ifTrue: [ ^sexp ]. - sexp := self macroexpand: sexp env: env. - sexp type ~= #list ifTrue: [ - ^self evalAst: sexp env: env - ]. - ast := sexp value. a0 := ast first. @@ -163,11 +128,6 @@ Object subclass: MAL [ ^result ]. - a0_ = #'macroexpand' ifTrue: [ - a1 := ast second. - ^self macroexpand: a1 env: env - ]. - a0_ = #'let*' ifTrue: [ | env_ | env_ := Env new: env. @@ -218,11 +178,6 @@ Object subclass: MAL [ ^a1 ]. - a0_ = #quasiquoteexpand ifTrue: [ - a1 := ast second. - ^self quasiquote: a1. - ]. - a0_ = #quasiquote ifTrue: [ | result | a1 := ast second. @@ -241,10 +196,13 @@ Object subclass: MAL [ ^Func new: a2 params: binds env: env fn: fn ]. - forms := (self evalAst: sexp env: env) value. - function := forms first. - args := forms allButFirst asArray. - + 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_ | diff --git a/impls/gnu-smalltalk/step9_try.st b/impls/gnu-smalltalk/step9_try.st index c8eeff5c4e..69b6fb484e 100644 --- a/impls/gnu-smalltalk/step9_try.st +++ b/impls/gnu-smalltalk/step9_try.st @@ -21,29 +21,9 @@ Object subclass: MAL [ ^Reader readStr: input ] - MAL class >> evalAst: sexp env: env [ - sexp type = #symbol ifTrue: [ - ^env get: sexp value - ]. - - sexp type = #list ifTrue: [ - ^self evalList: sexp env: env class: MALList - ]. - sexp type = #vector ifTrue: [ - ^self evalList: sexp env: env class: MALVector - ]. - sexp type = #map ifTrue: [ - ^self evalList: sexp env: env class: MALMap - ]. - - ^sexp - ] - - MAL class >> evalList: sexp env: env class: aClass [ - | items | - items := sexp value collect: + MAL class >> evalList: list env: env [ + ^list collect: [ :item | self EVAL: item env: env ]. - ^aClass new: items ] MAL class >> starts_with: ast sym: sym [ @@ -86,41 +66,8 @@ Object subclass: MAL [ ^acc ] - MAL class >> isMacroCall: ast env: env [ - | a0 a0_ f | - ast type = #list ifTrue: [ - a0 := ast value first. - a0_ := a0 value. - a0 type = #symbol ifTrue: [ - f := env find: a0_. - (f notNil and: [ f type = #func ]) ifTrue: [ - ^f isMacro - ] - ] - ]. - ^false - ] - - MAL class >> macroexpand: aSexp env: env [ - | sexp | - - "NOTE: redefinition of method arguments is not allowed" - sexp := aSexp. - - [ self isMacroCall: sexp env: env ] whileTrue: [ - | ast a0_ macro rest | - ast := sexp value. - a0_ := ast first value. - macro := env find: a0_. - rest := ast allButFirst. - sexp := macro fn value: rest. - ]. - - ^sexp - ] - MAL class >> EVAL: aSexp env: anEnv [ - | sexp env ast a0 a0_ a1 a1_ a2 a2_ a3 forms function args | + | sexp env ast a0 a0_ a1 a1_ a2 a2_ a3 function args | "NOTE: redefinition of method arguments is not allowed" sexp := aSexp. @@ -128,18 +75,36 @@ Object subclass: MAL [ [ [ :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: [ - ^self evalAst: sexp env: env + ^sexp ]. sexp value isEmpty ifTrue: [ ^sexp ]. - sexp := self macroexpand: sexp env: env. - sexp type ~= #list ifTrue: [ - ^self evalAst: sexp env: env - ]. - ast := sexp value. a0 := ast first. @@ -163,11 +128,6 @@ Object subclass: MAL [ ^result ]. - a0_ = #'macroexpand' ifTrue: [ - a1 := ast second. - ^self macroexpand: a1 env: env - ]. - a0_ = #'let*' ifTrue: [ | env_ | env_ := Env new: env. @@ -218,11 +178,6 @@ Object subclass: MAL [ ^a1 ]. - a0_ = #quasiquoteexpand ifTrue: [ - a1 := ast second. - ^self quasiquote: a1. - ]. - a0_ = #quasiquote ifTrue: [ | result | a1 := ast second. @@ -262,10 +217,13 @@ Object subclass: MAL [ ^Func new: a2 params: binds env: env fn: fn ]. - forms := (self evalAst: sexp env: env) value. - function := forms first. - args := forms allButFirst asArray. - + 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_ | diff --git a/impls/gnu-smalltalk/stepA_mal.st b/impls/gnu-smalltalk/stepA_mal.st index c67c89bf3a..e5e92455a3 100644 --- a/impls/gnu-smalltalk/stepA_mal.st +++ b/impls/gnu-smalltalk/stepA_mal.st @@ -21,29 +21,9 @@ Object subclass: MAL [ ^Reader readStr: input ] - MAL class >> evalAst: sexp env: env [ - sexp type = #symbol ifTrue: [ - ^env get: sexp value - ]. - - sexp type = #list ifTrue: [ - ^self evalList: sexp env: env class: MALList - ]. - sexp type = #vector ifTrue: [ - ^self evalList: sexp env: env class: MALVector - ]. - sexp type = #map ifTrue: [ - ^self evalList: sexp env: env class: MALMap - ]. - - ^sexp - ] - - MAL class >> evalList: sexp env: env class: aClass [ - | items | - items := sexp value collect: + MAL class >> evalList: list env: env [ + ^list collect: [ :item | self EVAL: item env: env ]. - ^aClass new: items ] MAL class >> starts_with: ast sym: sym [ @@ -86,41 +66,8 @@ Object subclass: MAL [ ^acc ] - MAL class >> isMacroCall: ast env: env [ - | a0 a0_ f | - ast type = #list ifTrue: [ - a0 := ast value first. - a0_ := a0 value. - a0 type = #symbol ifTrue: [ - f := env find: a0_. - (f notNil and: [ f type = #func ]) ifTrue: [ - ^f isMacro - ] - ] - ]. - ^false - ] - - MAL class >> macroexpand: aSexp env: env [ - | sexp | - - "NOTE: redefinition of method arguments is not allowed" - sexp := aSexp. - - [ self isMacroCall: sexp env: env ] whileTrue: [ - | ast a0_ macro rest | - ast := sexp value. - a0_ := ast first value. - macro := env find: a0_. - rest := ast allButFirst. - sexp := macro fn value: rest. - ]. - - ^sexp - ] - MAL class >> EVAL: aSexp env: anEnv [ - | sexp env ast a0 a0_ a1 a1_ a2 a2_ a3 forms function args | + | sexp env ast a0 a0_ a1 a1_ a2 a2_ a3 function args | "NOTE: redefinition of method arguments is not allowed" sexp := aSexp. @@ -128,18 +75,36 @@ Object subclass: MAL [ [ [ :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: [ - ^self evalAst: sexp env: env + ^sexp ]. sexp value isEmpty ifTrue: [ ^sexp ]. - sexp := self macroexpand: sexp env: env. - sexp type ~= #list ifTrue: [ - ^self evalAst: sexp env: env - ]. - ast := sexp value. a0 := ast first. @@ -163,11 +128,6 @@ Object subclass: MAL [ ^result ]. - a0_ = #'macroexpand' ifTrue: [ - a1 := ast second. - ^self macroexpand: a1 env: env - ]. - a0_ = #'let*' ifTrue: [ | env_ | env_ := Env new: env. @@ -218,11 +178,6 @@ Object subclass: MAL [ ^a1 ]. - a0_ = #quasiquoteexpand ifTrue: [ - a1 := ast second. - ^self quasiquote: a1. - ]. - a0_ = #quasiquote ifTrue: [ | result | a1 := ast second. @@ -262,10 +217,13 @@ Object subclass: MAL [ ^Func new: a2 params: binds env: env fn: fn ]. - forms := (self evalAst: sexp env: env) value. - function := forms first. - args := forms allButFirst asArray. - + 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_ | diff --git a/impls/go/src/stepA_mal/stepA_mal.go b/impls/go/src/stepA_mal/stepA_mal.go index dae2e4bb34..cd7c614f54 100644 --- a/impls/go/src/stepA_mal/stepA_mal.go +++ b/impls/go/src/stepA_mal/stepA_mal.go @@ -67,67 +67,28 @@ func quasiquote(ast MalType) MalType { } } -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:]) +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 ast, nil + return lst, nil } -func eval_ast(ast MalType, env EnvType) (MalType, error) { - //fmt.Printf("eval_ast: %#v\n", ast) +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 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) + lst, e := map_eval(ast.(Vector).Val, env) + if e != nil { + return nil, e } return Vector{lst, nil}, nil } else if HashMap_Q(ast) { @@ -141,30 +102,10 @@ func eval_ast(ast MalType, env EnvType) (MalType, error) { new_hm.Val[k] = kv } return new_hm, nil - } else { + } else if !List_Q(ast) { 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) - } - + } else { // 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 } @@ -217,8 +158,6 @@ 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!": @@ -228,8 +167,6 @@ func EVAL(ast MalType, env EnvType) (MalType, error) { 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) @@ -260,7 +197,7 @@ func EVAL(ast MalType, env EnvType) (MalType, error) { } case "do": lst := ast.(List).Val - _, e := eval_ast(List{lst[1 : len(lst)-1], nil}, env) + _, e := map_eval(lst[1 : len(lst)-1], env) if e != nil { return nil, e } @@ -286,15 +223,27 @@ func EVAL(ast MalType, env EnvType) (MalType, error) { fn := MalFunc{EVAL, a2, env, a1, false, NewEnv, nil} return fn, nil default: - el, e := eval_ast(ast, env) + 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 } - 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}) + env, e = NewEnv(fn.Env, fn.Params, List{args, nil}) if e != nil { return nil, e } @@ -303,10 +252,10 @@ func EVAL(ast MalType, env EnvType) (MalType, error) { if !ok { return nil, errors.New("attempt to call non-function") } - return fn.Fn(el.(List).Val[1:]) + return fn.Fn(args) } } - + } } // TCO loop } diff --git a/impls/groovy/env.groovy b/impls/groovy/env.groovy index 8ff0e514b0..be3fabb5e0 100644 --- a/impls/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/impls/groovy/step2_eval.groovy b/impls/groovy/step2_eval.groovy index 5fff657fbf..f58666c7ce 100644 --- a/impls/groovy/step2_eval.groovy +++ b/impls/groovy/step2_eval.groovy @@ -10,15 +10,17 @@ READ = { str -> } // EVAL -eval_ast = { ast, env -> +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: - return types.vector_Q(ast) ? - types.vector(ast.collect { EVAL(it,env) }) : - ast.collect { EVAL(it,env) } + 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 -> @@ -28,13 +30,10 @@ eval_ast = { ast, env -> 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 el = ast.collect { EVAL(it, env) } def (f, args) = [el[0], el[1..-1]] f(args) } diff --git a/impls/groovy/step3_env.groovy b/impls/groovy/step3_env.groovy index 66408b5d48..dd38ee3cc3 100644 --- a/impls/groovy/step3_env.groovy +++ b/impls/groovy/step3_env.groovy @@ -11,12 +11,21 @@ READ = { str -> } // EVAL -eval_ast = { ast, env -> +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); - 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[k] = EVAL(v, env) @@ -24,11 +33,7 @@ eval_ast = { ast, 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]) { @@ -41,7 +46,7 @@ EVAL = { ast, env -> } return EVAL(ast[2], let_env) default: - def el = eval_ast(ast, env) + def el = ast.collect { EVAL(it, env) } def (f, args) = [el[0], el[1..-1]] f(args) } diff --git a/impls/groovy/step4_if_fn_do.groovy b/impls/groovy/step4_if_fn_do.groovy index 5d873f910b..69fad95398 100644 --- a/impls/groovy/step4_if_fn_do.groovy +++ b/impls/groovy/step4_if_fn_do.groovy @@ -13,12 +13,21 @@ READ = { str -> } // EVAL -eval_ast = { ast, env -> +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); - 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[k] = EVAL(v, env) @@ -26,11 +35,7 @@ eval_ast = { ast, 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]) { @@ -43,7 +48,7 @@ EVAL = { ast, env -> } return EVAL(ast[2], let_env) case { it instanceof MalSymbol && it.value == "do" }: - return eval_ast(ast[1..-1], env)[-1] + 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) { @@ -58,7 +63,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] : []] f(args) } diff --git a/impls/groovy/step5_tco.groovy b/impls/groovy/step5_tco.groovy index fb020fc799..d83fcc4f90 100644 --- a/impls/groovy/step5_tco.groovy +++ b/impls/groovy/step5_tco.groovy @@ -13,12 +13,22 @@ 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[k] = EVAL(v, env) @@ -26,12 +36,7 @@ eval_ast = { ast, 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) diff --git a/impls/groovy/step6_file.groovy b/impls/groovy/step6_file.groovy index 95ab1c22b2..a0536a80fa 100644 --- a/impls/groovy/step6_file.groovy +++ b/impls/groovy/step6_file.groovy @@ -13,12 +13,22 @@ 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[k] = EVAL(v, env) @@ -26,12 +36,7 @@ eval_ast = { ast, 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) diff --git a/impls/groovy/step7_quote.groovy b/impls/groovy/step7_quote.groovy index b6010efb85..8e028d5911 100644 --- a/impls/groovy/step7_quote.groovy +++ b/impls/groovy/step7_quote.groovy @@ -46,12 +46,22 @@ quasiquote = { ast -> } } -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[k] = EVAL(v, env) @@ -59,12 +69,7 @@ eval_ast = { ast, 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]) { @@ -80,13 +85,11 @@ EVAL = { ast, env -> break // TCO case { it instanceof MalSymbol && it.value == "quote" }: return ast[1] - case { it instanceof MalSymbol && it.value == "quasiquoteexpand" }: - return quasiquote(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.size() > 2 ? ast[1..-2].collect { EVAL(it, env) } : null ast = ast[-1] break // TCO case { it instanceof MalSymbol && it.value == "if" }: @@ -105,7 +108,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) diff --git a/impls/groovy/step8_macros.groovy b/impls/groovy/step8_macros.groovy index a7c110d421..082d592b76 100644 --- a/impls/groovy/step8_macros.groovy +++ b/impls/groovy/step8_macros.groovy @@ -13,26 +13,6 @@ READ = { 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 -} - starts_with = { lst, sym -> lst.size() == 2 && lst[0].class == MalSymbol && lst[0].value == sym } @@ -66,12 +46,22 @@ quasiquote = { ast -> } } -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[k] = EVAL(v, env) @@ -79,15 +69,7 @@ eval_ast = { ast, 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]) { @@ -103,8 +85,6 @@ EVAL = { ast, env -> break // TCO case { it instanceof MalSymbol && it.value == "quote" }: return ast[1] - case { it instanceof MalSymbol && it.value == "quasiquoteexpand" }: - return quasiquote(ast[1]) case { it instanceof MalSymbol && it.value == "quasiquote" }: ast = quasiquote(ast[1]) break // TCO @@ -113,10 +93,8 @@ EVAL = { ast, env -> f = f.clone() 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.size() > 2 ? ast[1..-2].collect { EVAL(it, env) } : null ast = ast[-1] break // TCO case { it instanceof MalSymbol && it.value == "if" }: @@ -135,8 +113,13 @@ 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 (f, args) = [el[0], el.drop(1)] + 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 diff --git a/impls/groovy/step9_try.groovy b/impls/groovy/step9_try.groovy index 46d68f583a..5a35b96d3a 100644 --- a/impls/groovy/step9_try.groovy +++ b/impls/groovy/step9_try.groovy @@ -13,26 +13,6 @@ READ = { 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 -} - starts_with = { lst, sym -> lst.size() == 2 && lst[0].class == MalSymbol && lst[0].value == sym } @@ -66,12 +46,22 @@ quasiquote = { ast -> } } -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[k] = EVAL(v, env) @@ -79,15 +69,7 @@ eval_ast = { ast, 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]) { @@ -103,8 +85,6 @@ EVAL = { ast, env -> break // TCO case { it instanceof MalSymbol && it.value == "quote" }: return ast[1] - case { it instanceof MalSymbol && it.value == "quasiquoteexpand" }: - return quasiquote(ast[1]) case { it instanceof MalSymbol && it.value == "quasiquote" }: ast = quasiquote(ast[1]) break // TCO @@ -113,8 +93,6 @@ EVAL = { ast, env -> f = f.clone() 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) @@ -134,7 +112,7 @@ EVAL = { ast, env -> } } 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" }: @@ -153,8 +131,13 @@ 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 (f, args) = [el[0], el.drop(1)] + 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 diff --git a/impls/groovy/stepA_mal.groovy b/impls/groovy/stepA_mal.groovy index 44aeb28f50..e32fcb8804 100644 --- a/impls/groovy/stepA_mal.groovy +++ b/impls/groovy/stepA_mal.groovy @@ -13,26 +13,6 @@ READ = { 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 -} - starts_with = { lst, sym -> lst.size() == 2 && lst[0].class == MalSymbol && lst[0].value == sym } @@ -66,12 +46,22 @@ quasiquote = { ast -> } } -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[k] = EVAL(v, env) @@ -79,15 +69,7 @@ eval_ast = { ast, 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]) { @@ -103,8 +85,6 @@ EVAL = { ast, env -> break // TCO case { it instanceof MalSymbol && it.value == "quote" }: return ast[1] - case { it instanceof MalSymbol && it.value == "quasiquoteexpand" }: - return quasiquote(ast[1]) case { it instanceof MalSymbol && it.value == "quasiquote" }: ast = quasiquote(ast[1]) break // TCO @@ -113,8 +93,6 @@ EVAL = { ast, env -> f = f.clone() 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) @@ -134,7 +112,7 @@ EVAL = { ast, env -> } } 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" }: @@ -153,8 +131,13 @@ 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 (f, args) = [el[0], el.drop(1)] + 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 diff --git a/impls/guile/step2_eval.scm b/impls/guile/step2_eval.scm index d7b85ac3ce..c51ce77e82 100644 --- a/impls/guile/step2_eval.scm +++ b/impls/guile/step2_eval.scm @@ -13,7 +13,7 @@ ;; 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)) +(import (readline) (reader) (printer) (ice-9 match) (srfi srfi-43) (types)) (define *toplevel* `((+ . ,+) @@ -24,27 +24,22 @@ (define (READ str) (read_str str)) -(define (eval_ast ast env) - (define (_eval x) (EVAL x env)) +(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)))) - ((? list? lst) (map _eval lst)) - ((? vector? vec) (vector-map (lambda (i x) (_eval x)) vec)) + ((? 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))) ht) + (hash-for-each (lambda (k v) (hash-set! new-ht k (EVAL v env))) ht) new-ht) - (else ast))) - -(define (EVAL ast env) - (match ast + ((? non-list?) ast) (() ast) - ((? list?) - (let ((el (eval_ast ast env))) - (apply (car el) (cdr el)))) - (else (eval_ast ast env)))) + (else + (let ((el (map (lambda (x) (EVAL x env)) ast))) + (apply (car el) (cdr el)))))) (define (PRINT exp) (and (not (eof-object? exp)) diff --git a/impls/guile/step3_env.scm b/impls/guile/step3_env.scm index c3798c6292..80dede1be7 100644 --- a/impls/guile/step3_env.scm +++ b/impls/guile/step3_env.scm @@ -14,7 +14,7 @@ ;; along with this program. If not, see . (import (readline) (reader) (printer) (ice-9 match) (srfi srfi-43) - (srfi srfi-1) (ice-9 receive) (env)) + (srfi srfi-1) (ice-9 receive) (env) (types)) (define *primitives* `((+ ,+) @@ -29,18 +29,6 @@ (define (READ str) (read_str str)) -(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) - (define new-ht (make-hash-table)) - (hash-for-each (lambda (k v) (hash-set! new-ht k (_eval v))) ht) - new-ht) - (else ast))) - (define (EVAL ast env) (define (->list kvs) ((if (vector? kvs) vector->list identity) kvs)) (define (%unzip2 kvs) @@ -51,8 +39,16 @@ ((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 - ((? (lambda (x) (not (list? x)))) (eval_ast ast env)) + ((? 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) @@ -62,7 +58,7 @@ (for-each setter keys vals)) (EVAL body new-env))) (else - (let ((el (eval_ast ast env))) + (let ((el (map (lambda (x) (EVAL x env)) ast))) (apply (car el) (cdr el)))))) (define (PRINT exp) diff --git a/impls/guile/step4_if_fn_do.scm b/impls/guile/step4_if_fn_do.scm index af4c7e816b..04ec536f05 100644 --- a/impls/guile/step4_if_fn_do.scm +++ b/impls/guile/step4_if_fn_do.scm @@ -23,19 +23,6 @@ (define (READ str) (read_str str)) -(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) - (define new-ht (make-hash-table)) - (hash-for-each (lambda (k v) (hash-set! new-ht k (_eval v))) ht) - new-ht) - (else ast))) - (define (eval_seq ast env) (cond ((null? ast) nil) @@ -53,8 +40,16 @@ ((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 - ((? non-list?) (eval_ast ast env)) + ((? 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) diff --git a/impls/guile/step5_tco.scm b/impls/guile/step5_tco.scm index c75e01942f..d6b02c84cc 100644 --- a/impls/guile/step5_tco.scm +++ b/impls/guile/step5_tco.scm @@ -23,19 +23,6 @@ (define (READ str) (read_str str)) -(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) - (define new-ht (make-hash-table)) - (hash-for-each (lambda (k v) (hash-set! new-ht k (_eval v))) ht) - new-ht) - (else ast))) - (define (eval_seq ast env) (cond ((null? ast) nil) @@ -61,8 +48,16 @@ ;; 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 - ((? non-list?) (eval_ast ast env)) + ((? 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) diff --git a/impls/guile/step6_file.scm b/impls/guile/step6_file.scm index 1f12845214..65abd952ad 100644 --- a/impls/guile/step6_file.scm +++ b/impls/guile/step6_file.scm @@ -23,19 +23,6 @@ (define (READ str) (read_str str)) -(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) - (define new-ht (make-hash-table)) - (hash-for-each (lambda (k v) (hash-set! new-ht k (_eval v))) ht) - new-ht) - (else ast))) - (define (eval_seq ast env) (cond ((null? ast) nil) @@ -61,8 +48,16 @@ ;; 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 - ((? non-list?) (eval_ast ast env)) + ((? 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) diff --git a/impls/guile/step7_quote.scm b/impls/guile/step7_quote.scm index 8a7d8422d2..cea87b44f7 100644 --- a/impls/guile/step7_quote.scm +++ b/impls/guile/step7_quote.scm @@ -23,19 +23,6 @@ (define (READ str) (read_str str)) -(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) - (define new-ht (make-hash-table)) - (hash-for-each (lambda (k v) (hash-set! new-ht k (_eval v))) ht) - new-ht) - (else ast))) - (define (eval_seq ast env) (cond ((null? ast) nil) @@ -67,11 +54,18 @@ (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 - ((? non-list?) (eval_ast ast env)) + ((? 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) - (('quasiquoteexpand obj) (_quasiquote obj)) (('quasiquote obj) (EVAL (_quasiquote obj) env)) (('def! k v) ((env 'set) k (EVAL v env))) (('let* kvs body) diff --git a/impls/guile/step8_macros.scm b/impls/guile/step8_macros.scm index e58f4eb991..f98c096f7b 100644 --- a/impls/guile/step8_macros.scm +++ b/impls/guile/step8_macros.scm @@ -23,19 +23,6 @@ (define (READ str) (read_str str)) -(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) - (define new-ht (make-hash-table)) - (hash-for-each (lambda (k v) (hash-set! new-ht k (_eval v))) ht) - new-ht) - (else ast))) - (define (eval_seq ast env) (cond ((null? ast) nil) @@ -57,20 +44,6 @@ ((? symbol?) (list 'quote ast)) (else ast))) -(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 '())) @@ -81,16 +54,21 @@ (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 - (let ((ast (_macroexpand ast env))) + (when (cond-true? (env-check 'DEBUG-EVAL env)) + (format #t "EVAL: ~a~%" (pr_str ast #t))) (match ast - ((? non-list?) (eval_ast ast env)) + ((? 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)))) - (('macroexpand obj) (_macroexpand obj env)) (('quote obj) obj) - (('quasiquoteexpand obj) (_quasiquote obj)) (('quasiquote obj) (EVAL (_quasiquote obj) env)) (('def! k v) ((env 'set) k (EVAL v env))) (('let* kvs body) @@ -131,8 +109,11 @@ (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)))))))) + (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*)) diff --git a/impls/guile/step9_try.scm b/impls/guile/step9_try.scm index 91f3dad7d5..951cbd0d4f 100644 --- a/impls/guile/step9_try.scm +++ b/impls/guile/step9_try.scm @@ -32,20 +32,6 @@ (define (READ str) (read_str str)) -(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) - (define new-ht (make-hash-table)) - (hash-for-each (lambda (k v) (hash-set! new-ht k (_eval v))) ht) - new-ht) - (else ast))) - - (define (eval_seq ast env) (cond ((null? ast) nil) @@ -67,22 +53,6 @@ ((? symbol?) (list 'quote ast)) (else ast))) -(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 '())) @@ -93,17 +63,21 @@ (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 - ;;(format #t "CCC: ~a === ~a~%" ast (_macroexpand ast env)) - (let ((ast (_macroexpand ast env))) + (when (cond-true? (env-check 'DEBUG-EVAL env)) + (format #t "EVAL: ~a~%" (pr_str ast #t))) (match ast - ((? non-list?) (eval_ast ast env)) + ((? 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)))) - (('macroexpand obj) (_macroexpand obj env)) (('quote obj) obj) - (('quasiquoteexpand obj) (_quasiquote obj)) (('quasiquote obj) (EVAL (_quasiquote obj) env)) (('def! k v) ((env 'set) k (EVAL v env))) (('let* kvs body) @@ -153,8 +127,11 @@ (let ((nenv (make-Env #:outer env #:binds (list B) #:exprs (cdr e)))) (EVAL C nenv))))) (else - (let ((el (map (lambda (x) (EVAL x env)) ast))) - (callable-apply (car el) (cdr el)))))))) + (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*)) diff --git a/impls/guile/stepA_mal.scm b/impls/guile/stepA_mal.scm index a010273e1b..4372a03a0e 100644 --- a/impls/guile/stepA_mal.scm +++ b/impls/guile/stepA_mal.scm @@ -32,20 +32,6 @@ (define (READ str) (read_str str)) -(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) - (define new-ht (make-hash-table)) - (hash-for-each (lambda (k v) (hash-set! new-ht k (_eval v))) ht) - new-ht) - (else ast))) - - (define (eval_seq ast env) (cond ((null? ast) nil) @@ -67,20 +53,6 @@ ((? symbol?) (list 'quote ast)) (else ast))) -(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 '())) @@ -91,16 +63,21 @@ (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 - (let ((ast (_macroexpand ast env))) + (when (cond-true? (env-check 'DEBUG-EVAL env)) + (format #t "EVAL: ~a~%" (pr_str ast #t))) (match ast - ((? non-list?) (eval_ast ast env)) + ((? 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)))) - (('macroexpand obj) (_macroexpand obj env)) (('quote obj) obj) - (('quasiquoteexpand obj) (_quasiquote obj)) (('quasiquote obj) (EVAL (_quasiquote obj) env)) (('def! k v) ((env 'set) k (EVAL v env))) (('let* kvs body) @@ -150,8 +127,11 @@ (let ((nenv (make-Env #:outer env #:binds (list B) #:exprs (cdr e)))) (EVAL C nenv))))) (else - (let ((el (map (lambda (x) (EVAL x env)) ast))) - (callable-apply (car el) (cdr el)))))))) + (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*)) diff --git a/impls/haskell/step3_env.hs b/impls/haskell/step3_env.hs index 4edb7489d0..2043eaae30 100644 --- a/impls/haskell/step3_env.hs +++ b/impls/haskell/step3_env.hs @@ -7,12 +7,6 @@ import Reader (read_str) import Printer (_pr_list, _pr_str) import Env (Env, env_get, env_let, env_put, env_repl, env_set) --- --- Set this to True for a trace of each call to Eval. --- -traceEval :: Bool -traceEval = False - -- read mal_read :: String -> IOThrows MalVal @@ -49,15 +43,18 @@ apply_ast first rest env = do eval :: Env -> MalVal -> IOThrows MalVal eval env ast = do + traceEval <- liftIO $ env_get env "DEBUG-EVAL" case traceEval of - True -> liftIO $ do + Nothing -> pure () + Just Nil -> pure () + Just (MalBoolean False) -> pure () + Just _ -> liftIO $ do putStr "EVAL: " putStr =<< _pr_str True ast putStr " " env_put env putStrLn "" hFlush stdout - False -> pure () case ast of MalSymbol sym -> do maybeVal <- liftIO $ env_get env sym diff --git a/impls/haskell/step4_if_fn_do.hs b/impls/haskell/step4_if_fn_do.hs index bfc2e49aa0..acba2ce0a0 100644 --- a/impls/haskell/step4_if_fn_do.hs +++ b/impls/haskell/step4_if_fn_do.hs @@ -9,12 +9,6 @@ import Printer(_pr_list, _pr_str) import Env (Env, env_apply, env_get, env_let, env_put, env_repl, env_set) import Core (ns) --- --- Set this to True for a trace of each call to Eval. --- -traceEval :: Bool -traceEval = False - -- read mal_read :: String -> IOThrows MalVal @@ -78,15 +72,18 @@ apply_ast first rest env = do eval :: Env -> MalVal -> IOThrows MalVal eval env ast = do + traceEval <- liftIO $ env_get env "DEBUG-EVAL" case traceEval of - True -> liftIO $ do + Nothing -> pure () + Just Nil -> pure () + Just (MalBoolean False) -> pure () + Just _ -> liftIO $ do putStr "EVAL: " putStr =<< _pr_str True ast putStr " " env_put env putStrLn "" hFlush stdout - False -> pure () case ast of MalSymbol sym -> do maybeVal <- liftIO $ env_get env sym diff --git a/impls/haskell/step5_tco.hs b/impls/haskell/step5_tco.hs index bfc2e49aa0..acba2ce0a0 100644 --- a/impls/haskell/step5_tco.hs +++ b/impls/haskell/step5_tco.hs @@ -9,12 +9,6 @@ import Printer(_pr_list, _pr_str) import Env (Env, env_apply, env_get, env_let, env_put, env_repl, env_set) import Core (ns) --- --- Set this to True for a trace of each call to Eval. --- -traceEval :: Bool -traceEval = False - -- read mal_read :: String -> IOThrows MalVal @@ -78,15 +72,18 @@ apply_ast first rest env = do eval :: Env -> MalVal -> IOThrows MalVal eval env ast = do + traceEval <- liftIO $ env_get env "DEBUG-EVAL" case traceEval of - True -> liftIO $ do + Nothing -> pure () + Just Nil -> pure () + Just (MalBoolean False) -> pure () + Just _ -> liftIO $ do putStr "EVAL: " putStr =<< _pr_str True ast putStr " " env_put env putStrLn "" hFlush stdout - False -> pure () case ast of MalSymbol sym -> do maybeVal <- liftIO $ env_get env sym diff --git a/impls/haskell/step6_file.hs b/impls/haskell/step6_file.hs index 01f28a8e3f..56ff9539af 100644 --- a/impls/haskell/step6_file.hs +++ b/impls/haskell/step6_file.hs @@ -10,12 +10,6 @@ import Printer(_pr_list, _pr_str) import Env (Env, env_apply, env_get, env_let, env_put, env_repl, env_set) import Core (ns) --- --- Set this to True for a trace of each call to Eval. --- -traceEval :: Bool -traceEval = False - -- read mal_read :: String -> IOThrows MalVal @@ -79,15 +73,18 @@ apply_ast first rest env = do eval :: Env -> MalVal -> IOThrows MalVal eval env ast = do + traceEval <- liftIO $ env_get env "DEBUG-EVAL" case traceEval of - True -> liftIO $ do + Nothing -> pure () + Just Nil -> pure () + Just (MalBoolean False) -> pure () + Just _ -> liftIO $ do putStr "EVAL: " putStr =<< _pr_str True ast putStr " " env_put env putStrLn "" hFlush stdout - False -> pure () case ast of MalSymbol sym -> do maybeVal <- liftIO $ env_get env sym diff --git a/impls/haskell/step7_quote.hs b/impls/haskell/step7_quote.hs index 26a4130a1a..25bd80402f 100644 --- a/impls/haskell/step7_quote.hs +++ b/impls/haskell/step7_quote.hs @@ -10,12 +10,6 @@ import Printer(_pr_list, _pr_str) import Env (Env, env_apply, env_get, env_let, env_put, env_repl, env_set) import Core (ns) --- --- Set this to True for a trace of each call to Eval. --- -traceEval :: Bool -traceEval = False - -- read mal_read :: String -> IOThrows MalVal @@ -65,9 +59,6 @@ apply_ast (MalSymbol "let*") _ _ = throwStr "invalid let*" apply_ast (MalSymbol "quote") [a1] _ = return a1 apply_ast (MalSymbol "quote") _ _ = throwStr "invalid quote" -apply_ast (MalSymbol "quasiquoteexpand") [a1] _ = quasiquote a1 -apply_ast (MalSymbol "quasiquoteexpand") _ _ = throwStr "invalid quasiquote" - apply_ast (MalSymbol "quasiquote") [a1] env = eval env =<< quasiquote a1 apply_ast (MalSymbol "quasiquote") _ _ = throwStr "invalid quasiquote" @@ -106,15 +97,18 @@ apply_ast first rest env = do eval :: Env -> MalVal -> IOThrows MalVal eval env ast = do + traceEval <- liftIO $ env_get env "DEBUG-EVAL" case traceEval of - True -> liftIO $ do + Nothing -> pure () + Just Nil -> pure () + Just (MalBoolean False) -> pure () + Just _ -> liftIO $ do putStr "EVAL: " putStr =<< _pr_str True ast putStr " " env_put env putStrLn "" hFlush stdout - False -> pure () case ast of MalSymbol sym -> do maybeVal <- liftIO $ env_get env sym diff --git a/impls/haskell/step8_macros.hs b/impls/haskell/step8_macros.hs index d49acf1b27..9ceea18c2f 100644 --- a/impls/haskell/step8_macros.hs +++ b/impls/haskell/step8_macros.hs @@ -10,12 +10,6 @@ import Printer(_pr_list, _pr_str) import Env (Env, env_apply, env_get, env_let, env_put, env_repl, env_set) import Core (ns) --- --- Set this to True for a trace of each call to Eval. --- -traceEval :: Bool -traceEval = False - -- read mal_read :: String -> IOThrows MalVal @@ -41,14 +35,6 @@ quasiquote ast@(MalHashMap _ _) = return $ toList [MalSymbol "quote", ast] quasiquote ast@(MalSymbol _) = return $ toList [MalSymbol "quote", ast] quasiquote ast = return ast -macroexpand :: Env -> MalVal -> IOThrows MalVal -macroexpand env ast@(MalSeq _ (Vect False) (MalSymbol a0 : args)) = do - maybeMacro <- liftIO $ env_get env a0 - case maybeMacro of - Just (MalMacro f) -> macroexpand env =<< f args - _ -> return ast -macroexpand _ ast = return ast - let_bind :: Env -> [MalVal] -> IOThrows () let_bind _ [] = return () let_bind env (MalSymbol b : e : xs) = do @@ -73,9 +59,6 @@ apply_ast (MalSymbol "let*") _ _ = throwStr "invalid let*" apply_ast (MalSymbol "quote") [a1] _ = return a1 apply_ast (MalSymbol "quote") _ _ = throwStr "invalid quote" -apply_ast (MalSymbol "quasiquoteexpand") [a1] _ = quasiquote a1 -apply_ast (MalSymbol "quasiquoteexpand") _ _ = throwStr "invalid quasiquote" - apply_ast (MalSymbol "quasiquote") [a1] env = eval env =<< quasiquote a1 apply_ast (MalSymbol "quasiquote") _ _ = throwStr "invalid quasiquote" @@ -89,9 +72,6 @@ apply_ast (MalSymbol "defmacro!") [MalSymbol a1, a2] env = do _ -> throwStr "defmacro! on non-function" apply_ast (MalSymbol "defmacro!") _ _ = throwStr "invalid defmacro!" -apply_ast (MalSymbol "macroexpand") [a1] env = macroexpand env a1 -apply_ast (MalSymbol "macroexpand") _ _ = throwStr "invalid macroexpand" - apply_ast (MalSymbol "do") args env = foldlM (const $ eval env) Nil args apply_ast (MalSymbol "if") [a1, a2, a3] env = do @@ -128,15 +108,18 @@ apply_ast first rest env = do eval :: Env -> MalVal -> IOThrows MalVal eval env ast = do + traceEval <- liftIO $ env_get env "DEBUG-EVAL" case traceEval of - True -> liftIO $ do + Nothing -> pure () + Just Nil -> pure () + Just (MalBoolean False) -> pure () + Just _ -> liftIO $ do putStr "EVAL: " putStr =<< _pr_str True ast putStr " " env_put env putStrLn "" hFlush stdout - False -> pure () case ast of MalSymbol sym -> do maybeVal <- liftIO $ env_get env sym diff --git a/impls/haskell/step9_try.hs b/impls/haskell/step9_try.hs index d2c26837a1..483019d872 100644 --- a/impls/haskell/step9_try.hs +++ b/impls/haskell/step9_try.hs @@ -10,12 +10,6 @@ import Printer(_pr_list, _pr_str) import Env (Env, env_apply, env_get, env_let, env_put, env_repl, env_set) import Core (ns) --- --- Set this to True for a trace of each call to Eval. --- -traceEval :: Bool -traceEval = False - -- read mal_read :: String -> IOThrows MalVal @@ -41,14 +35,6 @@ quasiquote ast@(MalHashMap _ _) = return $ toList [MalSymbol "quote", ast] quasiquote ast@(MalSymbol _) = return $ toList [MalSymbol "quote", ast] quasiquote ast = return ast -macroexpand :: Env -> MalVal -> IOThrows MalVal -macroexpand env ast@(MalSeq _ (Vect False) (MalSymbol a0 : args)) = do - maybeMacro <- liftIO $ env_get env a0 - case maybeMacro of - Just (MalMacro f) -> macroexpand env =<< f args - _ -> return ast -macroexpand _ ast = return ast - let_bind :: Env -> [MalVal] -> IOThrows () let_bind _ [] = return () let_bind env (MalSymbol b : e : xs) = do @@ -73,9 +59,6 @@ apply_ast (MalSymbol "let*") _ _ = throwStr "invalid let*" apply_ast (MalSymbol "quote") [a1] _ = return a1 apply_ast (MalSymbol "quote") _ _ = throwStr "invalid quote" -apply_ast (MalSymbol "quasiquoteexpand") [a1] _ = quasiquote a1 -apply_ast (MalSymbol "quasiquoteexpand") _ _ = throwStr "invalid quasiquote" - apply_ast (MalSymbol "quasiquote") [a1] env = eval env =<< quasiquote a1 apply_ast (MalSymbol "quasiquote") _ _ = throwStr "invalid quasiquote" @@ -89,9 +72,6 @@ apply_ast (MalSymbol "defmacro!") [MalSymbol a1, a2] env = do _ -> throwStr "defmacro! on non-function" apply_ast (MalSymbol "defmacro!") _ _ = throwStr "invalid defmacro!" -apply_ast (MalSymbol "macroexpand") [a1] env = macroexpand env a1 -apply_ast (MalSymbol "macroexpand") _ _ = throwStr "invalid macroexpand" - apply_ast (MalSymbol "try*") [a1] env = eval env a1 apply_ast (MalSymbol "try*") [a1, MalSeq _ (Vect False) [MalSymbol "catch*", a21, a22]] env = do res <- liftIO $ runExceptT $ eval env a1 @@ -138,15 +118,18 @@ apply_ast first rest env = do eval :: Env -> MalVal -> IOThrows MalVal eval env ast = do + traceEval <- liftIO $ env_get env "DEBUG-EVAL" case traceEval of - True -> liftIO $ do + Nothing -> pure () + Just Nil -> pure () + Just (MalBoolean False) -> pure () + Just _ -> liftIO $ do putStr "EVAL: " putStr =<< _pr_str True ast putStr " " env_put env putStrLn "" hFlush stdout - False -> pure () case ast of MalSymbol sym -> do maybeVal <- liftIO $ env_get env sym diff --git a/impls/haskell/stepA_mal.hs b/impls/haskell/stepA_mal.hs index 3e3517282d..8661f0fe15 100644 --- a/impls/haskell/stepA_mal.hs +++ b/impls/haskell/stepA_mal.hs @@ -10,12 +10,6 @@ import Printer(_pr_list, _pr_str) import Env (Env, env_apply, env_get, env_let, env_put, env_repl, env_set) import Core (ns) --- --- Set this to True for a trace of each call to Eval. --- -traceEval :: Bool -traceEval = False - -- read mal_read :: String -> IOThrows MalVal @@ -41,14 +35,6 @@ quasiquote ast@(MalHashMap _ _) = return $ toList [MalSymbol "quote", ast] quasiquote ast@(MalSymbol _) = return $ toList [MalSymbol "quote", ast] quasiquote ast = return ast -macroexpand :: Env -> MalVal -> IOThrows MalVal -macroexpand env ast@(MalSeq _ (Vect False) (MalSymbol a0 : args)) = do - maybeMacro <- liftIO $ env_get env a0 - case maybeMacro of - Just (MalMacro f) -> macroexpand env =<< f args - _ -> return ast -macroexpand _ ast = return ast - let_bind :: Env -> [MalVal] -> IOThrows () let_bind _ [] = return () let_bind env (MalSymbol b : e : xs) = do @@ -73,9 +59,6 @@ apply_ast (MalSymbol "let*") _ _ = throwStr "invalid let*" apply_ast (MalSymbol "quote") [a1] _ = return a1 apply_ast (MalSymbol "quote") _ _ = throwStr "invalid quote" -apply_ast (MalSymbol "quasiquoteexpand") [a1] _ = quasiquote a1 -apply_ast (MalSymbol "quasiquoteexpand") _ _ = throwStr "invalid quasiquote" - apply_ast (MalSymbol "quasiquote") [a1] env = eval env =<< quasiquote a1 apply_ast (MalSymbol "quasiquote") _ _ = throwStr "invalid quasiquote" @@ -89,9 +72,6 @@ apply_ast (MalSymbol "defmacro!") [MalSymbol a1, a2] env = do _ -> throwStr "defmacro! on non-function" apply_ast (MalSymbol "defmacro!") _ _ = throwStr "invalid defmacro!" -apply_ast (MalSymbol "macroexpand") [a1] env = macroexpand env a1 -apply_ast (MalSymbol "macroexpand") _ _ = throwStr "invalid macroexpand" - apply_ast (MalSymbol "try*") [a1] env = eval env a1 apply_ast (MalSymbol "try*") [a1, MalSeq _ (Vect False) [MalSymbol "catch*", a21, a22]] env = do res <- liftIO $ runExceptT $ eval env a1 @@ -138,15 +118,18 @@ apply_ast first rest env = do eval :: Env -> MalVal -> IOThrows MalVal eval env ast = do + traceEval <- liftIO $ env_get env "DEBUG-EVAL" case traceEval of - True -> liftIO $ do + Nothing -> pure () + Just Nil -> pure () + Just (MalBoolean False) -> pure () + Just _ -> liftIO $ do putStr "EVAL: " putStr =<< _pr_str True ast putStr " " env_put env putStrLn "" hFlush stdout - False -> pure () case ast of MalSymbol sym -> do maybeVal <- liftIO $ env_get env sym diff --git a/impls/haxe/Step2_eval.hx b/impls/haxe/Step2_eval.hx index 02d34f4a54..993eecdb65 100644 --- a/impls/haxe/Step2_eval.hx +++ b/impls/haxe/Step2_eval.hx @@ -11,40 +11,34 @@ class Step2_eval { } // EVAL - static function eval_ast(ast:MalType, env:Map) { - return switch (ast) { + static function EVAL(ast:MalType, env:Map) { + // Compat.println("EVAL: " + PRINT(ast)); + var alst; + switch (ast) { case MalSymbol(s): if (env.exists(s)) { - env.get(s); + return env.get(s); } else { throw "'" + s + "' not found"; } 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: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); + 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"; } } diff --git a/impls/haxe/Step3_env.hx b/impls/haxe/Step3_env.hx index 5166025841..eec34d028f 100644 --- a/impls/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"; } } diff --git a/impls/haxe/Step4_if_fn_do.hx b/impls/haxe/Step4_if_fn_do.hx index 6821da74fa..d48d9cc052 100644 --- a/impls/haxe/Step4_if_fn_do.hx +++ b/impls/haxe/Step4_if_fn_do.hx @@ -14,30 +14,30 @@ class Step4_if_fn_do { } // 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 = _list(ast); if (alst.length == 0) { return ast; } - switch (alst[0]) { case MalSymbol("def!"): return env.set(alst[1], EVAL(alst[2], env)); @@ -53,7 +53,9 @@ class Step4_if_fn_do { } return EVAL(alst[2], let_env); case MalSymbol("do"): - return last(eval_ast(MalList(alst.slice(1)), env)); + 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) { @@ -68,10 +70,10 @@ class Step4_if_fn_do { 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)); + 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"; } } diff --git a/impls/haxe/Step5_tco.hx b/impls/haxe/Step5_tco.hx index f1b69b9c67..7176aca768 100644 --- a/impls/haxe/Step5_tco.hx +++ b/impls/haxe/Step5_tco.hx @@ -14,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)); @@ -56,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); @@ -74,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); diff --git a/impls/haxe/Step6_file.hx b/impls/haxe/Step6_file.hx index 1eb5288db9..fab62295c6 100644 --- a/impls/haxe/Step6_file.hx +++ b/impls/haxe/Step6_file.hx @@ -14,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)); @@ -56,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); @@ -74,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); diff --git a/impls/haxe/Step7_quote.hx b/impls/haxe/Step7_quote.hx index a42b36c424..93b7009dac 100644 --- a/impls/haxe/Step7_quote.hx +++ b/impls/haxe/Step7_quote.hx @@ -39,31 +39,31 @@ class Step7_quote { } } - 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)); @@ -82,14 +82,13 @@ class Step7_quote { continue; // TCO case MalSymbol("quote"): return alst[1]; - case MalSymbol("quasiquoteexpand"): - return quasiquote(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); + 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); @@ -106,11 +105,9 @@ class Step7_quote { 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); diff --git a/impls/haxe/Step8_macros.hx b/impls/haxe/Step8_macros.hx index d76a54c773..bef3954eef 100644 --- a/impls/haxe/Step8_macros.hx +++ b/impls/haxe/Step8_macros.hx @@ -39,56 +39,30 @@ class Step8_macros { } } - 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); + 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 - 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!"): @@ -108,8 +82,6 @@ class Step8_macros { continue; // TCO case MalSymbol("quote"): return alst[1]; - case MalSymbol("quasiquoteexpand"): - return quasiquote(alst[1]); case MalSymbol("quasiquote"): ast = quasiquote(alst[1]); continue; // TCO @@ -121,11 +93,10 @@ class Step8_macros { 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); + 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); @@ -142,11 +113,13 @@ class Step8_macros { 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); + 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); diff --git a/impls/haxe/Step9_try.hx b/impls/haxe/Step9_try.hx index e2bfbeafce..651c96d092 100644 --- a/impls/haxe/Step9_try.hx +++ b/impls/haxe/Step9_try.hx @@ -40,56 +40,30 @@ class Step9_try { } } - 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); + 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 - 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!"): @@ -109,8 +83,6 @@ class Step9_try { continue; // TCO case MalSymbol("quote"): return alst[1]; - case MalSymbol("quasiquoteexpand"): - return quasiquote(alst[1]); case MalSymbol("quasiquote"): ast = quasiquote(alst[1]); continue; // TCO @@ -122,8 +94,6 @@ class Step9_try { case _: throw "Invalid defmacro! call"; } - case MalSymbol("macroexpand"): - return macroexpand(alst[1], env); case MalSymbol("try*"): try { return EVAL(alst[1], env); @@ -146,8 +116,9 @@ class Step9_try { } } 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); @@ -164,11 +135,13 @@ class Step9_try { 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); + 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); diff --git a/impls/haxe/StepA_mal.hx b/impls/haxe/StepA_mal.hx index 7a89cda115..fe1e7c9536 100644 --- a/impls/haxe/StepA_mal.hx +++ b/impls/haxe/StepA_mal.hx @@ -40,56 +40,30 @@ class StepA_mal { } } - 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); + 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 - 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!"): @@ -109,8 +83,6 @@ class StepA_mal { continue; // TCO case MalSymbol("quote"): return alst[1]; - case MalSymbol("quasiquoteexpand"): - return quasiquote(alst[1]); case MalSymbol("quasiquote"): ast = quasiquote(alst[1]); continue; // TCO @@ -122,8 +94,6 @@ class StepA_mal { case _: throw "Invalid defmacro! call"; } - case MalSymbol("macroexpand"): - return macroexpand(alst[1], env); case MalSymbol("try*"): try { return EVAL(alst[1], env); @@ -146,8 +116,9 @@ class StepA_mal { } } 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); @@ -164,11 +135,13 @@ class StepA_mal { 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); + 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); diff --git a/impls/haxe/env/Env.hx b/impls/haxe/env/Env.hx index ce60fa89a5..ed4e34ef5d 100644 --- a/impls/haxe/env/Env.hx +++ b/impls/haxe/env/Env.hx @@ -40,23 +40,9 @@ class Env { 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"; - } + 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/tests/step5_tco.mal b/impls/haxe/tests/step5_tco.mal index d20df25db7..087368335f 100644 --- a/impls/haxe/tests/step5_tco.mal +++ b/impls/haxe/tests/step5_tco.mal @@ -10,6 +10,6 @@ ;=>nil ;;; For implementations without their own TCO this should fail and ;;; leave res1 unchanged -(def! res1 (sum-to 10000)) +(def! res1 (sum-to 100000)) res1 ;=>nil diff --git a/impls/java/src/main/java/mal/env.java b/impls/java/src/main/java/mal/env.java index 711a9eee76..b4c2cdfac8 100644 --- a/impls/java/src/main/java/mal/env.java +++ b/impls/java/src/main/java/mal/env.java @@ -30,26 +30,17 @@ public Env(Env outer, MalList binds, MalList exprs) { } } - public Env find(MalSymbol key) { - if (data.containsKey(key.getName())) { - return this; + public MalVal get(String key) { + MalVal res = data.get(key); + if (res != null) { + return res; } else if (outer != null) { - return outer.find(key); + return outer.get(key); } else { return null; } } - public MalVal get(MalSymbol key) throws MalThrowable { - Env e = find(key); - if (e == null) { - throw new MalException( - "'" + key.getName() + "' not found"); - } else { - return e.data.get(key.getName()); - } - } - public Env set(MalSymbol key, MalVal value) { data.put(key.getName(), value); return this; diff --git a/impls/java/src/main/java/mal/step2_eval.java b/impls/java/src/main/java/mal/step2_eval.java index 6de69cd811..e5bbfdcf7f 100644 --- a/impls/java/src/main/java/mal/step2_eval.java +++ b/impls/java/src/main/java/mal/step2_eval.java @@ -5,7 +5,6 @@ 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; @@ -18,53 +17,42 @@ public static MalVal READ(String str) throws MalThrowable { } // eval - public static MalVal eval_ast(MalVal ast, HashMap env) throws MalThrowable { - if (ast instanceof MalSymbol) { - MalSymbol sym = (MalSymbol)ast; - return (MalVal)env.get(sym.getName()); - } else if (ast instanceof MalList) { - MalList old_lst = (MalList)ast; - MalList new_lst = ast.list_Q() ? new MalList() - : (MalList)new MalVector(); + 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 (ast instanceof MalHashMap) { + } else if (orig_ast instanceof MalHashMap) { + final Map old_hm = ((MalHashMap)orig_ast).value; MalHashMap new_hm = new MalHashMap(); - Iterator it = ((MalHashMap)ast).value.entrySet().iterator(); - while (it.hasNext()) { - Map.Entry entry = (Map.Entry)it.next(); + for (Map.Entry entry : old_hm.entrySet()) { 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); + } else if (!orig_ast.list_Q()) { + return orig_ast; } - + final MalList ast = (MalList)orig_ast; // 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); + 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); } @@ -102,7 +90,7 @@ public MalVal apply(MalList a) throws MalThrowable { public static void main(String[] args) throws MalThrowable { String prompt = "user> "; - HashMap repl_env = new HashMap(); + Map repl_env = new HashMap(); repl_env.put("+", add); repl_env.put("-", subtract); repl_env.put("*", multiply); @@ -125,13 +113,12 @@ public static void main(String[] args) throws MalThrowable { 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)); } catch (MalThrowable t) { System.out.println("Error: " + t.getMessage()); - continue; } catch (Throwable t) { System.out.println("Uncaught " + t + ": " + t.getMessage()); - continue; } } } diff --git a/impls/java/src/main/java/mal/step3_env.java b/impls/java/src/main/java/mal/step3_env.java index 65649718b8..aff63c4d9d 100644 --- a/impls/java/src/main/java/mal/step3_env.java +++ b/impls/java/src/main/java/mal/step3_env.java @@ -4,8 +4,6 @@ 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; @@ -19,39 +17,37 @@ public static MalVal READ(String str) throws MalThrowable { } // 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(); + 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 (ast instanceof MalHashMap) { + } else if (orig_ast instanceof MalHashMap) { + final Map old_hm = ((MalHashMap)orig_ast).value; MalHashMap new_hm = new MalHashMap(); - Iterator it = ((MalHashMap)ast).value.entrySet().iterator(); - while (it.hasNext()) { - Map.Entry entry = (Map.Entry)it.next(); + for (Map.Entry entry : old_hm.entrySet()) { new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); } return new_hm; - } else { - return ast; + } else if (!orig_ast.list_Q()) { + return orig_ast; } - } - - public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { + final MalList ast = (MalList)orig_ast; 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)) { @@ -79,9 +75,11 @@ public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { } 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); + final ILambda f = (ILambda)EVAL(a0, env); + final MalList args = new MalList(); + for (int i=1; i)old_lst.value) { new_lst.conj_BANG(EVAL(mv, env)); } return new_lst; - } else if (ast instanceof MalHashMap) { + } else if (orig_ast instanceof MalHashMap) { + final Map old_hm = ((MalHashMap)orig_ast).value; MalHashMap new_hm = new MalHashMap(); - Iterator it = ((MalHashMap)ast).value.entrySet().iterator(); - while (it.hasNext()) { - Map.Entry entry = (Map.Entry)it.next(); + for (Map.Entry entry : old_hm.entrySet()) { new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); } return new_hm; - } else { - return ast; + } else if (!orig_ast.list_Q()) { + return orig_ast; } - } - - public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { + final MalList ast = (MalList)orig_ast; 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() @@ -78,8 +73,9 @@ public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { } return EVAL(a2, let_env); case "do": - el = (MalList)eval_ast(ast.rest(), env); - return el.nth(el.size()-1); + for (int i=1; i)old_lst.value) { new_lst.conj_BANG(EVAL(mv, env)); } return new_lst; - } else if (ast instanceof MalHashMap) { + } else if (orig_ast instanceof MalHashMap) { + final Map old_hm = ((MalHashMap)orig_ast).value; MalHashMap new_hm = new MalHashMap(); - Iterator it = ((MalHashMap)ast).value.entrySet().iterator(); - while (it.hasNext()) { - Map.Entry entry = (Map.Entry)it.next(); + for (Map.Entry entry : old_hm.entrySet()) { new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); } return new_hm; - } else { - return ast; + } else if (!orig_ast.list_Q()) { + return orig_ast; } - } - - public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { + final MalList ast = (MalList)orig_ast; 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() @@ -83,7 +77,8 @@ public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { env = let_env; break; case "do": - eval_ast(ast.slice(1, ast.size()-1), env); + for (int i=1; i)old_lst.value) { new_lst.conj_BANG(EVAL(mv, env)); } return new_lst; - } else if (ast instanceof MalHashMap) { + } else if (orig_ast instanceof MalHashMap) { + final Map old_hm = ((MalHashMap)orig_ast).value; MalHashMap new_hm = new MalHashMap(); - Iterator it = ((MalHashMap)ast).value.entrySet().iterator(); - while (it.hasNext()) { - Map.Entry entry = (Map.Entry)it.next(); + for (Map.Entry entry : old_hm.entrySet()) { new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); } return new_hm; - } else { - return ast; + } else if (!orig_ast.list_Q()) { + return orig_ast; } - } - - public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { + final MalList ast = (MalList)orig_ast; 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() @@ -83,7 +77,8 @@ public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { env = let_env; break; case "do": - eval_ast(ast.slice(1, ast.size()-1), env); + for (int i=1; i)old_lst.value) { new_lst.conj_BANG(EVAL(mv, env)); } return new_lst; - } else if (ast instanceof MalHashMap) { + } else if (orig_ast instanceof MalHashMap) { + final Map old_hm = ((MalHashMap)orig_ast).value; MalHashMap new_hm = new MalHashMap(); - Iterator it = ((MalHashMap)ast).value.entrySet().iterator(); - while (it.hasNext()) { - Map.Entry entry = (Map.Entry)it.next(); + for (Map.Entry entry : old_hm.entrySet()) { new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); } return new_hm; - } else { - return ast; + } else if (!orig_ast.list_Q()) { + return orig_ast; } - } - - public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { + final MalList ast = (MalList)orig_ast; 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() @@ -116,13 +110,12 @@ public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { break; case "quote": return ast.nth(1); - case "quasiquoteexpand": - return quasiquote(ast.nth(1)); case "quasiquote": orig_ast = quasiquote(ast.nth(1)); break; case "do": - eval_ast(ast.slice(1, ast.size()-1), env); + for (int i=1; i)old_lst.value) { new_lst.conj_BANG(EVAL(mv, env)); } return new_lst; - } else if (ast instanceof MalHashMap) { + } else if (orig_ast instanceof MalHashMap) { + final Map old_hm = ((MalHashMap)orig_ast).value; MalHashMap new_hm = new MalHashMap(); - Iterator it = ((MalHashMap)ast).value.entrySet().iterator(); - while (it.hasNext()) { - Map.Entry entry = (Map.Entry)it.next(); + for (Map.Entry entry : old_hm.entrySet()) { new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); } return new_hm; - } else { - return ast; + } else if (!orig_ast.list_Q()) { + return orig_ast; } - } - - public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { + final MalList ast = (MalList)orig_ast; 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); - } - if (((MalList)orig_ast).size() == 0) { return orig_ast; } - // 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() @@ -147,8 +110,6 @@ public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { break; case "quote": return ast.nth(1); - case "quasiquoteexpand": - return quasiquote(ast.nth(1)); case "quasiquote": orig_ast = quasiquote(ast.nth(1)); break; @@ -160,11 +121,9 @@ public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { ((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); + for (int i=1; i)old_lst.value) { new_lst.conj_BANG(EVAL(mv, env)); } return new_lst; - } else if (ast instanceof MalHashMap) { + } else if (orig_ast instanceof MalHashMap) { + final Map old_hm = ((MalHashMap)orig_ast).value; MalHashMap new_hm = new MalHashMap(); - Iterator it = ((MalHashMap)ast).value.entrySet().iterator(); - while (it.hasNext()) { - Map.Entry entry = (Map.Entry)it.next(); + for (Map.Entry entry : old_hm.entrySet()) { new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); } return new_hm; - } else { - return ast; + } else if (!orig_ast.list_Q()) { + return orig_ast; } - } - - public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { + final MalList ast = (MalList)orig_ast; 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); - } - if (((MalList)orig_ast).size() == 0) { return orig_ast; } - // 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() @@ -149,8 +112,6 @@ public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { break; case "quote": return ast.nth(1); - case "quasiquoteexpand": - return quasiquote(ast.nth(1)); case "quasiquote": orig_ast = quasiquote(ast.nth(1)); break; @@ -162,9 +123,6 @@ public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { ((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); @@ -190,7 +148,8 @@ public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { throw t; } case "do": - eval_ast(ast.slice(1, ast.size()-1), env); + for (int i=1; i)old_lst.value) { new_lst.conj_BANG(EVAL(mv, env)); } return new_lst; - } else if (ast instanceof MalHashMap) { + } else if (orig_ast instanceof MalHashMap) { + final Map old_hm = ((MalHashMap)orig_ast).value; MalHashMap new_hm = new MalHashMap(); - Iterator it = ((MalHashMap)ast).value.entrySet().iterator(); - while (it.hasNext()) { - Map.Entry entry = (Map.Entry)it.next(); + for (Map.Entry entry : old_hm.entrySet()) { new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); } return new_hm; - } else { - return ast; + } else if (!orig_ast.list_Q()) { + return orig_ast; } - } - - public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { + final MalList ast = (MalList)orig_ast; 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); - } - if (((MalList)orig_ast).size() == 0) { return orig_ast; } - // 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() @@ -149,8 +112,6 @@ public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { break; case "quote": return ast.nth(1); - case "quasiquoteexpand": - return quasiquote(ast.nth(1)); case "quasiquote": orig_ast = quasiquote(ast.nth(1)); break; @@ -162,9 +123,6 @@ public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { ((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); @@ -190,7 +148,8 @@ public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { throw t; } case "do": - eval_ast(ast.slice(1, ast.size()-1), env); + 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)))))))"); if (typeof process !== 'undefined' && process.argv.length > 2) { - repl_env.set(types._symbol('*ARGV*'), process.argv.slice(3)); + repl_env.set('*ARGV*', process.argv.slice(3)); rep('(load-file "' + process.argv[2] + '")'); process.exit(0); } diff --git a/impls/julia/step2_eval.jl b/impls/julia/step2_eval.jl index f61697866e..b64ca9e17c 100755 --- a/impls/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) - [x[1] => 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 index 1436bcb6ef..b1cdd6c595 100755 --- a/impls/julia/step3_env.jl +++ b/impls/julia/step3_env.jl @@ -12,20 +12,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) - [x[1] => 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 @@ -38,7 +43,7 @@ function EVAL(ast, env) end EVAL(ast[3], let_env) 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/impls/julia/step4_if_fn_do.jl b/impls/julia/step4_if_fn_do.jl index 5891975874..70334f4337 100755 --- a/impls/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) - [x[1] => 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/impls/julia/step5_tco.jl b/impls/julia/step5_tco.jl index 42b48febbe..08ed0659cf 100755 --- a/impls/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) - [x[1] => 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/impls/julia/step6_file.jl b/impls/julia/step6_file.jl index 51190c8e8f..0c39d0516e 100755 --- a/impls/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) - [x[1] => 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/impls/julia/step7_quote.jl b/impls/julia/step7_quote.jl index d21e423951..86148cfd67 100755 --- a/impls/julia/step7_quote.jl +++ b/impls/julia/step7_quote.jl @@ -43,22 +43,27 @@ function quasiquote(ast) end end -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) - [x[1] => 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 @@ -74,13 +79,11 @@ function EVAL(ast, env) # TCO loop elseif :quote == ast[1] return ast[2] - elseif :quasiquoteexpand == ast[1] - return quasiquote(ast[2]) elseif :quasiquote == ast[1] ast = quasiquote(ast[2]) # 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] @@ -101,7 +104,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/impls/julia/step8_macros.jl b/impls/julia/step8_macros.jl index 49b7833869..5dee5a32e1 100755 --- a/impls/julia/step8_macros.jl +++ b/impls/julia/step8_macros.jl @@ -43,43 +43,28 @@ function quasiquote(ast) 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 EVAL(ast, env) + while true -function macroexpand(ast, env) - while ismacroCall(ast, env) - mac = env_get(env, ast[1]) - ast = mac.fn(ast[2:end]...) + 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 - 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) + return env_get(env,ast) + elseif isa(ast, Tuple) + return map((x) -> EVAL(x,env), ast) elseif isa(ast, Dict) - [x[1] => 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 # 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] @@ -94,8 +79,6 @@ function EVAL(ast, env) # TCO loop elseif :quote == ast[1] return ast[2] - elseif :quasiquoteexpand == ast[1] - return quasiquote(ast[2]) elseif :quasiquote == ast[1] ast = quasiquote(ast[2]) # TCO loop @@ -103,10 +86,8 @@ function EVAL(ast, env) 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) + map((x) -> EVAL(x,env), ast[2:end-1]) ast = ast[end] # TCO loop elseif :if == ast[1] @@ -127,8 +108,13 @@ 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) - f, args = el[1], el[2:end] + 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) diff --git a/impls/julia/step9_try.jl b/impls/julia/step9_try.jl index a739930ec4..73c18d01df 100755 --- a/impls/julia/step9_try.jl +++ b/impls/julia/step9_try.jl @@ -43,43 +43,28 @@ function quasiquote(ast) 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 EVAL(ast, env) + while true -function macroexpand(ast, env) - while ismacroCall(ast, env) - mac = env_get(env, ast[1]) - ast = mac.fn(ast[2:end]...) + 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 - 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) + return env_get(env,ast) + elseif isa(ast, Tuple) + return map((x) -> EVAL(x,env), ast) elseif isa(ast, Dict) - [x[1] => 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 # 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] @@ -94,8 +79,6 @@ function EVAL(ast, env) # TCO loop elseif :quote == ast[1] return ast[2] - elseif :quasiquoteexpand == ast[1] - return quasiquote(ast[2]) elseif :quasiquote == ast[1] ast = quasiquote(ast[2]) # TCO loop @@ -103,8 +86,6 @@ function EVAL(ast, env) 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) @@ -124,7 +105,7 @@ function EVAL(ast, env) end end 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] @@ -145,8 +126,13 @@ 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) - f, args = el[1], el[2:end] + 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) diff --git a/impls/julia/stepA_mal.jl b/impls/julia/stepA_mal.jl index 77bdaa9f00..efeabef3e6 100755 --- a/impls/julia/stepA_mal.jl +++ b/impls/julia/stepA_mal.jl @@ -43,43 +43,28 @@ function quasiquote(ast) 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 EVAL(ast, env) + while true -function macroexpand(ast, env) - while ismacroCall(ast, env) - mac = env_get(env, ast[1]) - ast = mac.fn(ast[2:end]...) + 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 - 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) + return env_get(env,ast) + elseif isa(ast, Tuple) + return map((x) -> EVAL(x,env), ast) elseif isa(ast, Dict) - [x[1] => 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 # 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] @@ -94,8 +79,6 @@ function EVAL(ast, env) # TCO loop elseif :quote == ast[1] return ast[2] - elseif :quasiquoteexpand == ast[1] - return quasiquote(ast[2]) elseif :quasiquote == ast[1] ast = quasiquote(ast[2]) # TCO loop @@ -103,8 +86,6 @@ function EVAL(ast, env) 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) @@ -124,7 +105,7 @@ function EVAL(ast, env) end end 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] @@ -145,8 +126,13 @@ 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) - f, args = el[1], el[2:end] + 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) diff --git a/impls/kotlin/src/mal/env.kt b/impls/kotlin/src/mal/env.kt index fa7b599124..b95fba2a49 100644 --- a/impls/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/impls/kotlin/src/mal/step2_eval.kt b/impls/kotlin/src/mal/step2_eval.kt index 630745a1c0..3a947a919b 100644 --- a/impls/kotlin/src/mal/step2_eval.kt +++ b/impls/kotlin/src/mal/step2_eval.kt @@ -2,21 +2,21 @@ 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 +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") - (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 + 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) diff --git a/impls/kotlin/src/mal/step3_env.kt b/impls/kotlin/src/mal/step3_env.kt index 021ac4875d..7601692566 100644 --- a/impls/kotlin/src/mal/step3_env.kt +++ b/impls/kotlin/src/mal/step3_env.kt @@ -2,11 +2,19 @@ package mal fun read(input: String?): MalType = read_str(input) -fun eval(ast: MalType, env: Env): MalType = - if (ast is MalList && ast.count() > 0) { +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!") { - env.set(ast.nth(1) as MalSymbol, eval(ast.nth(2), env)) + 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) @@ -18,22 +26,19 @@ fun eval(ast: MalType, env: Env): MalType = val value = eval(it.next(), child) child.set(key as MalSymbol, value) } - eval(ast.nth(2), child) + return eval(ast.nth(2), child) } else { - val evaluated = eval_ast(ast, env) as ISeq + 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") - (evaluated.first() as MalFunction).apply(evaluated.rest()) + return (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 } + 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) diff --git a/impls/kotlin/src/mal/step4_if_fn_do.kt b/impls/kotlin/src/mal/step4_if_fn_do.kt index ff7ae5c58b..9ff50cc2d9 100644 --- a/impls/kotlin/src/mal/step4_if_fn_do.kt +++ b/impls/kotlin/src/mal/step4_if_fn_do.kt @@ -2,20 +2,34 @@ package mal fun read(input: String?): MalType = read_str(input) -fun eval(ast: MalType, env: Env): MalType = - if (ast is MalList && ast.count() > 0) { +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!" -> 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) + "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) } - } else eval_function_call(ast, env) - } else eval_ast(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)) @@ -46,8 +60,12 @@ private fun eval_fn_STAR(ast: ISeq, env: Env): MalType { }) } -private fun eval_do(ast: ISeq, env: Env): MalType = - (eval_ast(MalList(ast.rest()), env) as ISeq).seq().last() +private fun eval_do(ast: ISeq, env: Env): MalType { + for (i in 1..ast.count() - 1) { + 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) @@ -59,21 +77,12 @@ private fun eval_if(ast: ISeq, env: Env): MalType { } else NIL } -private fun eval_function_call(ast: ISeq, env: Env): MalType { - val evaluated = eval_ast(ast, env) as ISeq +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 }) 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 = diff --git a/impls/kotlin/src/mal/step5_tco.kt b/impls/kotlin/src/mal/step5_tco.kt index cfc750f387..aaad5a5bd5 100644 --- a/impls/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() - 1) { + 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 }) as ISeq 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/impls/kotlin/src/mal/step6_file.kt b/impls/kotlin/src/mal/step6_file.kt index 12baaaf33a..21c972d724 100644 --- a/impls/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() - 1) { + 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 }) as ISeq 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() diff --git a/impls/kotlin/src/mal/step7_quote.kt b/impls/kotlin/src/mal/step7_quote.kt index 9cb803fe98..669d63b055 100644 --- a/impls/kotlin/src/mal/step7_quote.kt +++ b/impls/kotlin/src/mal/step7_quote.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() - 1) { + eval(ast.nth(i), env) + } ast = ast.seq().last() } "if" -> { @@ -42,10 +51,9 @@ fun eval(_ast: MalType, _env: Env): MalType { } else return NIL } "quote" -> return ast.nth(1) - "quasiquoteexpand" -> return quasiquote(ast.nth(1)) "quasiquote" -> ast = quasiquote(ast.nth(1)) else -> { - val evaluated = eval_ast(ast, env) as ISeq + val evaluated = ast.elements.fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) as ISeq val firstEval = evaluated.first() when (firstEval) { @@ -58,19 +66,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/impls/kotlin/src/mal/step8_macros.kt b/impls/kotlin/src/mal/step8_macros.kt index d3c031fae7..2ba8704e78 100644 --- a/impls/kotlin/src/mal/step8_macros.kt +++ b/impls/kotlin/src/mal/step8_macros.kt @@ -9,9 +9,14 @@ fun eval(_ast: MalType, _env: Env): MalType { var env = _env while (true) { - ast = macroexpand(ast, env) - 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)) @@ -31,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() - 1) { + eval(ast.nth(i), env) + } ast = ast.seq().last() } "if" -> { @@ -44,37 +51,34 @@ fun eval(_ast: MalType, _env: Env): MalType { } else return NIL } "quote" -> return ast.nth(1) - "quasiquoteexpand" -> return quasiquote(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() - + 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, evaluated.rest().seq()) + env = Env(firstEval.env, firstEval.params, args.seq()) } - is MalFunction -> return firstEval.apply(evaluated.rest()) + is MalFunction -> return firstEval.apply(args) else -> throw MalException("cannot execute non-function") } + } } } - } 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() @@ -121,25 +125,6 @@ private fun quasiquote_loop(elt: MalType, acc: MalList): MalList { return result } -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 diff --git a/impls/kotlin/src/mal/step9_try.kt b/impls/kotlin/src/mal/step9_try.kt index a65659f860..69263f4185 100644 --- a/impls/kotlin/src/mal/step9_try.kt +++ b/impls/kotlin/src/mal/step9_try.kt @@ -9,9 +9,14 @@ fun eval(_ast: MalType, _env: Env): MalType { var env = _env while (true) { - ast = macroexpand(ast, env) - 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)) @@ -31,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() - 1) { + eval(ast.nth(i), env) + } ast = ast.seq().last() } "if" -> { @@ -44,38 +51,35 @@ fun eval(_ast: MalType, _env: Env): MalType { } else return NIL } "quote" -> return ast.nth(1) - "quasiquoteexpand" -> return quasiquote(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() - + 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, evaluated.rest().seq()) + env = Env(firstEval.env, firstEval.params, args.seq()) } - is MalFunction -> return firstEval.apply(evaluated.rest()) + is MalFunction -> return firstEval.apply(args) else -> throw MalException("cannot execute non-function") } + } } } - } 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() @@ -122,25 +126,6 @@ private fun quasiquote_loop(elt: MalType, acc: MalList): MalList { return result } -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 diff --git a/impls/kotlin/src/mal/stepA_mal.kt b/impls/kotlin/src/mal/stepA_mal.kt index b72bfd3627..cccd0a614f 100644 --- a/impls/kotlin/src/mal/stepA_mal.kt +++ b/impls/kotlin/src/mal/stepA_mal.kt @@ -9,9 +9,14 @@ fun eval(_ast: MalType, _env: Env): MalType { var env = _env while (true) { - ast = macroexpand(ast, env) - 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)) @@ -31,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() - 1) { + eval(ast.nth(i), env) + } ast = ast.seq().last() } "if" -> { @@ -44,38 +51,35 @@ fun eval(_ast: MalType, _env: Env): MalType { } else return NIL } "quote" -> return ast.nth(1) - "quasiquoteexpand" -> return quasiquote(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() - + 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, evaluated.rest().seq()) + env = Env(firstEval.env, firstEval.params, args.seq()) } - is MalFunction -> return firstEval.apply(evaluated.rest()) + is MalFunction -> return firstEval.apply(args) else -> throw MalException("cannot execute non-function") } + } } } - } 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() @@ -122,27 +126,9 @@ private fun quasiquote_loop(elt: MalType, acc: MalList): MalList { return result } -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 + 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) diff --git a/impls/logo/core.lg b/impls/logo/core.lg index 52bd0fbb28..25c1e48854 100644 --- a/impls/logo/core.lg +++ b/impls/logo/core.lg @@ -1,14 +1,28 @@ -load "../logo/types.lg -load "../logo/reader.lg -load "../logo/printer.lg - make "global_exception [] -to bool_to_mal :bool -output ifelse :bool [true_new] [false_new] +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_equal_q :a :b +to |mal_=| :a :b output bool_to_mal equal_q :a :b end @@ -17,270 +31,232 @@ make "global_exception :a (throw "error "_mal_exception_) end -to mal_nil_q :a +to mal_nil? :a output bool_to_mal ((obj_type :a) = "nil) end -to mal_true_q :a +to mal_true? :a output bool_to_mal ((obj_type :a) = "true) end -to mal_false_q :a +to mal_false? :a output bool_to_mal ((obj_type :a) = "false) end -to mal_string_q :a +to mal_string? :a output bool_to_mal ((obj_type :a) = "string) end to mal_symbol :a -output symbol_new obj_val :a +output symbol_new string_val :a end -to mal_symbol_q :a +to mal_symbol? :a output bool_to_mal ((obj_type :a) = "symbol) end to mal_keyword :a -output obj_new "keyword obj_val :a +output ifelse "keyword = obj_type :a ":a [keyword_new string_val :a] end -to mal_keyword_q :a +to mal_keyword? :a output bool_to_mal ((obj_type :a) = "keyword) end -to mal_number_q :a +to mal_number? :a output bool_to_mal ((obj_type :a) = "number) end -to mal_fn_q :a -case obj_type :a [ - [[nativefn] output true_new ] - [[fn] output bool_to_mal not fn_is_macro :a] - [else output false_new ] -] +to mal_fn? :a +output bool_to_mal memberp obj_type :a [fn nativefn] end -to mal_macro_q :a -if ((obj_type :a) = "fn) [ output bool_to_mal fn_is_macro :a ] -output false_new +to mal_macro? :a +output bool_to_mal "macro = obj_type :a end -to mal_pr_str [:args] -output obj_new "string pr_seq :args "true " " :space_char +to |mal_pr-str| [:args] +output string_new pr_seq :args "true "| | end to mal_str [:args] -output obj_new "string pr_seq :args "false " " " +output string_new pr_seq :args "false " end to mal_prn [:args] -print pr_seq :args "true " " :space_char +print pr_seq :args "true "| | output nil_new end to mal_println [:args] -print pr_seq :args "false " " :space_char +print pr_seq :args "false "| | output nil_new end -to mal_read_string :str -output read_str obj_val :str +to |mal_read-string| :str +output read_str string_val :str end to mal_readline :prompt -localmake "line readline obj_val :prompt +localmake "line readline string_val :prompt if :line=[] [output nil_new] -output obj_new "string :line +output string_new :line end to mal_slurp :str -openread obj_val :str -setread obj_val :str +localmake "filename string_val :str +openread :filename +setread :filename localmake "content " -while [not eofp] [ +until [eofp] [ make "content word :content readchar ] -close obj_val :str -output obj_new "string :content +close :filename +output string_new :content end -to mal_lt :a :b -output bool_to_mal ((obj_val :a) < (obj_val :b)) +to |mal_<| :a :b +output bool_to_mal lessp number_val :a number_val :b end -to mal_lte :a :b -output bool_to_mal ((obj_val :a) <= (obj_val :b)) +to |mal_<=| :a :b +output bool_to_mal lessequalp number_val :a number_val :b end -to mal_gt :a :b -output bool_to_mal ((obj_val :a) > (obj_val :b)) +to |mal_>| :a :b +output bool_to_mal greaterp number_val :a number_val :b end -to mal_gte :a :b -output bool_to_mal ((obj_val :a) >= (obj_val :b)) +to |mal_>=| :a :b +output bool_to_mal greaterequalp number_val :a number_val :b end -to mal_add :a :b -output obj_new "number ((obj_val :a) + (obj_val :b)) +to |mal_+| :a :b +output number_new sum number_val :a number_val :b end -to mal_sub :a :b -output obj_new "number ((obj_val :a) - (obj_val :b)) +to |mal_-| :a :b +output number_new difference number_val :a number_val :b end -to mal_mul :a :b -output obj_new "number ((obj_val :a) * (obj_val :b)) +to |mal_*| :a :b +output number_new product number_val :a number_val :b end -to mal_div :a :b -output obj_new "number ((obj_val :a) / (obj_val :b)) +to |mal_/| :a :b +output number_new quotient number_val :a number_val :b end -to mal_time_ms +to |mal_time-ms| ; Native function timems is added to coms.c (see Dockerfile) -output obj_new "number timems +output number_new timems end to mal_list [:args] -output obj_new "list :args +output list_new :args end -to mal_list_q :a +to mal_list? :a output bool_to_mal ((obj_type :a) = "list) end to mal_vector [:args] -output obj_new "vector :args +output vector_new :args end -to mal_vector_q :a +to mal_vector? :a output bool_to_mal ((obj_type :a) = "vector) end -to mal_hash_map [:args] -localmake "h [] -localmake "i 1 -while [:i < count :args] [ - make "h hashmap_put :h item :i :args item (:i + 1) :args - make "i (:i + 2) -] -output obj_new "hashmap :h +to |mal_hash-map| [:pairs] +output map_assoc :map_empty :pairs end -to mal_map_q :a -output bool_to_mal ((obj_type :a) = "hashmap) +to mal_map? :a +output bool_to_mal "map = obj_type :a end to mal_assoc :map [:args] -localmake "h obj_val :map -localmake "i 1 -while [:i < count :args] [ - make "h hashmap_put :h item :i :args item (:i + 1) :args - make "i (:i + 2) -] -output obj_new "hashmap :h -end - -to mal_dissoc :map [:args] -localmake "h obj_val :map -foreach :args [make "h hashmap_delete :h ?] -output obj_new "hashmap :h +output map_assoc :map :args end to mal_get :map :key -localmake "val hashmap_get obj_val :map :key -if emptyp :val [output nil_new] +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_q :map :key -localmake "val hashmap_get obj_val :map :key -output bool_to_mal not emptyp :val +to mal_contains? :m :k +output bool_to_mal "notfound <> obj_type map_get :m :k end to mal_keys :map -localmake "h obj_val :map -localmake "keys [] -localmake "i 1 -while [:i <= count :h] [ - make "keys lput item :i :h :keys - make "i (:i + 2) -] -output obj_new "list :keys +output list_new map_keys :map end to mal_vals :map -localmake "h obj_val :map -localmake "values [] -localmake "i 2 -while [:i <= count :h] [ - make "values lput item :i :h :values - make "i (:i + 2) -] -output obj_new "list :values +output list_new map_vals :map end -to mal_sequential_q :a -output bool_to_mal sequentialp :a +to mal_sequential? :a +output bool_to_mal memberp obj_type :a [list vector] end to mal_cons :a :b -output obj_new "list fput :a obj_val :b +output list_new fput :a seq_val :b end to mal_concat [:args] -output obj_new "list apply "sentence map [obj_val ?] :args +output list_new map.se "seq_val :args end to mal_vec :s -output obj_new "vector obj_val :s +output vector_new seq_val :s end to mal_nth :a :i -if (obj_val :i) >= _count :a [(throw "error [nth: index out of range])] -output nth :a obj_val :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 -output cond [ - [[(obj_type :a) = "nil] nil_new] - [[(_count :a) = 0] nil_new] - [else first obj_val :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 -output obj_new "list cond [ - [[(obj_type :a) = "nil] []] - [[(_count :a) = 0] []] - [else butfirst obj_val :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_q :a -output bool_to_mal (emptyp obj_val :a) +to mal_empty? :a +output bool_to_mal emptyp seq_val :a end to mal_count :a -output obj_new "number _count :a +output number_new ifelse "nil = obj_type :a 0 [count seq_val :a] end to mal_apply :f [:args] -localmake "callargs obj_new "list sentence butlast :args obj_val last :args +localmake "callargs map.se [ifelse emptyp ?rest [seq_val ?] [(list ?)]] :args output invoke_fn :f :callargs end to mal_map :f :seq -output obj_new "list map [invoke_fn :f obj_new "list (list ?)] obj_val :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 :a0 - foreach :rest [make "newlist mal_cons ? :newlist] - output :newlist ] - [[vector] output obj_new "vector sentence obj_val :a0 :rest ] + [[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 @@ -288,151 +264,79 @@ end to mal_seq :a case obj_type :a [ [[string] - if (_count :a) = 0 [output nil_new] + make "a string_val :a + if emptyp :a [output nil_new] localmake "chars [] - foreach obj_val :a [ make "chars lput obj_new "string ? :chars ] - output obj_new "list :chars ] + for [i [count :a] 1 -1] [ make "chars fput string_new item :i :a :chars ] + output list_new :chars ] [[list] - if (_count :a) = 0 [output nil_new] + if emptyp seq_val :a [output nil_new] output :a ] [[vector] - if (_count :a) = 0 [output nil_new] - output obj_new "list obj_val :a ] + 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_meta :a -localmake "m obj_meta :a -if emptyp :m [output nil_new] -output :m -end - -to mal_with_meta :a :new_meta -localmake "m ifelse (obj_type :new_meta) = "nil [[]] [:new_meta] -output obj_new_with_meta obj_type :a obj_val :a :m -end - -to mal_atom :a -output obj_new "atom :a -end - -to mal_atom_q :a +to mal_atom? :a output bool_to_mal ((obj_type :a) = "atom) end -to mal_deref :a -output obj_val :a -end - -to mal_reset_bang :a :val -.setfirst butfirst :a :val -output :val -end - to invoke_fn :f :callargs output case obj_type :f [ [[nativefn] - apply obj_val :f obj_val :callargs ] + nativefn_apply :f :callargs ] [[fn] - _eval fn_body :f env_new fn_env :f fn_args :f :callargs ] + fn_apply :f :callargs ] + [[macro] + macro_apply :f :callargs ] [else (throw "error [Wrong type for apply])] ] end -to mal_swap_bang :atom :f [:args] -localmake "callargs obj_new "list fput mal_deref :atom :args -output mal_reset_bang :atom invoke_fn :f :callargs +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 [ - [[:a = "true] true_new] - [[:a = "false] false_new] - [[numberp :a] obj_new "number :a] - [[wordp :a] obj_new "string :a] - [[listp :a] obj_new "list map [logo_to_mal ?] :a] + [[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 obj_val :str +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 [ - [[symbol =] [nativefn mal_equal_q]] - [[symbol throw] [nativefn mal_throw]] - - [[symbol nil?] [nativefn mal_nil_q]] - [[symbol true?] [nativefn mal_true_q]] - [[symbol false?] [nativefn mal_false_q]] - [[symbol string?] [nativefn mal_string_q]] - [[symbol symbol] [nativefn mal_symbol]] - [[symbol symbol?] [nativefn mal_symbol_q]] - [[symbol keyword] [nativefn mal_keyword]] - [[symbol keyword?] [nativefn mal_keyword_q]] - [[symbol number?] [nativefn mal_number_q]] - [[symbol fn?] [nativefn mal_fn_q]] - [[symbol macro?] [nativefn mal_macro_q]] - - [[symbol pr-str] [nativefn mal_pr_str]] - [[symbol str] [nativefn mal_str]] - [[symbol prn] [nativefn mal_prn]] - [[symbol println] [nativefn mal_println]] - [[symbol read-string] [nativefn mal_read_string]] - [[symbol readline] [nativefn mal_readline]] - [[symbol slurp] [nativefn mal_slurp]] - - [[symbol <] [nativefn mal_lt]] - [[symbol <=] [nativefn mal_lte]] - [[symbol >] [nativefn mal_gt]] - [[symbol >=] [nativefn mal_gte]] - [[symbol +] [nativefn mal_add]] - [[symbol -] [nativefn mal_sub]] - [[symbol *] [nativefn mal_mul]] - [[symbol /] [nativefn mal_div]] - [[symbol time-ms] [nativefn mal_time_ms]] - - [[symbol list] [nativefn mal_list]] - [[symbol list?] [nativefn mal_list_q]] - [[symbol vector] [nativefn mal_vector]] - [[symbol vector?] [nativefn mal_vector_q]] - [[symbol hash-map] [nativefn mal_hash_map]] - [[symbol map?] [nativefn mal_map_q]] - [[symbol assoc] [nativefn mal_assoc]] - [[symbol dissoc] [nativefn mal_dissoc]] - [[symbol get] [nativefn mal_get]] - [[symbol contains?] [nativefn mal_contains_q]] - [[symbol keys] [nativefn mal_keys]] - [[symbol vals] [nativefn mal_vals]] - - [[symbol sequential?] [nativefn mal_sequential_q]] - [[symbol cons] [nativefn mal_cons]] - [[symbol concat] [nativefn mal_concat]] - [[symbol vec] [nativefn mal_vec]] - [[symbol nth] [nativefn mal_nth]] - [[symbol first] [nativefn mal_first]] - [[symbol rest] [nativefn mal_rest]] - [[symbol empty?] [nativefn mal_empty_q]] - [[symbol count] [nativefn mal_count]] - [[symbol apply] [nativefn mal_apply]] - [[symbol map] [nativefn mal_map]] - - [[symbol conj] [nativefn mal_conj]] - [[symbol seq] [nativefn mal_seq]] - - [[symbol meta] [nativefn mal_meta]] - [[symbol with-meta] [nativefn mal_with_meta]] - [[symbol atom] [nativefn mal_atom]] - [[symbol atom?] [nativefn mal_atom_q]] - [[symbol deref] [nativefn mal_deref]] - [[symbol reset!] [nativefn mal_reset_bang]] - [[symbol swap!] [nativefn mal_swap_bang]] - - [[symbol logo-eval] [nativefn mal_logo_eval]] + = 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 index b3f5b74e89..d23279fcde 100644 --- a/impls/logo/env.lg +++ b/impls/logo/env.lg @@ -1,51 +1,22 @@ -load "../logo/printer.lg -load "../logo/types.lg - to env_new :outer :binds :exprs -localmake "data [] -if not emptyp :binds [ - localmake "i 0 - while [:i < _count :binds] [ - ifelse (nth :binds :i) = [symbol &] [ - localmake "val drop :exprs :i - make "i (:i + 1) - localmake "key nth :binds :i - ] [ - localmake "val nth :exprs :i - localmake "key nth :binds :i - ] - make "data hashmap_put :data :key :val - make "i (:i + 1) - ] -] -output listtoarray list :outer :data -end - -to env_outer :env -output item 1 :env +output listtoarray (list :outer :binds :exprs) end -to env_data :env +to env_keys :env output item 2 :env end -to env_find :env :key -if emptyp :env [output []] -localmake "val hashmap_get env_data :env :key -ifelse emptyp :val [ - output env_find env_outer :env :key -] [ - output :env -] -end - to env_get :env :key -localmake "foundenv env_find :env :key -if emptyp :foundenv [(throw "error sentence (word "' pr_str :key "true "' ) [not found])] -output hashmap_get env_data :foundenv :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 hashmap_put env_data :env :key :val -output :val +.setitem 2 :env fput :key item 2 :env +.setitem 3 :env fput :val item 3 :env end diff --git a/impls/logo/printer.lg b/impls/logo/printer.lg index efe1339854..ab310bc3be 100644 --- a/impls/logo/printer.lg +++ b/impls/logo/printer.lg @@ -1,54 +1,44 @@ -load "../logo/types.lg - to pr_str :exp :readable -if emptyp :exp [output []] output case obj_type :exp [ [[nil] "nil] [[true] "true] [[false] "false] - [[number] obj_val :exp] - [[symbol] obj_val :exp] - [[keyword] word ": obj_val :exp] - [[string] print_string :exp :readable] - [[list] pr_seq obj_val :exp :readable "\( "\) :space_char] - [[vector] pr_seq obj_val :exp :readable "\[ "\] :space_char] - [[hashmap] pr_seq obj_val :exp :readable "\{ "\} :space_char] - [[atom] (word "\(atom :space_char pr_str obj_val :exp :readable "\) ) ] - [[nativefn] (word "#) ] - [[fn] (word "#) ] + [[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 -localmake "i 1 -localmake "res " -while [:i <= count :s] [ - localmake "c item :i :s - make "res word :res cond [ - [[ :c = "\\ ] "\\\\ ] - [[ :c = char 10 ] "\\n ] - [[ :c = "\" ] "\\\" ] - [else :c ] - ] - make "i (:i + 1) -] -output :res +output map [ + case rawascii ? [ + [[34 92] word "\\ ?] + [[10] "\\n] + [else ?] + ] + ] :s end to print_string :exp :readable ifelse :readable [ - output (word "\" escape_string obj_val :exp "\" ) + output (word "\" escape_string :exp "\" ) ] [ - output obj_val :exp + output :exp ] end -to pr_seq :seq :readable :start_char :end_char :delim_char -localmake "res :start_char -foreach :seq [ - if # > 1 [make "res word :res :delim_char] - make "res word :res pr_str ? :readable -] -output word :res :end_char +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 index 049428d0c3..4b19e93c78 100644 --- a/impls/logo/reader.lg +++ b/impls/logo/reader.lg @@ -1,221 +1,121 @@ -load "../logo/types.lg +; 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 "open_paren_char char 40 -make "close_paren_char char 41 -make "open_bracket_char char 91 -make "close_bracket_char char 93 -make "open_brace_char char 123 -make "close_brace_char char 125 +make "new_line_char char 10 +make "forbidden_chars (word :new_line_char char 13 "| "(),;[\\]{}|) +make "separator_chars (word :new_line_char "| ,|) -to newlinep :char -output case ascii :char [ - [[10 13] "true] - [else "false] -] -end - -to whitespacep :char -output case ascii :char [ - [[9 10 13 32] "true] - [else "false] -] -end - -to singlechartokenp :char -output case :char [ - [[ ( ) \[ \] \{ \} ' ` \^ @ ] "true] - [else "false] -] -end - -to separatorp :char -output ifelse whitespacep :char [ - "true -] [ - case :char [ - [[ ( ) \[ \] \{ \} ' \" ` , \; ] "true] - [else "false] - ] -] -end - -to read_comment_token :s -localmake "rest :s -while [not emptyp :rest] [ - localmake "c first :rest - ifelse newlinep :c [ - output list " butfirst :rest - ] [ - make "rest butfirst :rest - ] +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 list " :rest +output :res end -to read_word_token :s -localmake "w " -localmake "rest :s -while [not emptyp :rest] [ - localmake "c first :rest - ifelse separatorp :c [ - output list :w :rest - ] [ - make "w word :w :c - make "rest butfirst :rest +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 ] -output list :w :rest end -to read_string_token :s -localmake "w first :s -localmake "rest butfirst :s -while [not emptyp :rest] [ - localmake "c first :rest - if :c = "" [ - make "w word :w :c - output list :w butfirst :rest - ] +to read_string +localmake "res " +while [:idx <= :cnt] [ + localmake "c item :idx :str + make "idx :idx + 1 + if :c = "" [output :res] if :c = "\\ [ - make "w word :w :c - make "rest butfirst :rest - make "c first :rest + if :cnt < :idx [(throw "error [unbalananced ""])] + make "c item :idx :str + make "idx :idx + 1 + if :c = "n [make "c :new_line_char] ] - make "w word :w :c - make "rest butfirst :rest + make "res word :res :c ] -(throw "error [Expected closing quotes, not EOF]) +(throw "error [unbalanced ""]) end -to read_next_token :s -localmake "c first :s -localmake "rest butfirst :s +to read_symbol +localmake "token word :c read_allowed_chars output cond [ - [[whitespacep :c] list " :rest] - [[:c = ",] list " :rest] - [[:c = "~] ifelse ((first :rest) = "@) [list "~@ butfirst :rest] [list "~ :rest] ] - [[singlechartokenp :c] list :c :rest] - [[:c = "\;] read_comment_token :s] - [[:c = ""] read_string_token :s] - [else read_word_token :s] + [[:token = "nil] nil_new] + [[memberp :token [false true]] bool_to_mal :token] + [[numberp :token] number_new :token] + [else symbol_new :token] ] -output list first :s butfirst :s end -to tokenize :str -localmake "tokens [] -localmake "s :str -while [not emptyp :s] [ - localmake "res read_next_token :s - localmake "token first :res - make "s last :res - if not emptyp :token [ - make "tokens lput :token :tokens +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 ] -output :tokens -end - -to reader_new :tokens -output listtoarray list :tokens 1 -end - -to reader_peek :reader -localmake "tokens item 1 :reader -localmake "pos item 2 :reader -if :pos > count :tokens [output []] -output item :pos :tokens -end - -to reader_next :reader -make "token reader_peek :reader -localmake "pos item 2 :reader -setitem 2 :reader (1 + :pos) -output :token -end - -to unescape_string :token -localmake "s butfirst butlast :token ; remove surrounding double-quotes -localmake "i 1 -localmake "res " -while [:i <= count :s] [ - localmake "c item :i :s - ifelse :c = "\\ [ - make "i (:i + 1) - make "c item :i :s - make "res word :res case :c [ - [[ n ] char 10] - [[ " ] "\" ] - [[ \\ ] "\\ ] - [else :c] - ] - ] [ - make "res word :res :c - ] - make "i (:i + 1) -] -output :res -end - -to read_atom :reader -localmake "token reader_next :reader -output cond [ - [[:token = "nil] nil_new] - [[:token = "true] true_new] - [[:token = "false] false_new] - [[numberp :token] obj_new "number :token] - [[(first :token) = ": ] obj_new "keyword butfirst :token] - [[(first :token) = "\" ] obj_new "string unescape_string :token] - [else symbol_new :token] -] -end - -to read_seq :reader :value_type :start_char :end_char -localmake "token reader_next :reader -if :token <> :start_char [(throw "error sentence "expected (word "' :start_char "'))] -localmake "seq [] -make "token reader_peek :reader -while [:token <> :end_char] [ - if emptyp :token [(throw "error (sentence [expected] (word "' :end_char "',) [got EOF]))] - make "seq lput read_form :reader :seq - make "token reader_peek :reader -] -ignore reader_next :reader -output obj_new :value_type :seq -end - -to reader_macro :reader :symbol_name -ignore reader_next :reader -output obj_new "list list symbol_new :symbol_name read_form :reader -end - -to with_meta_reader_macro :reader -ignore reader_next :reader -localmake "meta read_form :reader -output obj_new "list (list symbol_new "with-meta read_form :reader :meta) end -to read_form :reader -output case reader_peek :reader [ - [[ ' ] reader_macro :reader "quote ] - [[ ` ] reader_macro :reader "quasiquote ] - [[ ~ ] reader_macro :reader "unquote ] - [[ ~@ ] reader_macro :reader "splice-unquote ] - [[ \^ ] with_meta_reader_macro :reader ] - [[ @ ] reader_macro :reader "deref ] - [[ ( ] read_seq :reader "list :open_paren_char :close_paren_char ] - [[ ) ] (throw "error sentence [unexpected] (word "' :close_paren_char "')) ] - [[ \[ ] read_seq :reader "vector :open_bracket_char :close_bracket_char ] - [[ \] ] (throw "error sentence [unexpected] (word "' :close_bracket_char "')) ] - [[ \{ ] read_seq :reader "hashmap :open_brace_char :close_brace_char ] - [[ \} ] (throw "error sentence [unexpected] (word "' :close_brace_char "')) ] - [else read_atom :reader] +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 "tokens tokenize :str -if emptyp :tokens [output []] -localmake "reader reader_new :tokens -output read_form :reader +localmake "idx 1 +localmake "cnt count :str +output read_form end diff --git a/impls/logo/readline.lg b/impls/logo/readline.lg index b015ff397f..59e7766c83 100644 --- a/impls/logo/readline.lg +++ b/impls/logo/readline.lg @@ -1,5 +1,4 @@ make "backspace_char char 8 -make "space_char char 32 to readline :prompt type :prompt @@ -10,13 +9,12 @@ forever [ ifelse emptyp :c [ output [] ] [ - localmake "ascii rawascii :c - case :ascii [ + case rawascii :c [ [[4] output []] [[10] type :c output :line] [[127] if not emptyp :line [ - type (word :backspace_char :space_char :backspace_char) + (type :backspace_char "| | :backspace_char) make "line butlast :line ]] [else type :c diff --git a/impls/logo/step0_repl.lg b/impls/logo/step0_repl.lg index f62cd8d675..97b0254d52 100644 --- a/impls/logo/step0_repl.lg +++ b/impls/logo/step0_repl.lg @@ -4,7 +4,7 @@ to _read :str output :str end -to _eval :ast :env +to _eval :ast output :ast end @@ -12,19 +12,18 @@ to _print :exp output :exp end +to rep :str +output _print _eval _read :str +end + to repl -localmake "running "true -while [:running] [ - localmake "line readline word "user> :space_char - ifelse :line=[] [ - print " - make "running "false - ] [ +do.until [ + localmake "line readline "|user> | if not emptyp :line [ - print _print _eval _read :line [] + print rep :line ] - ] -] +] [:line = []] +(print) end repl diff --git a/impls/logo/step1_read_print.lg b/impls/logo/step1_read_print.lg index c3e5e61008..b7dfcdabd5 100644 --- a/impls/logo/step1_read_print.lg +++ b/impls/logo/step1_read_print.lg @@ -1,12 +1,13 @@ 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 +to _eval :ast output :ast end @@ -15,26 +16,24 @@ output pr_str :exp "true end to rep :str -output _print _eval _read :str [] +output _print _eval _read :str +end + +to print_exception :exception +if not emptyp :exception [ + (print "Error: item 2 :exception) +] end to repl -localmake "running "true -while [:running] [ - localmake "line readline word "user> :space_char - ifelse :line=[] [ - print " - make "running "false - ] [ +do.until [ + localmake "line readline "|user> | if not emptyp :line [ catch "error [print rep :line] - localmake "exception error - if not emptyp :exception [ - (print "Error: first butfirst :exception) - ] + print_exception error ] - ] -] +] [:line = []] +(print) end repl diff --git a/impls/logo/step2_eval.lg b/impls/logo/step2_eval.lg index de1be205a2..73b1e50dd2 100644 --- a/impls/logo/step2_eval.lg +++ b/impls/logo/step2_eval.lg @@ -7,23 +7,33 @@ to _read :str output read_str :str end -to eval_ast :ast :env -output case (obj_type :ast) [ - [[symbol] localmake "val hashmap_get :env :ast - if emptyp :val [(throw "error sentence (word "' obj_val :ast "' ) [not found])] - :val ] - [[list] obj_new "list map [_eval ? :env] obj_val :ast] - [[vector] obj_new "vector map [_eval ? :env] obj_val :ast] - [[hashmap] obj_new "hashmap map [_eval ? :env] obj_val :ast] - [else :ast] -] -end - to _eval :ast :env -if (obj_type :ast) <> "list [output eval_ast :ast :env] -if emptyp obj_val :ast [output :ast] -make "el obj_val eval_ast :ast :env -output apply first :el butfirst :el +; (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 @@ -35,44 +45,43 @@ output _print _eval _read :str :repl_env end to mal_add :a :b -output obj_new "number ((obj_val :a) + (obj_val :b)) +output number_new ((number_val :a) + (number_val :b)) end to mal_sub :a :b -output obj_new "number ((obj_val :a) - (obj_val :b)) +output number_new ((number_val :a) - (number_val :b)) end to mal_mul :a :b -output obj_new "number ((obj_val :a) * (obj_val :b)) +output number_new ((number_val :a) * (number_val :b)) end to mal_div :a :b -output obj_new "number ((obj_val :a) / (obj_val :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 -localmake "running "true -while [:running] [ - localmake "line readline word "user> :space_char - ifelse :line=[] [ - print " - make "running "false - ] [ +do.until [ + localmake "line readline "|user> | if not emptyp :line [ catch "error [print rep :line] - localmake "exception error - if not emptyp :exception [ - (print "Error: first butfirst :exception) - ] + print_exception error ] - ] -] +] [:line = []] +(print) end -make "repl_env [] -make "repl_env hashmap_put :repl_env symbol_new "+ "mal_add -make "repl_env hashmap_put :repl_env symbol_new "- "mal_sub -make "repl_env hashmap_put :repl_env symbol_new "* "mal_mul -make "repl_env hashmap_put :repl_env symbol_new "/ "mal_div +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 index 05147038d6..2ddd38471f 100644 --- a/impls/logo/step3_env.lg +++ b/impls/logo/step3_env.lg @@ -8,39 +8,55 @@ to _read :str output read_str :str end -to eval_ast :ast :env -output case (obj_type :ast) [ - [[symbol] env_get :env :ast] - [[list] obj_new "list map [_eval ? :env] obj_val :ast] - [[vector] obj_new "vector map [_eval ? :env] obj_val :ast] - [[hashmap] obj_new "hashmap map [_eval ? :env] obj_val :ast] - [else :ast] +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) ] -end -to _eval :ast :env -if (obj_type :ast) <> "list [output eval_ast :ast :env] -if emptyp obj_val :ast [output :ast] -localmake "a0 nth :ast 0 -case list obj_type :a0 obj_val :a0 [ - [[[symbol def!]] - localmake "a1 nth :ast 1 - localmake "a2 nth :ast 2 - output env_set :env :a1 _eval :a2 :env ] - - [[[symbol let*]] - localmake "a1 nth :ast 1 - localmake "letenv env_new :env [] [] - localmake "i 0 - while [:i < _count :a1] [ - ignore env_set :letenv nth :a1 :i _eval nth :a1 (:i + 1) :letenv - make "i (:i + 2) +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 _eval nth :ast 2 :letenv ] + 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 - make "el obj_val eval_ast :ast :env - output apply first :el butfirst :el ] + [else + localmake "f _eval :a0 :env + output nativefn_apply :f map [_eval ? :env] :ast ] + ] + ] + [else output :ast] ] end @@ -53,44 +69,40 @@ output _print _eval _read :str :repl_env end to mal_add :a :b -output obj_new "number ((obj_val :a) + (obj_val :b)) +output number_new ((number_val :a) + (number_val :b)) end to mal_sub :a :b -output obj_new "number ((obj_val :a) - (obj_val :b)) +output number_new ((number_val :a) - (number_val :b)) end to mal_mul :a :b -output obj_new "number ((obj_val :a) * (obj_val :b)) +output number_new ((number_val :a) * (number_val :b)) end to mal_div :a :b -output obj_new "number ((obj_val :a) / (obj_val :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 -localmake "running "true -while [:running] [ - localmake "line readline word "user> :space_char - ifelse :line=[] [ - print " - make "running "false - ] [ +do.until [ + localmake "line readline "|user> | if not emptyp :line [ catch "error [print rep :line] - localmake "exception error - if not emptyp :exception [ - (print "Error: first butfirst :exception) - ] + print_exception error ] - ] -] +] [:line = []] +(print) end -make "repl_env env_new [] [] [] -ignore env_set :repl_env obj_new "symbol "+ "mal_add -ignore env_set :repl_env obj_new "symbol "- "mal_sub -ignore env_set :repl_env obj_new "symbol "* "mal_mul -ignore env_set :repl_env obj_new "symbol "/ "mal_div +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 index fd1293ea3d..03f15a6b29 100644 --- a/impls/logo/step4_if_fn_do.lg +++ b/impls/logo/step4_if_fn_do.lg @@ -9,66 +9,83 @@ to _read :str output read_str :str end -to eval_ast :ast :env -output case (obj_type :ast) [ - [[symbol] env_get :env :ast] - [[list] obj_new "list map [_eval ? :env] obj_val :ast] - [[vector] obj_new "vector map [_eval ? :env] obj_val :ast] - [[hashmap] obj_new "hashmap map [_eval ? :env] obj_val :ast] - [else :ast] +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) ] -end -to _eval :ast :env -if (obj_type :ast) <> "list [output eval_ast :ast :env] -if emptyp obj_val :ast [output :ast] -localmake "a0 nth :ast 0 -case list obj_type :a0 obj_val :a0 [ - [[[symbol def!]] - localmake "a1 nth :ast 1 - localmake "a2 nth :ast 2 - output env_set :env :a1 _eval :a2 :env ] - - [[[symbol let*]] - localmake "a1 nth :ast 1 - localmake "letenv env_new :env [] [] - localmake "i 0 - while [:i < _count :a1] [ - ignore env_set :letenv nth :a1 :i _eval nth :a1 (:i + 1) :letenv - make "i (:i + 2) +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] + ] ] - output _eval nth :ast 2 :letenv ] - - [[[symbol do]] - output last obj_val eval_ast rest :ast :env ] - - [[[symbol if]] - localmake "a1 nth :ast 1 - localmake "cond _eval :a1 :env - output case obj_type :cond [ - [[nil false] ifelse (_count :ast) > 3 [ - _eval nth :ast 3 :env - ] [ - nil_new - ]] - [else _eval nth :ast 2 :env] - ]] - - [[[symbol fn*]] - output fn_new nth :ast 1 :env nth :ast 2 ] - - [else - localmake "el eval_ast :ast :env - localmake "f nth :el 0 - case obj_type :f [ - [[nativefn] - output apply obj_val :f butfirst obj_val :el ] - [[fn] - localmake "funcenv env_new fn_env :f fn_args :f rest :el - output _eval fn_body :f :funcenv ] - [else - (throw "error [Wrong type for apply])] - ] ] + + [[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 @@ -77,37 +94,38 @@ output pr_str :exp "true end to re :str -output _eval _read :str :repl_env +ignore _eval _read :str :repl_env end to rep :str -output _print re :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 -localmake "running "true -while [:running] [ - localmake "line readline word "user> :space_char - ifelse :line=[] [ - print " - make "running "false - ] [ +do.until [ + localmake "line readline "|user> | if not emptyp :line [ catch "error [print rep :line] - localmake "exception error - if not emptyp :exception [ - (print "Error: first butfirst :exception) - ] + print_exception error ] - ] -] +] [:line = []] +(print) end +; core_ns make "repl_env env_new [] [] [] foreach :core_ns [ - ignore env_set :repl_env first ? first butfirst ? + env_set :repl_env symbol_new ? nativefn_new word "mal_ ? ] + ; core.mal: defined using the language itself -ignore re "|(def! not (fn* (a) (if a false true)))| +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 index a9171f39a2..443fceac88 100644 --- a/impls/logo/step5_tco.lg +++ b/impls/logo/step5_tco.lg @@ -9,76 +9,87 @@ to _read :str output read_str :str end -to eval_ast :ast :env -output case (obj_type :ast) [ - [[symbol] env_get :env :ast] - [[list] obj_new "list map [_eval ? :env] obj_val :ast] - [[vector] obj_new "vector map [_eval ? :env] obj_val :ast] - [[hashmap] obj_new "hashmap map [_eval ? :env] obj_val :ast] - [else :ast] +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) ] -end -to _eval :a_ast :a_env -localmake "ast :a_ast -localmake "env :a_env -forever [ - if (obj_type :ast) <> "list [output eval_ast :ast :env] - if emptyp obj_val :ast [output :ast] - localmake "a0 nth :ast 0 - case list obj_type :a0 obj_val :a0 [ - [[[symbol def!]] - localmake "a1 nth :ast 1 - localmake "a2 nth :ast 2 - output env_set :env :a1 _eval :a2 :env ] - - [[[symbol let*]] - localmake "a1 nth :ast 1 +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 [] [] - localmake "i 0 - while [:i < _count :a1] [ - ignore env_set :letenv nth :a1 :i _eval nth :a1 (:i + 1) :letenv - make "i (:i + 2) + foreach seq_val first :ast [ + if 1 = modulo # 2 [ + env_set :letenv ? _eval first ?rest :letenv + ] ] make "env :letenv - make "ast nth :ast 2 ] ; TCO + make "ast item 2 :ast ] ; TCO - [[[symbol do]] - localmake "i 1 - while [:i < ((_count :ast) - 1)] [ - ignore _eval nth :ast :i :env - make "i (:i + 1) + [[do] + foreach :ast [ ; TCO for last item + ifelse emptyp ?rest [make "ast ?] [ignore _eval ? :env] ] - make "ast last obj_val :ast ] ; TCO + ] - [[[symbol if]] - localmake "a1 nth :ast 1 + [[if] + localmake "a1 first :ast localmake "cond _eval :a1 :env case obj_type :cond [ - [[nil false] ifelse (_count :ast) > 3 [ - make "ast nth :ast 3 ; TCO + [[nil false] ifelse 3 = count :ast [ + make "ast item 3 :ast ; TCO ] [ output nil_new ]] - [else make "ast nth :ast 2] ; TCO + [else make "ast item 2 :ast] ; TCO ]] - [[[symbol fn*]] - output fn_new nth :ast 1 :env nth :ast 2 ] + [[fn*] + output fn_new seq_val first :ast :env item 2 :ast ] [else - localmake "el eval_ast :ast :env - localmake "f nth :el 0 + localmake "f _eval :a0 :env case obj_type :f [ [[nativefn] - output apply obj_val :f butfirst obj_val :el ] + output nativefn_apply :f map [_eval ? :env] :ast ] [[fn] - make "env env_new fn_env :f fn_args :f rest :el + 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 @@ -87,37 +98,38 @@ output pr_str :exp "true end to re :str -output _eval _read :str :repl_env +ignore _eval _read :str :repl_env end to rep :str -output _print re :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 -localmake "running "true -while [:running] [ - localmake "line readline word "user> :space_char - ifelse :line=[] [ - print " - make "running "false - ] [ +do.until [ + localmake "line readline "|user> | if not emptyp :line [ catch "error [print rep :line] - localmake "exception error - if not emptyp :exception [ - (print "Error: first butfirst :exception) - ] + print_exception error ] - ] -] +] [:line = []] +(print) end +; core_ns make "repl_env env_new [] [] [] foreach :core_ns [ - ignore env_set :repl_env first ? first butfirst ? + env_set :repl_env symbol_new ? nativefn_new word "mal_ ? ] + ; core.mal: defined using the language itself -ignore re "|(def! not (fn* (a) (if a false true)))| +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 index ef51812e9a..387aa32c13 100644 --- a/impls/logo/step6_file.lg +++ b/impls/logo/step6_file.lg @@ -9,76 +9,87 @@ to _read :str output read_str :str end -to eval_ast :ast :env -output case (obj_type :ast) [ - [[symbol] env_get :env :ast] - [[list] obj_new "list map [_eval ? :env] obj_val :ast] - [[vector] obj_new "vector map [_eval ? :env] obj_val :ast] - [[hashmap] obj_new "hashmap map [_eval ? :env] obj_val :ast] - [else :ast] +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) ] -end -to _eval :a_ast :a_env -localmake "ast :a_ast -localmake "env :a_env -forever [ - if (obj_type :ast) <> "list [output eval_ast :ast :env] - if emptyp obj_val :ast [output :ast] - localmake "a0 nth :ast 0 - case list obj_type :a0 obj_val :a0 [ - [[[symbol def!]] - localmake "a1 nth :ast 1 - localmake "a2 nth :ast 2 - output env_set :env :a1 _eval :a2 :env ] - - [[[symbol let*]] - localmake "a1 nth :ast 1 +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 [] [] - localmake "i 0 - while [:i < _count :a1] [ - ignore env_set :letenv nth :a1 :i _eval nth :a1 (:i + 1) :letenv - make "i (:i + 2) + foreach seq_val first :ast [ + if 1 = modulo # 2 [ + env_set :letenv ? _eval first ?rest :letenv + ] ] make "env :letenv - make "ast nth :ast 2 ] ; TCO + make "ast item 2 :ast ] ; TCO - [[[symbol do]] - localmake "i 1 - while [:i < ((_count :ast) - 1)] [ - ignore _eval nth :ast :i :env - make "i (:i + 1) + [[do] + foreach :ast [ ; TCO for last item + ifelse emptyp ?rest [make "ast ?] [ignore _eval ? :env] ] - make "ast last obj_val :ast ] ; TCO + ] - [[[symbol if]] - localmake "a1 nth :ast 1 + [[if] + localmake "a1 first :ast localmake "cond _eval :a1 :env case obj_type :cond [ - [[nil false] ifelse (_count :ast) > 3 [ - make "ast nth :ast 3 ; TCO + [[nil false] ifelse 3 = count :ast [ + make "ast item 3 :ast ; TCO ] [ output nil_new ]] - [else make "ast nth :ast 2] ; TCO + [else make "ast item 2 :ast] ; TCO ]] - [[[symbol fn*]] - output fn_new nth :ast 1 :env nth :ast 2 ] + [[fn*] + output fn_new seq_val first :ast :env item 2 :ast ] [else - localmake "el eval_ast :ast :env - localmake "f nth :el 0 + localmake "f _eval :a0 :env case obj_type :f [ [[nativefn] - output apply obj_val :f butfirst obj_val :el ] + output nativefn_apply :f map [_eval ? :env] :ast ] [[fn] - make "env env_new fn_env :f fn_args :f rest :el + 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 @@ -87,16 +98,16 @@ output pr_str :exp "true end to re :str -output _eval _read :str :repl_env +ignore _eval _read :str :repl_env end to rep :str -output _print re :str +output _print _eval _read :str :repl_env end to print_exception :exception if not emptyp :exception [ - localmake "e first butfirst :exception + localmake "e item 2 :exception ifelse :e = "_mal_exception_ [ (print "Error: pr_str :global_exception "false) ] [ @@ -106,19 +117,14 @@ if not emptyp :exception [ end to repl -localmake "running "true -while [:running] [ - localmake "line readline word "user> :space_char - ifelse :line=[] [ - print " - make "running "false - ] [ +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 @@ -127,25 +133,25 @@ end to argv_list localmake "argv ifelse emptyp :command.line [[]] [butfirst :command.line] -output obj_new "list map [obj_new "string ?] :argv +output list_new map "string_new :argv end make "repl_env env_new [] [] [] foreach :core_ns [ - ignore env_set :repl_env first ? first butfirst ? + env_set :repl_env symbol_new ? nativefn_new word "mal_ ? ] -ignore env_set :repl_env [symbol eval] [nativefn mal_eval] -ignore env_set :repl_env [symbol *ARGV*] argv_list +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 -ignore re "|(def! not (fn* (a) (if a false true)))| -ignore re "|(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))| +re "|(def! not (fn* (a) (if a false true)))| +re "|(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))| -if not emptyp :command.line [ - catch "error [ignore re (word "\(load-file :space_char "\" first :command.line "\"\) )] +ifelse emptyp :command.line [ + repl +] [ + catch "error [re (word "|(load-file "| first :command.line "|")| )] print_exception error - bye ] -repl bye diff --git a/impls/logo/step7_quote.lg b/impls/logo/step7_quote.lg index ff93a88719..8428d5c7c8 100644 --- a/impls/logo/step7_quote.lg +++ b/impls/logo/step7_quote.lg @@ -9,108 +9,122 @@ to _read :str output read_str :str end -to starts_with :ast :sym -if (obj_type :ast) <> "list [output "false] -localmake "xs obj_val :ast -if emptyp :xs [output "false] -localmake "a0 first :xs -output and ((obj_type :a0) = "symbol) ((obj_val :a0) = :sym) +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 quasiquote :ast -if memberp obj_type :ast [hashmap symbol] [output (mal_list symbol_new "quote :ast)] -if not sequentialp :ast [output :ast] -if starts_with :ast "unquote [output nth :ast 1] -localmake "result mal_list -foreach reverse obj_val :ast [ - ifelse starts_with ? "splice-unquote [ - make "result (mal_list symbol_new "concat nth ? 1 :result) - ] [ - make "result (mal_list symbol_new "cons quasiquote ? :result) - ] ] -if (obj_type :ast) = "vector [make "result (mal_list symbol_new "vec :result)] +to qq_seq :xs +localmake "result list_new [] +foreach reverse :xs [make "result qq_folder ? :result] output :result end -to eval_ast :ast :env -output case (obj_type :ast) [ - [[symbol] env_get :env :ast] - [[list] obj_new "list map [_eval ? :env] obj_val :ast] - [[vector] obj_new "vector map [_eval ? :env] obj_val :ast] - [[hashmap] obj_new "hashmap map [_eval ? :env] obj_val :ast] - [else :ast] +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 :a_ast :a_env -localmake "ast :a_ast -localmake "env :a_env +to _eval :ast :env forever [ - if (obj_type :ast) <> "list [output eval_ast :ast :env] - if emptyp obj_val :ast [output :ast] - localmake "a0 nth :ast 0 - case list obj_type :a0 obj_val :a0 [ - [[[symbol def!]] - localmake "a1 nth :ast 1 - localmake "a2 nth :ast 2 - output env_set :env :a1 _eval :a2 :env ] - - [[[symbol let*]] - localmake "a1 nth :ast 1 +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 [] [] - localmake "i 0 - while [:i < _count :a1] [ - ignore env_set :letenv nth :a1 :i _eval nth :a1 (:i + 1) :letenv - make "i (:i + 2) + foreach seq_val first :ast [ + if 1 = modulo # 2 [ + env_set :letenv ? _eval first ?rest :letenv + ] ] make "env :letenv - make "ast nth :ast 2 ] ; TCO + make "ast item 2 :ast ] ; TCO - [[[symbol quote]] - output nth :ast 1 ] + [[quote] + output first :ast] - [[[symbol quasiquote]] - make "ast quasiquote nth :ast 1 ] ; TCO + [[quasiquote] + make "ast quasiquote first :ast ] ; TCO - [[[symbol quasiquoteexpand]] - output quasiquote nth :ast 1] - - [[[symbol do]] - localmake "i 1 - while [:i < ((_count :ast) - 1)] [ - ignore _eval nth :ast :i :env - make "i (:i + 1) + [[do] + foreach :ast [ ; TCO for last item + ifelse emptyp ?rest [make "ast ?] [ignore _eval ? :env] ] - make "ast last obj_val :ast ] ; TCO + ] - [[[symbol if]] - localmake "a1 nth :ast 1 + [[if] + localmake "a1 first :ast localmake "cond _eval :a1 :env case obj_type :cond [ - [[nil false] ifelse (_count :ast) > 3 [ - make "ast nth :ast 3 ; TCO + [[nil false] ifelse 3 = count :ast [ + make "ast item 3 :ast ; TCO ] [ output nil_new ]] - [else make "ast nth :ast 2] ; TCO + [else make "ast item 2 :ast] ; TCO ]] - [[[symbol fn*]] - output fn_new nth :ast 1 :env nth :ast 2 ] + [[fn*] + output fn_new seq_val first :ast :env item 2 :ast ] [else - localmake "el eval_ast :ast :env - localmake "f nth :el 0 + localmake "f _eval :a0 :env case obj_type :f [ [[nativefn] - output apply obj_val :f butfirst obj_val :el ] + output nativefn_apply :f map [_eval ? :env] :ast ] [[fn] - make "env env_new fn_env :f fn_args :f rest :el + 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 @@ -119,16 +133,16 @@ output pr_str :exp "true end to re :str -output _eval _read :str :repl_env +ignore _eval _read :str :repl_env end to rep :str -output _print re :str +output _print _eval _read :str :repl_env end to print_exception :exception if not emptyp :exception [ - localmake "e first butfirst :exception + localmake "e item 2 :exception ifelse :e = "_mal_exception_ [ (print "Error: pr_str :global_exception "false) ] [ @@ -138,22 +152,14 @@ if not emptyp :exception [ end to repl -localmake "running "true -while [:running] [ - localmake "line readline word "user> :space_char - ifelse :line=[] [ - print " - make "running "false - ] [ +do.until [ + localmake "line readline "|user> | if not emptyp :line [ catch "error [print rep :line] - localmake "exception error - if not emptyp :exception [ - (print "Error: first butfirst :exception) - ] + print_exception error ] - ] -] +] [:line = []] +(print) end to mal_eval :a @@ -162,25 +168,25 @@ end to argv_list localmake "argv ifelse emptyp :command.line [[]] [butfirst :command.line] -output obj_new "list map [obj_new "string ?] :argv +output list_new map "string_new :argv end make "repl_env env_new [] [] [] foreach :core_ns [ - ignore env_set :repl_env first ? first butfirst ? + env_set :repl_env symbol_new ? nativefn_new word "mal_ ? ] -ignore env_set :repl_env [symbol eval] [nativefn mal_eval] -ignore env_set :repl_env [symbol *ARGV*] argv_list +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 -ignore re "|(def! not (fn* (a) (if a false true)))| -ignore re "|(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))| +re "|(def! not (fn* (a) (if a false true)))| +re "|(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))| -if not emptyp :command.line [ - catch "error [ignore re (word "\(load-file :space_char "\" first :command.line "\"\) )] +ifelse emptyp :command.line [ + repl +] [ + catch "error [re (word "|(load-file "| first :command.line "|")| )] print_exception error - bye ] -repl bye diff --git a/impls/logo/step8_macros.lg b/impls/logo/step8_macros.lg index 4f760d7aea..572a91ec50 100644 --- a/impls/logo/step8_macros.lg +++ b/impls/logo/step8_macros.lg @@ -9,144 +9,131 @@ to _read :str output read_str :str end -to starts_with :ast :sym -if (obj_type :ast) <> "list [output "false] -localmake "xs obj_val :ast -if emptyp :xs [output "false] -localmake "a0 first :xs -output and ((obj_type :a0) = "symbol) ((obj_val :a0) = :sym) -end - to quasiquote :ast -if memberp obj_type :ast [hashmap symbol] [output (mal_list symbol_new "quote :ast)] -if not sequentialp :ast [output :ast] -if starts_with :ast "unquote [output nth :ast 1] -localmake "result mal_list -foreach reverse obj_val :ast [ - ifelse starts_with ? "splice-unquote [ - make "result (mal_list symbol_new "concat nth ? 1 :result) - ] [ - make "result (mal_list symbol_new "cons quasiquote ? :result) - ] ] -if (obj_type :ast) = "vector [make "result (mal_list symbol_new "vec :result)] -output :result -end - -to macrocallp :ast :env -if (obj_type :ast) = "list [ - if (_count :ast) > 0 [ - localmake "a0 nth :ast 0 - if (obj_type :a0) = "symbol [ - if not emptyp env_find :env :a0 [ - localmake "f env_get :env :a0 - if (obj_type :f) = "fn [ - output fn_is_macro :f - ] - ] - ] - ] +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] ] -output "false end -to _macroexpand :ast :env -if not macrocallp :ast :env [output :ast] -localmake "a0 nth :ast 0 -localmake "f env_get :env :a0 -output _macroexpand invoke_fn :f rest :ast :env +to qq_seq :xs +localmake "result list_new [] +foreach reverse :xs [make "result qq_folder ? :result] +output :result end -to eval_ast :ast :env -output case (obj_type :ast) [ - [[symbol] env_get :env :ast] - [[list] obj_new "list map [_eval ? :env] obj_val :ast] - [[vector] obj_new "vector map [_eval ? :env] obj_val :ast] - [[hashmap] obj_new "hashmap map [_eval ? :env] obj_val :ast] - [else :ast] +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 :a_ast :a_env -localmake "ast :a_ast -localmake "env :a_env +to _eval :ast :env forever [ - if (obj_type :ast) <> "list [output eval_ast :ast :env] - make "ast _macroexpand :ast :env - if (obj_type :ast) <> "list [output eval_ast :ast :env] - if emptyp obj_val :ast [output :ast] - localmake "a0 nth :ast 0 - case list obj_type :a0 obj_val :a0 [ - [[[symbol def!]] - localmake "a1 nth :ast 1 - localmake "a2 nth :ast 2 - output env_set :env :a1 _eval :a2 :env ] - - [[[symbol let*]] - localmake "a1 nth :ast 1 +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 [] [] - localmake "i 0 - while [:i < _count :a1] [ - ignore env_set :letenv nth :a1 :i _eval nth :a1 (:i + 1) :letenv - make "i (:i + 2) + foreach seq_val first :ast [ + if 1 = modulo # 2 [ + env_set :letenv ? _eval first ?rest :letenv + ] ] make "env :letenv - make "ast nth :ast 2 ] ; TCO - - [[[symbol quote]] - output nth :ast 1 ] - - [[[symbol quasiquote]] - make "ast quasiquote nth :ast 1 ] ; TCO + make "ast item 2 :ast ] ; TCO - [[[symbol quasiquoteexpand]] - output quasiquote nth :ast 1] + [[quote] + output first :ast] - [[[symbol defmacro!]] - localmake "a1 nth :ast 1 - localmake "a2 nth :ast 2 - localmake "macro_fn _eval :a2 :env - fn_set_macro :macro_fn - output env_set :env :a1 :macro_fn ] + [[quasiquote] + make "ast quasiquote first :ast ] ; TCO - [[[symbol macroexpand]] - output _macroexpand nth :ast 1 :env ] + [[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 ] - [[[symbol do]] - localmake "i 1 - while [:i < ((_count :ast) - 1)] [ - ignore _eval nth :ast :i :env - make "i (:i + 1) + [[do] + foreach :ast [ ; TCO for last item + ifelse emptyp ?rest [make "ast ?] [ignore _eval ? :env] ] - make "ast last obj_val :ast ] ; TCO + ] - [[[symbol if]] - localmake "a1 nth :ast 1 + [[if] + localmake "a1 first :ast localmake "cond _eval :a1 :env case obj_type :cond [ - [[nil false] ifelse (_count :ast) > 3 [ - make "ast nth :ast 3 ; TCO + [[nil false] ifelse 3 = count :ast [ + make "ast item 3 :ast ; TCO ] [ output nil_new ]] - [else make "ast nth :ast 2] ; TCO + [else make "ast item 2 :ast] ; TCO ]] - [[[symbol fn*]] - output fn_new nth :ast 1 :env nth :ast 2 ] + [[fn*] + output fn_new seq_val first :ast :env item 2 :ast ] [else - localmake "el eval_ast :ast :env - localmake "f nth :el 0 + localmake "f _eval :a0 :env case obj_type :f [ [[nativefn] - output apply obj_val :f butfirst obj_val :el ] + output nativefn_apply :f map [_eval ? :env] :ast ] [[fn] - make "env env_new fn_env :f fn_args :f rest :el + 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 @@ -155,16 +142,16 @@ output pr_str :exp "true end to re :str -output _eval _read :str :repl_env +ignore _eval _read :str :repl_env end to rep :str -output _print re :str +output _print _eval _read :str :repl_env end to print_exception :exception if not emptyp :exception [ - localmake "e first butfirst :exception + localmake "e item 2 :exception ifelse :e = "_mal_exception_ [ (print "Error: pr_str :global_exception "false) ] [ @@ -174,19 +161,14 @@ if not emptyp :exception [ end to repl -localmake "running "true -while [:running] [ - localmake "line readline word "user> :space_char - ifelse :line=[] [ - print " - make "running "false - ] [ +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 @@ -195,26 +177,26 @@ end to argv_list localmake "argv ifelse emptyp :command.line [[]] [butfirst :command.line] -output obj_new "list map [obj_new "string ?] :argv +output list_new map "string_new :argv end make "repl_env env_new [] [] [] foreach :core_ns [ - ignore env_set :repl_env first ? first butfirst ? + env_set :repl_env symbol_new ? nativefn_new word "mal_ ? ] -ignore env_set :repl_env [symbol eval] [nativefn mal_eval] -ignore env_set :repl_env [symbol *ARGV*] argv_list +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 -ignore re "|(def! not (fn* (a) (if a false true)))| -ignore re "|(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))| -ignore 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 not emptyp :command.line [ - catch "error [ignore re (word "\(load-file :space_char "\" first :command.line "\"\) )] +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 ] -repl bye diff --git a/impls/logo/step9_try.lg b/impls/logo/step9_try.lg index de7882edef..e72c27f04c 100644 --- a/impls/logo/step9_try.lg +++ b/impls/logo/step9_try.lg @@ -9,163 +9,153 @@ to _read :str output read_str :str end -to starts_with :ast :sym -if (obj_type :ast) <> "list [output "false] -localmake "xs obj_val :ast -if emptyp :xs [output "false] -localmake "a0 first :xs -output and ((obj_type :a0) = "symbol) ((obj_val :a0) = :sym) -end - to quasiquote :ast -if memberp obj_type :ast [hashmap symbol] [output (mal_list symbol_new "quote :ast)] -if not sequentialp :ast [output :ast] -if starts_with :ast "unquote [output nth :ast 1] -localmake "result mal_list -foreach reverse obj_val :ast [ - ifelse starts_with ? "splice-unquote [ - make "result (mal_list symbol_new "concat nth ? 1 :result) - ] [ - make "result (mal_list symbol_new "cons quasiquote ? :result) - ] ] -if (obj_type :ast) = "vector [make "result (mal_list symbol_new "vec :result)] -output :result -end - -to macrocallp :ast :env -if (obj_type :ast) = "list [ - if (_count :ast) > 0 [ - localmake "a0 nth :ast 0 - if (obj_type :a0) = "symbol [ - if not emptyp env_find :env :a0 [ - localmake "f env_get :env :a0 - if (obj_type :f) = "fn [ - output fn_is_macro :f - ] - ] - ] - ] +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] ] -output "false end -to _macroexpand :ast :env -if not macrocallp :ast :env [output :ast] -localmake "a0 nth :ast 0 -localmake "f env_get :env :a0 -output _macroexpand invoke_fn :f rest :ast :env +to qq_seq :xs +localmake "result list_new [] +foreach reverse :xs [make "result qq_folder ? :result] +output :result end -to eval_ast :ast :env -output case (obj_type :ast) [ - [[symbol] env_get :env :ast] - [[list] obj_new "list map [_eval ? :env] obj_val :ast] - [[vector] obj_new "vector map [_eval ? :env] obj_val :ast] - [[hashmap] obj_new "hashmap map [_eval ? :env] obj_val :ast] - [else :ast] +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 :a_ast :a_env -localmake "ast :a_ast -localmake "env :a_env +to _eval :ast :env forever [ - if (obj_type :ast) <> "list [output eval_ast :ast :env] - make "ast _macroexpand :ast :env - if (obj_type :ast) <> "list [output eval_ast :ast :env] - if emptyp obj_val :ast [output :ast] - localmake "a0 nth :ast 0 - case list obj_type :a0 obj_val :a0 [ - [[[symbol def!]] - localmake "a1 nth :ast 1 - localmake "a2 nth :ast 2 - output env_set :env :a1 _eval :a2 :env ] - - [[[symbol let*]] - localmake "a1 nth :ast 1 - localmake "letenv env_new :env [] [] - localmake "i 0 - while [:i < _count :a1] [ - ignore env_set :letenv nth :a1 :i _eval nth :a1 (:i + 1) :letenv - make "i (:i + 2) - ] - make "env :letenv - make "ast nth :ast 2 ] ; TCO +if not memberp obj_type env_get :env symbol_new "DEBUG-EVAL [false nil notfound] [ + (print "EVAL: _print :ast "/ map "_print env_keys :env) +] - [[[symbol quote]] - output nth :ast 1 ] +case obj_type :ast [ - [[[symbol quasiquote]] - make "ast quasiquote nth :ast 1 ] ; TCO + [[symbol] + localmake "val env_get :env :ast + if "notfound = obj_type :val [ + (throw "error sentence (word "' symbol_value :ast "') [not found]) + ] + output :val + ] - [[[symbol quasiquoteexpand]] - output quasiquote nth :ast 1] + [[vector] output vector_new map [_eval ? :env] seq_val :ast] - [[[symbol defmacro!]] - localmake "a1 nth :ast 1 - localmake "a2 nth :ast 2 - localmake "macro_fn _eval :a2 :env - fn_set_macro :macro_fn - output env_set :env :a1 :macro_fn ] + [[map] output map_map [_eval ? :env] :ast] - [[[symbol macroexpand]] - output _macroexpand nth :ast 1 :env ] + [[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] "" [ - [[[symbol try*]] - localmake "a1 nth :ast 1 - if (_count :ast) < 3 [ - output _eval :a1 :env + [[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 first butfirst :exception - localmake "exception_obj ifelse :e = "_mal_exception_ [:global_exception] [obj_new "string :e] - localmake "a2 nth :ast 2 + 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 [] [] - ignore env_set :catchenv nth :a2 1 :exception_obj - output _eval nth :a2 2 :catchenv + env_set :catchenv item 2 :a2 :exception_obj + make "env :catchenv + make "ast item 3 :a2 ; TCO ] ] + ] - [[[symbol do]] - localmake "i 1 - while [:i < ((_count :ast) - 1)] [ - ignore _eval nth :ast :i :env - make "i (:i + 1) + [[do] + foreach :ast [ ; TCO for last item + ifelse emptyp ?rest [make "ast ?] [ignore _eval ? :env] ] - make "ast last obj_val :ast ] ; TCO + ] - [[[symbol if]] - localmake "a1 nth :ast 1 + [[if] + localmake "a1 first :ast localmake "cond _eval :a1 :env case obj_type :cond [ - [[nil false] ifelse (_count :ast) > 3 [ - make "ast nth :ast 3 ; TCO + [[nil false] ifelse 3 = count :ast [ + make "ast item 3 :ast ; TCO ] [ output nil_new ]] - [else make "ast nth :ast 2] ; TCO + [else make "ast item 2 :ast] ; TCO ]] - [[[symbol fn*]] - output fn_new nth :ast 1 :env nth :ast 2 ] + [[fn*] + output fn_new seq_val first :ast :env item 2 :ast ] [else - localmake "el eval_ast :ast :env - localmake "f nth :el 0 + localmake "f _eval :a0 :env case obj_type :f [ [[nativefn] - output apply obj_val :f butfirst obj_val :el ] + output nativefn_apply :f map [_eval ? :env] :ast ] [[fn] - make "env env_new fn_env :f fn_args :f rest :el + 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 @@ -174,16 +164,16 @@ output pr_str :exp "true end to re :str -output _eval _read :str :repl_env +ignore _eval _read :str :repl_env end to rep :str -output _print re :str +output _print _eval _read :str :repl_env end to print_exception :exception if not emptyp :exception [ - localmake "e first butfirst :exception + localmake "e item 2 :exception ifelse :e = "_mal_exception_ [ (print "Error: pr_str :global_exception "false) ] [ @@ -193,19 +183,14 @@ if not emptyp :exception [ end to repl -localmake "running "true -while [:running] [ - localmake "line readline word "user> :space_char - ifelse :line=[] [ - print " - make "running "false - ] [ +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 @@ -214,26 +199,26 @@ end to argv_list localmake "argv ifelse emptyp :command.line [[]] [butfirst :command.line] -output obj_new "list map [obj_new "string ?] :argv +output list_new map "string_new :argv end make "repl_env env_new [] [] [] foreach :core_ns [ - ignore env_set :repl_env first ? first butfirst ? + env_set :repl_env symbol_new ? nativefn_new word "mal_ ? ] -ignore env_set :repl_env [symbol eval] [nativefn mal_eval] -ignore env_set :repl_env [symbol *ARGV*] argv_list +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 -ignore re "|(def! not (fn* (a) (if a false true)))| -ignore re "|(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))| -ignore 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 not emptyp :command.line [ - catch "error [ignore re (word "\(load-file :space_char "\" first :command.line "\"\) )] +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 ] -repl bye diff --git a/impls/logo/stepA_mal.lg b/impls/logo/stepA_mal.lg index c3d1340444..4244e6a880 100644 --- a/impls/logo/stepA_mal.lg +++ b/impls/logo/stepA_mal.lg @@ -9,163 +9,153 @@ to _read :str output read_str :str end -to starts_with :ast :sym -if (obj_type :ast) <> "list [output "false] -localmake "xs obj_val :ast -if emptyp :xs [output "false] -localmake "a0 first :xs -output and ((obj_type :a0) = "symbol) ((obj_val :a0) = :sym) -end - to quasiquote :ast -if memberp obj_type :ast [hashmap symbol] [output (mal_list symbol_new "quote :ast)] -if not sequentialp :ast [output :ast] -if starts_with :ast "unquote [output nth :ast 1] -localmake "result mal_list -foreach reverse obj_val :ast [ - ifelse starts_with ? "splice-unquote [ - make "result (mal_list symbol_new "concat nth ? 1 :result) - ] [ - make "result (mal_list symbol_new "cons quasiquote ? :result) - ] ] -if (obj_type :ast) = "vector [make "result (mal_list symbol_new "vec :result)] -output :result -end - -to macrocallp :ast :env -if (obj_type :ast) = "list [ - if (_count :ast) > 0 [ - localmake "a0 nth :ast 0 - if (obj_type :a0) = "symbol [ - if not emptyp env_find :env :a0 [ - localmake "f env_get :env :a0 - if (obj_type :f) = "fn [ - output fn_is_macro :f - ] - ] - ] - ] +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] ] -output "false end -to _macroexpand :ast :env -if not macrocallp :ast :env [output :ast] -localmake "a0 nth :ast 0 -localmake "f env_get :env :a0 -output _macroexpand invoke_fn :f rest :ast :env +to qq_seq :xs +localmake "result list_new [] +foreach reverse :xs [make "result qq_folder ? :result] +output :result end -to eval_ast :ast :env -output case (obj_type :ast) [ - [[symbol] env_get :env :ast] - [[list] obj_new "list map [_eval ? :env] obj_val :ast] - [[vector] obj_new "vector map [_eval ? :env] obj_val :ast] - [[hashmap] obj_new "hashmap map [_eval ? :env] obj_val :ast] - [else :ast] +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 :a_ast :a_env -localmake "ast :a_ast -localmake "env :a_env +to _eval :ast :env forever [ - if (obj_type :ast) <> "list [output eval_ast :ast :env] - make "ast _macroexpand :ast :env - if (obj_type :ast) <> "list [output eval_ast :ast :env] - if emptyp obj_val :ast [output :ast] - localmake "a0 nth :ast 0 - case list obj_type :a0 obj_val :a0 [ - [[[symbol def!]] - localmake "a1 nth :ast 1 - localmake "a2 nth :ast 2 - output env_set :env :a1 _eval :a2 :env ] - - [[[symbol let*]] - localmake "a1 nth :ast 1 - localmake "letenv env_new :env [] [] - localmake "i 0 - while [:i < _count :a1] [ - ignore env_set :letenv nth :a1 :i _eval nth :a1 (:i + 1) :letenv - make "i (:i + 2) - ] - make "env :letenv - make "ast nth :ast 2 ] ; TCO +if not memberp obj_type env_get :env symbol_new "DEBUG-EVAL [false nil notfound] [ + (print "EVAL: _print :ast "/ map "_print env_keys :env) +] - [[[symbol quote]] - output nth :ast 1 ] +case obj_type :ast [ - [[[symbol quasiquote]] - make "ast quasiquote nth :ast 1 ] ; TCO + [[symbol] + localmake "val env_get :env :ast + if "notfound = obj_type :val [ + (throw "error sentence (word "' symbol_value :ast "') [not found]) + ] + output :val + ] - [[[symbol quasiquoteexpand]] - output quasiquote nth :ast 1] + [[vector] output vector_new map [_eval ? :env] seq_val :ast] - [[[symbol defmacro!]] - localmake "a1 nth :ast 1 - localmake "a2 nth :ast 2 - localmake "macro_fn _eval :a2 :env - fn_set_macro :macro_fn - output env_set :env :a1 :macro_fn ] + [[map] output map_map [_eval ? :env] :ast] - [[[symbol macroexpand]] - output _macroexpand nth :ast 1 :env ] + [[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] "" [ - [[[symbol try*]] - localmake "a1 nth :ast 1 - if (_count :ast) < 3 [ - output _eval :a1 :env + [[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 first butfirst :exception - localmake "exception_obj ifelse :e = "_mal_exception_ [:global_exception] [obj_new "string :e] - localmake "a2 nth :ast 2 + 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 [] [] - ignore env_set :catchenv nth :a2 1 :exception_obj - output _eval nth :a2 2 :catchenv + env_set :catchenv item 2 :a2 :exception_obj + make "env :catchenv + make "ast item 3 :a2 ; TCO ] ] + ] - [[[symbol do]] - localmake "i 1 - while [:i < ((_count :ast) - 1)] [ - ignore _eval nth :ast :i :env - make "i (:i + 1) + [[do] + foreach :ast [ ; TCO for last item + ifelse emptyp ?rest [make "ast ?] [ignore _eval ? :env] ] - make "ast last obj_val :ast ] ; TCO + ] - [[[symbol if]] - localmake "a1 nth :ast 1 + [[if] + localmake "a1 first :ast localmake "cond _eval :a1 :env case obj_type :cond [ - [[nil false] ifelse (_count :ast) > 3 [ - make "ast nth :ast 3 ; TCO + [[nil false] ifelse 3 = count :ast [ + make "ast item 3 :ast ; TCO ] [ output nil_new ]] - [else make "ast nth :ast 2] ; TCO + [else make "ast item 2 :ast] ; TCO ]] - [[[symbol fn*]] - output fn_new nth :ast 1 :env nth :ast 2 ] + [[fn*] + output fn_new seq_val first :ast :env item 2 :ast ] [else - localmake "el eval_ast :ast :env - localmake "f nth :el 0 + localmake "f _eval :a0 :env case obj_type :f [ [[nativefn] - output apply obj_val :f butfirst obj_val :el ] + output nativefn_apply :f map [_eval ? :env] :ast ] [[fn] - make "env env_new fn_env :f fn_args :f rest :el + 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 @@ -174,16 +164,16 @@ output pr_str :exp "true end to re :str -output _eval _read :str :repl_env +ignore _eval _read :str :repl_env end to rep :str -output _print re :str +output _print _eval _read :str :repl_env end to print_exception :exception if not emptyp :exception [ - localmake "e first butfirst :exception + localmake "e item 2 :exception ifelse :e = "_mal_exception_ [ (print "Error: pr_str :global_exception "false) ] [ @@ -193,19 +183,14 @@ if not emptyp :exception [ end to repl -localmake "running "true -while [:running] [ - localmake "line readline word "user> :space_char - ifelse :line=[] [ - print " - make "running "false - ] [ +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 @@ -214,28 +199,28 @@ end to argv_list localmake "argv ifelse emptyp :command.line [[]] [butfirst :command.line] -output obj_new "list map [obj_new "string ?] :argv +output list_new map "string_new :argv end make "repl_env env_new [] [] [] foreach :core_ns [ - ignore env_set :repl_env first ? first butfirst ? + env_set :repl_env symbol_new ? nativefn_new word "mal_ ? ] -ignore env_set :repl_env [symbol eval] [nativefn mal_eval] -ignore env_set :repl_env [symbol *ARGV*] argv_list +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 -ignore re "|(def! *host-language* "logo")| -ignore re "|(def! not (fn* (a) (if a false true)))| -ignore re "|(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))| -ignore 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 not emptyp :command.line [ - catch "error [ignore re (word "\(load-file :space_char "\" first :command.line "\"\) )] +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 ] -ignore re "|(println (str "Mal [" *host-language* "]"))| -repl bye diff --git a/impls/logo/tests/stepA_mal.mal b/impls/logo/tests/stepA_mal.mal index 9175626d1f..7e1cdb7a93 100644 --- a/impls/logo/tests/stepA_mal.mal +++ b/impls/logo/tests/stepA_mal.mal @@ -23,7 +23,7 @@ (logo-eval ":foo") ;=>8 -(logo-eval "apply \"word map [reverse ?] [Abc Abcd Abcde]") +(logo-eval "apply \"word map \"reverse [Abc Abcd Abcde]") ;=>"cbAdcbAedcbA" (logo-eval "map [1 + ?] [1 2 3]") diff --git a/impls/logo/types.lg b/impls/logo/types.lg index dd5fcd1a98..947d6dcb50 100644 --- a/impls/logo/types.lg +++ b/impls/logo/types.lg @@ -10,162 +10,194 @@ catch "case.error [output case.helper :case.value :case.clauses] (throw "error [Empty CASE clause]) end -to obj_new :type :val -output list :type :val +; 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 obj_new_with_meta :type :val :meta -output (list :type :val :meta) +to list_new :val +output list "list :val end -to obj_type :obj -output first :obj +to vector_new :val +output list "vector :val end -to obj_val :obj +to seq_val :obj output item 2 :obj end -to obj_meta :obj -if (count :obj) < 3 [output []] -output item 3 :obj +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 obj_new "nil [] +make "global_nil [nil] to nil_new output :global_nil end -make "global_true obj_new "true [] +make "global_false [false] +make "global_true [true] -to true_new -output :global_true +to bool_to_mal :bool +output ifelse :bool ":global_true ":global_false end -make "global_false obj_new "false [] +to number_new :val +output :val +end -to false_new -output :global_false +to number_val :obj +output :obj end to symbol_new :name -output obj_new "symbol :name +output list "symbol :name end -to hashmap_get :h :key -localmake "i 1 -while [:i < count :h] [ - if equal_q item :i :h :key [ - output item (:i + 1) :h - ] - make "i (:i + 2) -] -output [] +to symbol_value :obj +output item 2 :obj end -; Returns a new list with the key-val pair set -to hashmap_put :h :key :val -localmake "res hashmap_delete :h :key -make "res lput :key :res -make "res lput :val :res -output :res +to keyword_new :val +output list "keyword :val end -; Returns a new list without the key-val pair set -to hashmap_delete :h :key -localmake "res [] -localmake "i 1 -while [:i < count :h] [ - if (item :i :h) <> :key [ - make "res lput item :i :h :res - make "res lput item (:i + 1) :h :res +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) ] - make "i (:i + 2) ] -output :res +output :map end -to fn_new :args :env :body -output obj_new "fn (list :args :env :body "false) +; 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 fn_args :fn -output item 1 obj_val :fn +to map_keys :map +output item 2 :map end -to fn_env :fn -output item 2 obj_val :fn +to map_vals :map +output item 3 :map end -to fn_body :fn -output item 3 obj_val :fn +to map_map :fn :map +output (list "map item 2 :map map :fn item 3 :map) end -to fn_is_macro :fn -output item 4 obj_val :fn +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_set_macro :fn -.setfirst butfirst butfirst butfirst obj_val :fn "true +to fn_apply :fn :args +output _eval item 3 :fn fn_gen_env :fn :args end -; zero-based sequence addressing -to nth :seq :index -output item (:index + 1) obj_val :seq +to fn_env :fn +output item 2 :fn end -to _count :seq -output count obj_val :seq +to fn_body :fn +output item 3 :fn end -to rest :seq -output obj_new obj_type :seq butfirst obj_val :seq +to macro_new :fn +output list "macro :fn end -to drop :seq :num -if or :num = 0 (_count :seq) = 0 [output :seq] -foreach obj_val :seq [ - if # >= :num [output obj_new obj_type :seq ?rest] -] +to macro_apply :fn :args +output fn_apply item 2 :fn :args end -to sequentialp :obj -output memberp obj_type :obj [list vector] +to mal_atom :value +output listtoarray list "atom :value end -to equal_sequential_q :a :b -if (_count :a) <> (_count :b) [output "false] -(foreach obj_val :a obj_val :b [ - if not equal_q ?1 ?2 [output "false] -]) -output "true +to mal_deref :a +output item 2 :a end -to equal_hashmap_q :a :b -if (_count :a) <> (_count :b) [output "false] -localmake "a_keys obj_val mal_keys :a -foreach :a_keys [ - localmake "a_val hashmap_get obj_val :a ? - localmake "b_val hashmap_get obj_val :b ? - if emptyp :b_val [output "false] - if not equal_q :a_val :b_val [output "false] -] -output "true -end - -to equal_q :a :b -output cond [ - [[and sequentialp :a sequentialp :b] - equal_sequential_q :a :b] - [[((obj_type :a) = (obj_type :b))] - case obj_type :a [ - [[true false nil] "true] - [[number string keyword symbol] ((obj_val :a) = (obj_val :b))] - [[hashmap] equal_hashmap_q :a :b] - [[atom] equal_q obj_val :a obj_val :b] - [else "false] - ]] - [else "false] -] +to mal_reset! :a :val +.setitem 2 :a :val +output :val end diff --git a/impls/make/env.mk b/impls/make/env.mk index c8f8792a10..733ac62b56 100644 --- a/impls/make/env.mk +++ b/impls/make/env.mk @@ -36,14 +36,8 @@ endef # $(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)$(__nil),$(call _get,$(strip $(subst |,,$(env))),$(subst =,$(__equal),$(2))))) + +ENV_GET = $(if $(call _EQ,$(1),$(__nil)),,$(or $(_get),$(call ENV_GET,$(call _get,$(1),__outer__),$(2)))) ENV_SET = $(if $(call _assoc!,$(1),$(subst =,$(__equal),$(2)),$(3)),$(1),) diff --git a/impls/make/step2_eval.mk b/impls/make/step2_eval.mk index f02c97532c..f03d6d73de 100644 --- a/impls/make/step2_eval.mk +++ b/impls/make/step2_eval.mk @@ -16,17 +16,22 @@ define READ $(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) endef +define EVAL_INVOKE +$(if $(__ERROR),,\ + $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1))))\ + $(foreach el,$(call _smap,EVAL,$(1),$(2)),\ + $(call _apply,$(call sfirst,$(el)),$(call srest,$(el))))) +endef + # EVAL: evaluate the parameter -define EVAL_AST -$(strip \ +define EVAL +$(strip $(if $(__ERROR),,\ $(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))),\ - $(if $(call _list?,$(1)),\ - $(call _smap,EVAL,$(1),$(2)),\ $(if $(call _vector?,$(1)),\ $(call _smap_vec,EVAL,$(1),$(2)),\ $(if $(call _hash_map?,$(1)),\ @@ -35,24 +40,11 @@ $(strip \ $(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))))) + $(1))))))) endef diff --git a/impls/make/step3_env.mk b/impls/make/step3_env.mk index 810e296501..ccd1fbfd20 100644 --- a/impls/make/step3_env.mk +++ b/impls/make/step3_env.mk @@ -30,25 +30,6 @@ $(strip \ $(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)))) @@ -63,18 +44,31 @@ $(if $(__ERROR),,\ $(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)),\ + $(foreach el,$(call _smap,EVAL,$(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 $(filter-out false nil,$(call _obj_type,$(or $(call ENV_GET,$(2),DEBUG-EVAL),$(__nil)))),\ + $(info EVAL: $(_pr_str)))\ + $(if $(call _symbol?,$(1)),\ + $(foreach key,$($(1)_value),\ + $(or $(call ENV_GET,$(2),$(key)),\ + $(call _error,'$(key)' not found)$(__nil))),\ + $(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)),\ $(if $(call _list?,$(1)),\ $(if $(call _EQ,0,$(call _count,$(1))),\ $(1),\ - $(strip $(call EVAL_INVOKE,$(1),$(2)))),\ - $(call EVAL_AST,$(1),$(2))))) + $(word 1,$(strip $(call EVAL_INVOKE,$(1),$(2)) $(__nil)))),\ + $(1))))))) endef diff --git a/impls/make/step4_if_fn_do.mk b/impls/make/step4_if_fn_do.mk index 0fa266d691..529f5e5a5c 100644 --- a/impls/make/step4_if_fn_do.mk +++ b/impls/make/step4_if_fn_do.mk @@ -30,25 +30,6 @@ $(strip \ $(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)))) @@ -64,7 +45,7 @@ $(if $(__ERROR),,\ $(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))),\ + $(call slast,$(call _smap,EVAL,$(call srest,$(1)),$(2))),\ $(if $(call _EQ,if,$($(a0)_value)),\ $(foreach a1,$(call _nth,$(1),1),\ $(foreach a2,$(call _nth,$(1),2),\ @@ -76,7 +57,7 @@ $(if $(__ERROR),,\ $(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)),\ + $(foreach el,$(call _smap,EVAL,$(1),$(2)),\ $(and $(EVAL_DEBUG),$(info invoke: $(call _pr_str,$(el))))\ $(foreach f,$(call sfirst,$(el)),\ $(foreach args,$(call srest,$(el)),\ @@ -85,12 +66,25 @@ endef define EVAL $(strip $(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL: $(call _pr_str,$(1))))\ + $(if $(filter-out false nil,$(call _obj_type,$(or $(call ENV_GET,$(2),DEBUG-EVAL),$(__nil)))),\ + $(info EVAL: $(_pr_str)))\ + $(if $(call _symbol?,$(1)),\ + $(foreach key,$($(1)_value),\ + $(or $(call ENV_GET,$(2),$(key)),\ + $(call _error,'$(key)' not found)$(__nil))),\ + $(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)),\ $(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))))) + $(1))))))) endef diff --git a/impls/make/step6_file.mk b/impls/make/step6_file.mk index f851747e52..6bdad802ce 100644 --- a/impls/make/step6_file.mk +++ b/impls/make/step6_file.mk @@ -30,25 +30,6 @@ $(strip \ $(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)))) @@ -64,7 +45,7 @@ $(if $(__ERROR),,\ $(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))),\ + $(call slast,$(call _smap,EVAL,$(call srest,$(1)),$(2))),\ $(if $(call _EQ,if,$($(a0)_value)),\ $(foreach a1,$(call _nth,$(1),1),\ $(foreach a2,$(call _nth,$(1),2),\ @@ -76,7 +57,7 @@ $(if $(__ERROR),,\ $(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)),\ + $(foreach el,$(call _smap,EVAL,$(1),$(2)),\ $(and $(EVAL_DEBUG),$(info invoke: $(call _pr_str,$(el))))\ $(foreach f,$(call sfirst,$(el)),\ $(foreach args,$(call srest,$(el)),\ @@ -85,12 +66,25 @@ endef define EVAL $(strip $(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL: $(call _pr_str,$(1))))\ + $(if $(filter-out false nil,$(call _obj_type,$(or $(call ENV_GET,$(2),DEBUG-EVAL),$(__nil)))),\ + $(info EVAL: $(_pr_str)))\ + $(if $(call _symbol?,$(1)),\ + $(foreach key,$($(1)_value),\ + $(or $(call ENV_GET,$(2),$(key)),\ + $(call _error,'$(key)' not found)$(__nil))),\ + $(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)),\ $(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))))) + $(1))))))) endef diff --git a/impls/make/step7_quote.mk b/impls/make/step7_quote.mk index 92c0dcb777..a239e5cb69 100644 --- a/impls/make/step7_quote.mk +++ b/impls/make/step7_quote.mk @@ -49,25 +49,6 @@ $(strip \ $(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)))) @@ -84,12 +65,10 @@ $(if $(__ERROR),,\ $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ $(if $(call _EQ,quote,$($(a0)_value)),\ $(call _nth,$(1),1),\ - $(if $(call _EQ,quasiquoteexpand,$($(a0)_value)),\ - $(call QUASIQUOTE,$(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))),\ + $(call slast,$(call _smap,EVAL,$(call srest,$(1)),$(2))),\ $(if $(call _EQ,if,$($(a0)_value)),\ $(foreach a1,$(call _nth,$(1),1),\ $(foreach a2,$(call _nth,$(1),2),\ @@ -101,21 +80,34 @@ $(if $(__ERROR),,\ $(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)),\ + $(foreach el,$(call _smap,EVAL,$(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))))))))))))))) + $(call apply,$(f),$(args)))))))))))))) endef define EVAL $(strip $(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL: $(call _pr_str,$(1))))\ + $(if $(filter-out false nil,$(call _obj_type,$(or $(call ENV_GET,$(2),DEBUG-EVAL),$(__nil)))),\ + $(info EVAL: $(_pr_str)))\ + $(if $(call _symbol?,$(1)),\ + $(foreach key,$($(1)_value),\ + $(or $(call ENV_GET,$(2),$(key)),\ + $(call _error,'$(key)' not found)$(__nil))),\ + $(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)),\ $(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))))) + $(1))))))) endef diff --git a/impls/make/step8_macros.mk b/impls/make/step8_macros.mk index 36a3d6afb3..07f17b7000 100644 --- a/impls/make/step8_macros.mk +++ b/impls/make/step8_macros.mk @@ -36,18 +36,6 @@ QUASIQUOTE = $(strip \ $(if $(_vector?), $(call _list,$(call _symbol,vec) $(QQ_FOLD)),\ $(if $(_symbol?)$(_hash_map?), $(call _list,$(call _symbol,quote) $1),\ $1)))) -define IS_MACRO_CALL -$(if $(call _list?,$(1)),$(if $(call ENV_FIND,$(2),$($(call _nth,$(1),0)_value)),$(_macro_$(call ENV_GET,$(2),$($(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) \ @@ -60,25 +48,6 @@ $(strip \ $(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)))) @@ -95,8 +64,6 @@ $(if $(__ERROR),,\ $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ $(if $(call _EQ,quote,$($(a0)_value)),\ $(call _nth,$(1),1),\ - $(if $(call _EQ,quasiquoteexpand,$($(a0)_value)),\ - $(call QUASIQUOTE,$(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)),\ @@ -105,10 +72,8 @@ $(if $(__ERROR),,\ $(foreach res,$(call _clone_obj,$(call EVAL,$(a2),$(2))),\ $(eval _macro_$(res) = 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))),\ + $(call slast,$(call _smap,EVAL,$(call srest,$(1)),$(2))),\ $(if $(call _EQ,if,$($(a0)_value)),\ $(foreach a1,$(call _nth,$(1),1),\ $(foreach a2,$(call _nth,$(1),2),\ @@ -120,24 +85,34 @@ $(if $(__ERROR),,\ $(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))))))))))))))))) + $(foreach f,$(call EVAL,$(a0),$(2)),\ + $(foreach args,$(call srest,$(1)),\ + $(if $(_macro_$(f)),\ + $(call EVAL,$(call apply,$(f),$(args)),$(2)),\ + $(call apply,$(f),$(call _smap,EVAL,$(args),$(2)))))))))))))))) endef define EVAL $(strip $(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL: $(call _pr_str,$(1))))\ + $(if $(filter-out false nil,$(call _obj_type,$(or $(call ENV_GET,$(2),DEBUG-EVAL),$(__nil)))),\ + $(info EVAL: $(_pr_str)))\ + $(if $(call _symbol?,$(1)),\ + $(foreach key,$($(1)_value),\ + $(or $(call ENV_GET,$(2),$(key)),\ + $(call _error,'$(key)' not found)$(__nil))),\ + $(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)),\ $(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))))) + $(if $(call _EQ,0,$(call _count,$(1))),\ + $(1),\ + $(word 1,$(strip $(call EVAL_INVOKE,$(1),$(2)) $(__nil)))),\ + $(1))))))) endef diff --git a/impls/make/step9_try.mk b/impls/make/step9_try.mk index 1fea14424d..7a9b8653b1 100644 --- a/impls/make/step9_try.mk +++ b/impls/make/step9_try.mk @@ -36,18 +36,6 @@ QUASIQUOTE = $(strip \ $(if $(_vector?), $(call _list,$(call _symbol,vec) $(QQ_FOLD)),\ $(if $(_symbol?)$(_hash_map?), $(call _list,$(call _symbol,quote) $1),\ $1)))) -define IS_MACRO_CALL -$(if $(call _list?,$(1)),$(if $(call ENV_FIND,$(2),$($(call _nth,$(1),0)_value)),$(_macro_$(call ENV_GET,$(2),$($(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) \ @@ -60,25 +48,6 @@ $(strip \ $(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)))) @@ -95,8 +64,6 @@ $(if $(__ERROR),,\ $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ $(if $(call _EQ,quote,$($(a0)_value)),\ $(call _nth,$(1),1),\ - $(if $(call _EQ,quasiquoteexpand,$($(a0)_value)),\ - $(call QUASIQUOTE,$(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)),\ @@ -105,8 +72,6 @@ $(if $(__ERROR),,\ $(foreach res,$(call _clone_obj,$(call EVAL,$(a2),$(2))),\ $(eval _macro_$(res) = 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)),\ @@ -123,7 +88,7 @@ $(if $(__ERROR),,\ $(res)))),\ $(res)))),\ $(if $(call _EQ,do,$($(a0)_value)),\ - $(call slast,$(call EVAL_AST,$(call srest,$(1)),$(2))),\ + $(call slast,$(call _smap,EVAL,$(call srest,$(1)),$(2))),\ $(if $(call _EQ,if,$($(a0)_value)),\ $(foreach a1,$(call _nth,$(1),1),\ $(foreach a2,$(call _nth,$(1),2),\ @@ -135,24 +100,34 @@ $(if $(__ERROR),,\ $(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)))))))))))))))))) + $(foreach f,$(call EVAL,$(a0),$(2)),\ + $(foreach args,$(call srest,$(1)),\ + $(if $(_macro_$(f)),\ + $(call EVAL,$(call apply,$(f),$(args)),$(2)),\ + $(call apply,$(f),$(call _smap,EVAL,$(args),$(2))))))))))))))))) endef define EVAL $(strip $(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL: $(call _pr_str,$(1))))\ + $(if $(filter-out false nil,$(call _obj_type,$(or $(call ENV_GET,$(2),DEBUG-EVAL),$(__nil)))),\ + $(info EVAL: $(_pr_str)))\ + $(if $(call _symbol?,$(1)),\ + $(foreach key,$($(1)_value),\ + $(or $(call ENV_GET,$(2),$(key)),\ + $(call _error,'$(key)' not found)$(__nil))),\ + $(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)),\ $(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))))) + $(if $(call _EQ,0,$(call _count,$(1))),\ + $(1),\ + $(word 1,$(strip $(call EVAL_INVOKE,$(1),$(2)) $(__nil)))),\ + $(1))))))) endef diff --git a/impls/make/stepA_mal.mk b/impls/make/stepA_mal.mk index ab52629d9e..275524ee6c 100644 --- a/impls/make/stepA_mal.mk +++ b/impls/make/stepA_mal.mk @@ -36,18 +36,6 @@ QUASIQUOTE = $(strip \ $(if $(_vector?), $(call _list,$(call _symbol,vec) $(QQ_FOLD)),\ $(if $(_symbol?)$(_hash_map?), $(call _list,$(call _symbol,quote) $1),\ $1)))) -define IS_MACRO_CALL -$(if $(call _list?,$(1)),$(if $(call ENV_FIND,$(2),$($(call _nth,$(1),0)_value)),$(_macro_$(call ENV_GET,$(2),$($(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) \ @@ -60,25 +48,6 @@ $(strip \ $(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)))) @@ -95,8 +64,6 @@ $(if $(__ERROR),,\ $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ $(if $(call _EQ,quote,$($(a0)_value)),\ $(call _nth,$(1),1),\ - $(if $(call _EQ,quasiquoteexpand,$($(a0)_value)),\ - $(call QUASIQUOTE,$(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)),\ @@ -105,8 +72,6 @@ $(if $(__ERROR),,\ $(foreach res,$(call _clone_obj,$(call EVAL,$(a2),$(2))),\ $(eval _macro_$(res) = 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)))))\ @@ -127,7 +92,7 @@ $(if $(__ERROR),,\ $(res)))),\ $(res)))),\ $(if $(call _EQ,do,$($(a0)_value)),\ - $(call slast,$(call EVAL_AST,$(call srest,$(1)),$(2))),\ + $(call slast,$(call _smap,EVAL,$(call srest,$(1)),$(2))),\ $(if $(call _EQ,if,$($(a0)_value)),\ $(foreach a1,$(call _nth,$(1),1),\ $(foreach a2,$(call _nth,$(1),2),\ @@ -139,24 +104,34 @@ $(if $(__ERROR),,\ $(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))))))))))))))))))) + $(foreach f,$(call EVAL,$(a0),$(2)),\ + $(foreach args,$(call srest,$(1)),\ + $(if $(_macro_$(f)),\ + $(call EVAL,$(call apply,$(f),$(args)),$(2)),\ + $(call apply,$(f),$(call _smap,EVAL,$(args),$(2)))))))))))))))))) endef define EVAL $(strip $(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL: $(call _pr_str,$(1))))\ + $(if $(filter-out false nil,$(call _obj_type,$(or $(call ENV_GET,$(2),DEBUG-EVAL),$(__nil)))),\ + $(info EVAL: $(_pr_str)))\ + $(if $(call _symbol?,$(1)),\ + $(foreach key,$($(1)_value),\ + $(or $(call ENV_GET,$(2),$(key)),\ + $(call _error,'$(key)' not found)$(__nil))),\ + $(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)),\ $(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))))) + $(if $(call _EQ,0,$(call _count,$(1))),\ + $(1),\ + $(word 1,$(strip $(call EVAL_INVOKE,$(1),$(2)) $(__nil)))),\ + $(1))))))) endef diff --git a/impls/mal/env.mal b/impls/mal/env.mal index b802ddad54..41b97e8a75 100644 --- a/impls/mal/env.mal +++ b/impls/mal/env.mal @@ -16,10 +16,16 @@ (atom {:outer (first args)}) (atom (apply bind-env {:outer (first args)} (rest args)))))) -(def! env-find (fn* [env k] - (env-find-str env (str k)))) +(def! env-as-map (fn* [env] + (dissoc @env :outer))) -;; Private helper for env-find and env-get. +(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] diff --git a/impls/mal/step2_eval.mal b/impls/mal/step2_eval.mal index a42c47482f..4aa16dd82f 100644 --- a/impls/mal/step2_eval.mal +++ b/impls/mal/step2_eval.mal @@ -7,35 +7,31 @@ ;; eval -(def! eval-ast (fn* [ast env] - ;; (do (prn "eval-ast" ast "/" (keys env)) ) - (cond - (symbol? ast) (let* [res (get env (str ast))] - (if res res (throw (str ast " not found")))) - - (list? ast) (map (fn* [exp] (EVAL exp 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)))) - - "else" ast))) - - (def! EVAL (fn* [ast env] - ;; (do (prn "EVAL" ast) ) + ;; (do (prn 'EVAL: ast)) (try* - (if (not (list? ast)) - (eval-ast ast env) + (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)) - ;; apply list + (map? ast) + (apply hash-map + (apply concat (map (fn* [k] [k (EVAL (get ast k) env)]) (keys ast)))) + + (list? ast) (if (empty? ast) - ast - (let* [el (eval-ast ast env)] - (apply (first el) (rest el))))) + () + (let* [a0 (first ast) + f (EVAL a0 env) + args (rest ast)] + (apply f (map (fn* [exp] (EVAL exp env)) args)))) + + "else" + ast) (catch* exc (do diff --git a/impls/mal/step3_env.mal b/impls/mal/step3_env.mal index ef813b833b..1658160279 100644 --- a/impls/mal/step3_env.mal +++ b/impls/mal/step3_env.mal @@ -9,22 +9,6 @@ ;; eval -(def! eval-ast (fn* [ast env] - ;; (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) (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)))) - - "else" ast))) - (def! LET (fn* [env binds form] (if (empty? binds) (EVAL form env) @@ -33,31 +17,44 @@ (LET env (rest (rest binds)) form))))) (def! EVAL (fn* [ast env] - ;; (do (prn "EVAL" ast "/" (keys @env)) ) - (try* - (if (not (list? ast)) - (eval-ast ast env) - - ;; apply list - (let* [a0 (first ast)] - (cond - (empty? ast) - ast - - (= 'def! a0) - (env-set env (nth ast 1) (EVAL (nth ast 2) env)) - - (= 'let* a0) - (LET (new-env env) (nth ast 1) (nth ast 2)) - - "else" - (let* [el (eval-ast ast env)] - (apply (first el) (rest el)))))) + (do + (if (env-get-or-nil env 'DEBUG-EVAL) + (prn 'EVAL: 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) + (env-set env (nth ast 1) (EVAL (nth ast 2) env)) + + (= 'let* a0) + (LET (new-env env) (nth ast 1) (nth ast 2)) + + "else" + (let* [f (EVAL a0 env) + args (rest ast)] + (apply f (map (fn* [exp] (EVAL exp env)) args)))))) + + "else" + ast) (catch* exc (do (swap! trace str "\n in mal EVAL: " ast) - (throw exc)))))) + (throw exc))))))) ;; print (def! PRINT pr-str) diff --git a/impls/mal/step4_if_fn_do.mal b/impls/mal/step4_if_fn_do.mal index cd6b05ffa4..c98b470e06 100644 --- a/impls/mal/step4_if_fn_do.mal +++ b/impls/mal/step4_if_fn_do.mal @@ -10,22 +10,6 @@ ;; eval -(def! eval-ast (fn* [ast env] - ;; (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) (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)))) - - "else" ast))) - (def! LET (fn* [env binds form] (if (empty? binds) (EVAL form env) @@ -34,43 +18,56 @@ (LET env (rest (rest binds)) form))))) (def! EVAL (fn* [ast env] - ;; (do (prn "EVAL" ast "/" (keys @env)) ) - (try* - (if (not (list? ast)) - (eval-ast ast env) - - ;; apply list - (let* [a0 (first ast)] - (cond - (empty? ast) - ast - - (= 'def! a0) - (env-set env (nth ast 1) (EVAL (nth ast 2) env)) - - (= 'let* a0) - (LET (new-env env) (nth ast 1) (nth ast 2)) - - (= 'do a0) - (nth (eval-ast (rest ast) env) (- (count ast) 2)) - - (= 'if a0) - (if (EVAL (nth ast 1) env) - (EVAL (nth ast 2) env) - (if (> (count ast) 3) - (EVAL (nth ast 3) env))) - - (= 'fn* a0) - (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) - - "else" - (let* [el (eval-ast ast env)] - (apply (first el) (rest el)))))) + (do + (if (env-get-or-nil env 'DEBUG-EVAL) + (prn 'EVAL: 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) + (env-set env (nth ast 1) (EVAL (nth ast 2) env)) + + (= 'let* a0) + (LET (new-env env) (nth ast 1) (nth ast 2)) + + (= 'do a0) + (nth (map (fn* [exp] (EVAL exp env)) (rest ast)) (- (count ast) 2)) + + (= 'if a0) + (if (EVAL (nth ast 1) env) + (EVAL (nth ast 2) env) + (if (> (count ast) 3) + (EVAL (nth ast 3) env))) + + (= 'fn* a0) + (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) + + "else" + (let* [f (EVAL a0 env) + args (rest ast)] + (apply f (map (fn* [exp] (EVAL exp env)) args)))))) + + "else" + ast) (catch* exc (do (swap! trace str "\n in mal EVAL: " ast) - (throw exc)))))) + (throw exc))))))) ;; print (def! PRINT pr-str) diff --git a/impls/mal/step6_file.mal b/impls/mal/step6_file.mal index 3d7ee78607..e1ebec480e 100644 --- a/impls/mal/step6_file.mal +++ b/impls/mal/step6_file.mal @@ -10,22 +10,6 @@ ;; eval -(def! eval-ast (fn* [ast env] - ;; (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) (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)))) - - "else" ast))) - (def! LET (fn* [env binds form] (if (empty? binds) (EVAL form env) @@ -34,43 +18,56 @@ (LET env (rest (rest binds)) form))))) (def! EVAL (fn* [ast env] - ;; (do (prn "EVAL" ast "/" (keys @env)) ) - (try* - (if (not (list? ast)) - (eval-ast ast env) - - ;; apply list - (let* [a0 (first ast)] - (cond - (empty? ast) - ast - - (= 'def! a0) - (env-set env (nth ast 1) (EVAL (nth ast 2) env)) - - (= 'let* a0) - (LET (new-env env) (nth ast 1) (nth ast 2)) - - (= 'do a0) - (nth (eval-ast (rest ast) env) (- (count ast) 2)) - - (= 'if a0) - (if (EVAL (nth ast 1) env) - (EVAL (nth ast 2) env) - (if (> (count ast) 3) - (EVAL (nth ast 3) env))) - - (= 'fn* a0) - (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) - - "else" - (let* [el (eval-ast ast env)] - (apply (first el) (rest el)))))) + (do + (if (env-get-or-nil env 'DEBUG-EVAL) + (prn 'EVAL: 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) + (env-set env (nth ast 1) (EVAL (nth ast 2) env)) + + (= 'let* a0) + (LET (new-env env) (nth ast 1) (nth ast 2)) + + (= 'do a0) + (nth (map (fn* [exp] (EVAL exp env)) (rest ast)) (- (count ast) 2)) + + (= 'if a0) + (if (EVAL (nth ast 1) env) + (EVAL (nth ast 2) env) + (if (> (count ast) 3) + (EVAL (nth ast 3) env))) + + (= 'fn* a0) + (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) + + "else" + (let* [f (EVAL a0 env) + args (rest ast)] + (apply f (map (fn* [exp] (EVAL exp env)) args)))))) + + "else" + ast) (catch* exc (do (swap! trace str "\n in mal EVAL: " ast) - (throw exc)))))) + (throw exc))))))) ;; print (def! PRINT pr-str) diff --git a/impls/mal/step7_quote.mal b/impls/mal/step7_quote.mal index 9e85f55d75..54b9cfd26c 100644 --- a/impls/mal/step7_quote.mal +++ b/impls/mal/step7_quote.mal @@ -28,22 +28,6 @@ (= (first ast) 'unquote) (nth ast 1) "else" (qq-foldr ast)))) -(def! eval-ast (fn* [ast env] - ;; (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) (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)))) - - "else" ast))) - (def! LET (fn* [env binds form] (if (empty? binds) (EVAL form env) @@ -52,52 +36,62 @@ (LET env (rest (rest binds)) form))))) (def! EVAL (fn* [ast env] - ;; (do (prn "EVAL" ast "/" (keys @env)) ) - (try* - (if (not (list? ast)) - (eval-ast ast env) - - ;; apply list - (let* [a0 (first ast)] - (cond - (empty? ast) - ast - - (= 'def! a0) - (env-set env (nth ast 1) (EVAL (nth ast 2) env)) - - (= 'let* a0) - (LET (new-env env) (nth ast 1) (nth ast 2)) - - (= 'quote a0) - (nth ast 1) - - (= 'quasiquoteexpand a0) - (QUASIQUOTE (nth ast 1)) - - (= 'quasiquote a0) - (EVAL (QUASIQUOTE (nth ast 1)) env) - - (= 'do a0) - (nth (eval-ast (rest ast) env) (- (count ast) 2)) - - (= 'if a0) - (if (EVAL (nth ast 1) env) - (EVAL (nth ast 2) env) - (if (> (count ast) 3) - (EVAL (nth ast 3) env))) - - (= 'fn* a0) - (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) - - "else" - (let* [el (eval-ast ast env)] - (apply (first el) (rest el)))))) + (do + (if (env-get-or-nil env 'DEBUG-EVAL) + (prn 'EVAL: 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) + (env-set env (nth ast 1) (EVAL (nth ast 2) env)) + + (= 'let* a0) + (LET (new-env env) (nth ast 1) (nth ast 2)) + + (= 'quote a0) + (nth ast 1) + + (= 'quasiquote a0) + (EVAL (QUASIQUOTE (nth ast 1)) env) + + (= 'do a0) + (nth (map (fn* [exp] (EVAL exp env)) (rest ast)) (- (count ast) 2)) + + (= 'if a0) + (if (EVAL (nth ast 1) env) + (EVAL (nth ast 2) env) + (if (> (count ast) 3) + (EVAL (nth ast 3) env))) + + (= 'fn* a0) + (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) + + "else" + (let* [f (EVAL a0 env) + args (rest ast)] + (apply f (map (fn* [exp] (EVAL exp env)) args)))))) + + "else" + ast) (catch* exc (do (swap! trace str "\n in mal EVAL: " ast) - (throw exc)))))) + (throw exc))))))) ;; print (def! PRINT pr-str) diff --git a/impls/mal/step8_macros.mal b/impls/mal/step8_macros.mal index cbbc6d4cb6..929cec6d33 100644 --- a/impls/mal/step8_macros.mal +++ b/impls/mal/step8_macros.mal @@ -28,30 +28,6 @@ (= (first ast) 'unquote) (nth ast 1) "else" (qq-foldr ast)))) -(def! MACROEXPAND (fn* [ast env] - (let* [a0 (if (list? ast) (first ast)) - e (if (symbol? a0) (env-find env a0)) - m (if e (env-get e a0))] - (if (_macro? m) - (MACROEXPAND (apply (get m :__MAL_MACRO__) (rest ast)) env) - ast)))) - -(def! eval-ast (fn* [ast env] - ;; (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) (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)))) - - "else" ast))) - (def! LET (fn* [env binds form] (if (empty? binds) (EVAL form env) @@ -60,60 +36,68 @@ (LET env (rest (rest binds)) form))))) (def! EVAL (fn* [ast env] - ;; (do (prn "EVAL" ast "/" (keys @env)) ) - (try* - (let* [ast (MACROEXPAND ast env)] - (if (not (list? ast)) - (eval-ast ast env) - - ;; apply list - (let* [a0 (first ast)] - (cond - (empty? ast) - ast - - (= 'def! a0) - (env-set env (nth ast 1) (EVAL (nth ast 2) env)) - - (= 'let* a0) - (LET (new-env env) (nth ast 1) (nth ast 2)) - - (= 'quote a0) - (nth ast 1) - - (= 'quasiquoteexpand a0) - (QUASIQUOTE (nth ast 1)) - - (= 'quasiquote a0) - (EVAL (QUASIQUOTE (nth ast 1)) env) - - (= 'defmacro! a0) - (env-set env (nth ast 1) (hash-map :__MAL_MACRO__ - (EVAL (nth ast 2) env))) - - (= 'macroexpand a0) - (MACROEXPAND (nth ast 1) env) - - (= 'do a0) - (nth (eval-ast (rest ast) env) (- (count ast) 2)) - - (= 'if a0) - (if (EVAL (nth ast 1) env) - (EVAL (nth ast 2) env) - (if (> (count ast) 3) - (EVAL (nth ast 3) env))) - - (= 'fn* a0) - (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) - - "else" - (let* [el (eval-ast ast env)] - (apply (first el) (rest el))))))) + (do + (if (env-get-or-nil env 'DEBUG-EVAL) + (prn 'EVAL: 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) + (env-set env (nth ast 1) (EVAL (nth ast 2) env)) + + (= 'let* a0) + (LET (new-env env) (nth ast 1) (nth ast 2)) + + (= 'quote a0) + (nth ast 1) + + (= 'quasiquote a0) + (EVAL (QUASIQUOTE (nth ast 1)) env) + + (= 'defmacro! a0) + (env-set env (nth ast 1) (hash-map :__MAL_MACRO__ + (EVAL (nth ast 2) env))) + + (= 'do a0) + (nth (map (fn* [exp] (EVAL exp env)) (rest ast)) (- (count ast) 2)) + + (= 'if a0) + (if (EVAL (nth ast 1) env) + (EVAL (nth ast 2) env) + (if (> (count ast) 3) + (EVAL (nth ast 3) env))) + + (= 'fn* a0) + (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) + + "else" + (let* [f (EVAL a0 env) + args (rest ast)] + (if (_macro? f) + (EVAL (apply (get f :__MAL_MACRO__) args) env) + (apply f (map (fn* [exp] (EVAL exp env)) args))))))) + + "else" + ast) (catch* exc (do (swap! trace str "\n in mal EVAL: " ast) - (throw exc)))))) + (throw exc))))))) ;; print (def! PRINT pr-str) diff --git a/impls/mal/step9_try.mal b/impls/mal/step9_try.mal index 1d7bbe44d6..194e7f35ad 100644 --- a/impls/mal/step9_try.mal +++ b/impls/mal/step9_try.mal @@ -28,30 +28,6 @@ (= (first ast) 'unquote) (nth ast 1) "else" (qq-foldr ast)))) -(def! MACROEXPAND (fn* [ast env] - (let* [a0 (if (list? ast) (first ast)) - e (if (symbol? a0) (env-find env a0)) - m (if e (env-get e a0))] - (if (_macro? m) - (MACROEXPAND (apply (get m :__MAL_MACRO__) (rest ast)) env) - ast)))) - -(def! eval-ast (fn* [ast env] - ;; (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) (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)))) - - "else" ast))) - (def! LET (fn* [env binds form] (if (empty? binds) (EVAL form env) @@ -60,71 +36,79 @@ (LET env (rest (rest binds)) form))))) (def! EVAL (fn* [ast env] - ;; (do (prn "EVAL" ast "/" (keys @env)) ) - (try* - (let* [ast (MACROEXPAND ast env)] - (if (not (list? ast)) - (eval-ast ast env) - - ;; apply list - (let* [a0 (first ast)] - (cond - (empty? ast) - ast - - (= 'def! a0) - (env-set env (nth ast 1) (EVAL (nth ast 2) env)) - - (= 'let* a0) - (LET (new-env env) (nth ast 1) (nth ast 2)) - - (= 'quote a0) - (nth ast 1) - - (= 'quasiquoteexpand a0) - (QUASIQUOTE (nth ast 1)) - - (= 'quasiquote a0) - (EVAL (QUASIQUOTE (nth ast 1)) env) - - (= 'defmacro! a0) - (env-set env (nth ast 1) (hash-map :__MAL_MACRO__ - (EVAL (nth ast 2) env))) - - (= 'macroexpand a0) - (MACROEXPAND (nth ast 1) env) - - (= 'try* a0) - (if (< (count ast) 3) - (EVAL (nth ast 1) env) + (do + (if (env-get-or-nil env 'DEBUG-EVAL) + (prn 'EVAL: 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) + (env-set env (nth ast 1) (EVAL (nth ast 2) env)) + + (= 'let* a0) + (LET (new-env env) (nth ast 1) (nth ast 2)) + + (= 'quote a0) + (nth ast 1) + + (= 'quasiquote a0) + (EVAL (QUASIQUOTE (nth ast 1)) env) + + (= 'defmacro! a0) + (env-set env (nth ast 1) (hash-map :__MAL_MACRO__ + (EVAL (nth ast 2) env))) + + (= 'try* a0) + (if (< (count ast) 3) + (EVAL (nth ast 1) env) (try* (EVAL (nth ast 1) env) (catch* exc (do (reset! trace "") - (let* [a2 (nth ast 2)] - (EVAL (nth a2 2) (new-env env [(nth a2 1)] [exc]))))))) + (let* [a2 (nth ast 2)] + (EVAL (nth a2 2) (new-env env [(nth a2 1)] [exc]))))))) + + (= 'do a0) + (nth (map (fn* [exp] (EVAL exp env)) (rest ast)) (- (count ast) 2)) - (= 'do a0) - (nth (eval-ast (rest ast) env) (- (count ast) 2)) + (= 'if a0) + (if (EVAL (nth ast 1) env) + (EVAL (nth ast 2) env) + (if (> (count ast) 3) + (EVAL (nth ast 3) env))) - (= 'if a0) - (if (EVAL (nth ast 1) env) - (EVAL (nth ast 2) env) - (if (> (count ast) 3) - (EVAL (nth ast 3) env))) + (= 'fn* a0) + (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) - (= 'fn* a0) - (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) + "else" + (let* [f (EVAL a0 env) + args (rest ast)] + (if (_macro? f) + (EVAL (apply (get f :__MAL_MACRO__) args) env) + (apply f (map (fn* [exp] (EVAL exp env)) args))))))) - "else" - (let* [el (eval-ast ast env)] - (apply (first el) (rest el))))))) + "else" + ast) (catch* exc (do (swap! trace str "\n in mal EVAL: " ast) - (throw exc)))))) + (throw exc))))))) ;; print (def! PRINT pr-str) diff --git a/impls/mal/stepA_mal.mal b/impls/mal/stepA_mal.mal index 432dd31935..79b1b225f7 100644 --- a/impls/mal/stepA_mal.mal +++ b/impls/mal/stepA_mal.mal @@ -28,30 +28,6 @@ (= (first ast) 'unquote) (nth ast 1) "else" (qq-foldr ast)))) -(def! MACROEXPAND (fn* [ast env] - (let* [a0 (if (list? ast) (first ast)) - e (if (symbol? a0) (env-find env a0)) - m (if e (env-get e a0))] - (if (_macro? m) - (MACROEXPAND (apply (get m :__MAL_MACRO__) (rest ast)) env) - ast)))) - -(def! eval-ast (fn* [ast env] - ;; (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) (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)))) - - "else" ast))) - (def! LET (fn* [env binds form] (if (empty? binds) (EVAL form env) @@ -60,71 +36,79 @@ (LET env (rest (rest binds)) form))))) (def! EVAL (fn* [ast env] - ;; (do (prn "EVAL" ast "/" (keys @env)) ) - (try* - (let* [ast (MACROEXPAND ast env)] - (if (not (list? ast)) - (eval-ast ast env) - - ;; apply list - (let* [a0 (first ast)] - (cond - (empty? ast) - ast - - (= 'def! a0) - (env-set env (nth ast 1) (EVAL (nth ast 2) env)) - - (= 'let* a0) - (LET (new-env env) (nth ast 1) (nth ast 2)) - - (= 'quote a0) - (nth ast 1) - - (= 'quasiquoteexpand a0) - (QUASIQUOTE (nth ast 1)) - - (= 'quasiquote a0) - (EVAL (QUASIQUOTE (nth ast 1)) env) - - (= 'defmacro! a0) - (env-set env (nth ast 1) (hash-map :__MAL_MACRO__ - (EVAL (nth ast 2) env))) - - (= 'macroexpand a0) - (MACROEXPAND (nth ast 1) env) - - (= 'try* a0) - (if (< (count ast) 3) - (EVAL (nth ast 1) env) + (do + (if (env-get-or-nil env 'DEBUG-EVAL) + (prn 'EVAL: 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) + (env-set env (nth ast 1) (EVAL (nth ast 2) env)) + + (= 'let* a0) + (LET (new-env env) (nth ast 1) (nth ast 2)) + + (= 'quote a0) + (nth ast 1) + + (= 'quasiquote a0) + (EVAL (QUASIQUOTE (nth ast 1)) env) + + (= 'defmacro! a0) + (env-set env (nth ast 1) (hash-map :__MAL_MACRO__ + (EVAL (nth ast 2) env))) + + (= 'try* a0) + (if (< (count ast) 3) + (EVAL (nth ast 1) env) (try* (EVAL (nth ast 1) env) (catch* exc (do (reset! trace "") - (let* [a2 (nth ast 2)] - (EVAL (nth a2 2) (new-env env [(nth a2 1)] [exc]))))))) + (let* [a2 (nth ast 2)] + (EVAL (nth a2 2) (new-env env [(nth a2 1)] [exc]))))))) + + (= 'do a0) + (nth (map (fn* [exp] (EVAL exp env)) (rest ast)) (- (count ast) 2)) - (= 'do a0) - (nth (eval-ast (rest ast) env) (- (count ast) 2)) + (= 'if a0) + (if (EVAL (nth ast 1) env) + (EVAL (nth ast 2) env) + (if (> (count ast) 3) + (EVAL (nth ast 3) env))) - (= 'if a0) - (if (EVAL (nth ast 1) env) - (EVAL (nth ast 2) env) - (if (> (count ast) 3) - (EVAL (nth ast 3) env))) + (= 'fn* a0) + (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) - (= 'fn* a0) - (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) + "else" + (let* [f (EVAL a0 env) + args (rest ast)] + (if (_macro? f) + (EVAL (apply (get f :__MAL_MACRO__) args) env) + (apply f (map (fn* [exp] (EVAL exp env)) args))))))) - "else" - (let* [el (eval-ast ast env)] - (apply (first el) (rest el))))))) + "else" + ast) (catch* exc (do (swap! trace str "\n in mal EVAL: " ast) - (throw exc)))))) + (throw exc))))))) ;; print (def! PRINT pr-str) diff --git a/impls/miniMAL/step2_eval.json b/impls/miniMAL/step2_eval.json index 6ca9e8b95f..30193ecfff 100644 --- a/impls/miniMAL/step2_eval.json +++ b/impls/miniMAL/step2_eval.json @@ -8,14 +8,12 @@ ["def", "READ", ["fn", ["strng"], ["read-str", "strng"]]], -["def", "eval-ast", ["fn", ["ast", "env"], +["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", ["list?", "ast"], - ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], ["if", ["vector?", "ast"], ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], ["if", ["map?", "ast"], @@ -26,17 +24,14 @@ ["EVAL", ["get", "ast", "k"], "env"]]], ["keys", "ast"]], "new-hm"]], - "ast"]]]]]], - -["def", "EVAL", ["fn", ["ast", "env"], ["if", ["not", ["list?", "ast"]], - ["eval-ast", "ast", "env"], + "ast", ["if", ["empty?", "ast"], "ast", - ["let", ["el", ["eval-ast", "ast", "env"], + ["let", ["el", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], "f", ["first", "el"], "args", ["rest", "el"]], - ["apply", "f", "args"]]]]]], + ["apply", "f", "args"]]]]]]]]], ["def", "PRINT", ["fn", ["exp"], ["pr-str", "exp", true]]], diff --git a/impls/miniMAL/step3_env.json b/impls/miniMAL/step3_env.json index 7c0b6b35df..a8c56a535e 100644 --- a/impls/miniMAL/step3_env.json +++ b/impls/miniMAL/step3_env.json @@ -9,11 +9,24 @@ ["def", "READ", ["fn", ["strng"], ["read-str", "strng"]]], -["def", "eval-ast", ["fn", ["ast", "env"], +["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", ["list?", "ast"], - ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], ["if", ["vector?", "ast"], ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], ["if", ["map?", "ast"], @@ -24,18 +37,8 @@ ["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"], + "ast", ["if", ["empty?", "ast"], "ast", ["let", ["a0", ["get", ["first", "ast"], ["`", "val"]]], @@ -47,10 +50,10 @@ ["do", ["LET", "let-env", ["nth", "ast", 1]], ["EVAL", ["nth", "ast", 2], "let-env"]]], - ["let", ["el", ["eval-ast", "ast", "env"], + ["let", ["el", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], "f", ["first", "el"], "args", ["rest", "el"]], - ["apply", "f", "args"]]]]]]]]], + ["apply", "f", "args"]]]]]]]]]]]]], ["def", "PRINT", ["fn", ["exp"], ["pr-str", "exp", true]]], diff --git a/impls/miniMAL/step4_if_fn_do.json b/impls/miniMAL/step4_if_fn_do.json index 3cbaa67c13..3d91c581fb 100644 --- a/impls/miniMAL/step4_if_fn_do.json +++ b/impls/miniMAL/step4_if_fn_do.json @@ -9,11 +9,24 @@ ["def", "READ", ["fn", ["strng"], ["read-str", "strng"]]], -["def", "eval-ast", ["fn", ["ast", "env"], +["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", ["list?", "ast"], - ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], ["if", ["vector?", "ast"], ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], ["if", ["map?", "ast"], @@ -24,18 +37,8 @@ ["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"], + "ast", ["if", ["empty?", "ast"], "ast", ["let", ["a0", ["get", ["first", "ast"], ["`", "val"]]], @@ -48,7 +51,7 @@ ["LET", "let-env", ["nth", "ast", 1]], ["EVAL", ["nth", "ast", 2], "let-env"]]], ["if", ["=", ["`", "do"], "a0"], - ["let", ["el", ["eval-ast", ["rest", "ast"], "env"]], + ["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"]], @@ -61,10 +64,10 @@ ["fn", ["&", "args"], ["let", ["e", ["env-new", "env", ["nth", "ast", 1], "args"]], ["EVAL", ["nth", "ast", 2], "e"]]], - ["let", ["el", ["eval-ast", "ast", "env"], + ["let", ["el", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], "f", ["first", "el"], "args", ["rest", "el"]], - ["apply", "f", "args"]]]]]]]]]]]], + ["apply", "f", "args"]]]]]]]]]]]]]]]], ["def", "PRINT", ["fn", ["exp"], ["pr-str", "exp", true]]], diff --git a/impls/miniMAL/step5_tco.json b/impls/miniMAL/step5_tco.json index 6a6f4e0ebf..babf6b0166 100644 --- a/impls/miniMAL/step5_tco.json +++ b/impls/miniMAL/step5_tco.json @@ -9,11 +9,24 @@ ["def", "READ", ["fn", ["strng"], ["read-str", "strng"]]], -["def", "eval-ast", ["fn", ["ast", "env"], +["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", ["list?", "ast"], - ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], ["if", ["vector?", "ast"], ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], ["if", ["map?", "ast"], @@ -24,18 +37,8 @@ ["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"], + "ast", ["if", ["empty?", "ast"], "ast", ["let", ["a0", ["get", ["first", "ast"], ["`", "val"]]], @@ -49,7 +52,7 @@ ["EVAL", ["nth", "ast", 2], "let-env"]]], ["if", ["=", ["`", "do"], "a0"], ["do", - ["eval-ast", ["slice", "ast", 1, ["-", ["count", "ast"], 1]], "env"], + ["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"]], @@ -64,7 +67,7 @@ ["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"], + ["let", ["el", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], "f", ["first", "el"], "args", ["rest", "el"]], ["if", ["malfunc?", "f"], @@ -72,7 +75,7 @@ ["env-new", ["get", "f", ["`", "env"]], ["get", "f", ["`", "params"]], "args"]], - ["apply", "f", "args"]]]]]]]]]]]]], + ["apply", "f", "args"]]]]]]]]]]]]]]]]], ["def", "PRINT", ["fn", ["exp"], ["pr-str", "exp", true]]], diff --git a/impls/miniMAL/step6_file.json b/impls/miniMAL/step6_file.json index 59d4b84573..1e954c740c 100644 --- a/impls/miniMAL/step6_file.json +++ b/impls/miniMAL/step6_file.json @@ -9,11 +9,24 @@ ["def", "READ", ["fn", ["strng"], ["read-str", "strng"]]], -["def", "eval-ast", ["fn", ["ast", "env"], +["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", ["list?", "ast"], - ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], ["if", ["vector?", "ast"], ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], ["if", ["map?", "ast"], @@ -24,18 +37,8 @@ ["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"], + "ast", ["if", ["empty?", "ast"], "ast", ["let", ["a0", ["get", ["first", "ast"], ["`", "val"]]], @@ -49,7 +52,7 @@ ["EVAL", ["nth", "ast", 2], "let-env"]]], ["if", ["=", ["`", "do"], "a0"], ["do", - ["eval-ast", ["slice", "ast", 1, ["-", ["count", "ast"], 1]], "env"], + ["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"]], @@ -64,7 +67,7 @@ ["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"], + ["let", ["el", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], "f", ["first", "el"], "args", ["rest", "el"]], ["if", ["malfunc?", "f"], @@ -72,7 +75,7 @@ ["env-new", ["get", "f", ["`", "env"]], ["get", "f", ["`", "params"]], "args"]], - ["apply", "f", "args"]]]]]]]]]]]]], + ["apply", "f", "args"]]]]]]]]]]]]]]]]], ["def", "PRINT", ["fn", ["exp"], ["pr-str", "exp", true]]], diff --git a/impls/miniMAL/step7_quote.json b/impls/miniMAL/step7_quote.json index b6b18cf6fd..e11f1d7fce 100644 --- a/impls/miniMAL/step7_quote.json +++ b/impls/miniMAL/step7_quote.json @@ -36,11 +36,24 @@ ["list", ["symbol", ["`", "quote"]], "ast"], "ast"]]]]], -["def", "eval-ast", ["fn", ["ast", "env"], +["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", ["list?", "ast"], - ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], ["if", ["vector?", "ast"], ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], ["if", ["map?", "ast"], @@ -51,18 +64,8 @@ ["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"], + "ast", ["if", ["empty?", "ast"], "ast", ["let", ["a0", ["get", ["first", "ast"], ["`", "val"]]], @@ -76,13 +79,11 @@ ["EVAL", ["nth", "ast", 2], "let-env"]]], ["if", ["=", ["`", "quote"], "a0"], ["nth", "ast", 1], - ["if", ["=", ["`", "quasiquoteexpand"], "a0"], - ["quasiquote", ["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"], + ["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"]], @@ -97,7 +98,7 @@ ["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"], + ["let", ["el", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], "f", ["first", "el"], "args", ["rest", "el"]], ["if", ["malfunc?", "f"], @@ -105,7 +106,7 @@ ["env-new", ["get", "f", ["`", "env"]], ["get", "f", ["`", "params"]], "args"]], - ["apply", "f", "args"]]]]]]]]]]]]]]]], + ["apply", "f", "args"]]]]]]]]]]]]]]]]]]], ["def", "PRINT", ["fn", ["exp"], ["pr-str", "exp", true]]], diff --git a/impls/miniMAL/step8_macros.json b/impls/miniMAL/step8_macros.json index 88ad3b2db9..d4b54576c1 100644 --- a/impls/miniMAL/step8_macros.json +++ b/impls/miniMAL/step8_macros.json @@ -36,25 +36,24 @@ ["list", ["symbol", ["`", "quote"]], "ast"], "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"], +["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", ["list?", "ast"], - ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], ["if", ["vector?", "ast"], ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], ["if", ["map?", "ast"], @@ -65,21 +64,8 @@ ["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"], + "ast", ["if", ["empty?", "ast"], "ast", ["let", ["a0", ["get", ["first", "ast"], ["`", "val"]]], @@ -93,8 +79,6 @@ ["EVAL", ["nth", "ast", 2], "let-env"]]], ["if", ["=", ["`", "quote"], "a0"], ["nth", "ast", 1], - ["if", ["=", ["`", "quasiquoteexpand"], "a0"], - ["quasiquote", ["nth", "ast", 1]], ["if", ["=", ["`", "quasiquote"], "a0"], ["EVAL", ["quasiquote", ["nth", "ast", 1]], "env"], ["if", ["=", ["`", "defmacro!"], "a0"], @@ -102,11 +86,9 @@ ["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"], + ["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"]], @@ -121,15 +103,16 @@ ["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"]], + ["let", ["f", ["EVAL", ["first", "ast"], "env"], + "args", ["rest", "ast"]], ["if", ["malfunc?", "f"], - ["EVAL", ["get", "f", ["`", "ast"]], + ["if", ["get", "f", ["`", "macro?"]], + ["EVAL", ["apply", ["get", "f", ["`", "fn"]], "args"], "env"], + ["EVAL", ["get", "f", ["`", "ast"]], ["env-new", ["get", "f", ["`", "env"]], ["get", "f", ["`", "params"]], - "args"]], - ["apply", "f", "args"]]]]]]]]]]]]]]]]]]]], + ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "args"]]]], + ["apply", "f", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "args"]]]]]]]]]]]]]]]]]]]]], ["def", "PRINT", ["fn", ["exp"], ["pr-str", "exp", true]]], diff --git a/impls/miniMAL/step9_try.json b/impls/miniMAL/step9_try.json index 26c8fa385c..05090ab9f8 100644 --- a/impls/miniMAL/step9_try.json +++ b/impls/miniMAL/step9_try.json @@ -36,25 +36,24 @@ ["list", ["symbol", ["`", "quote"]], "ast"], "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"], +["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", ["list?", "ast"], - ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], ["if", ["vector?", "ast"], ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], ["if", ["map?", "ast"], @@ -65,21 +64,8 @@ ["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"], + "ast", ["if", ["empty?", "ast"], "ast", ["let", ["a0", ["get", ["first", "ast"], ["`", "val"]]], @@ -93,8 +79,6 @@ ["EVAL", ["nth", "ast", 2], "let-env"]]], ["if", ["=", ["`", "quote"], "a0"], ["nth", "ast", 1], - ["if", ["=", ["`", "quasiquoteexpand"], "a0"], - ["quasiquote", ["nth", "ast", 1]], ["if", ["=", ["`", "quasiquote"], "a0"], ["EVAL", ["quasiquote", ["nth", "ast", 1]], "env"], ["if", ["=", ["`", "defmacro!"], "a0"], @@ -102,8 +86,6 @@ ["do", ["set", "func", ["`", "macro?"], true], ["env-set", "env", ["nth", "ast", 1], "func"]]], - ["if", ["=", ["`", "macroexpand"], "a0"], - ["macroexpand", ["nth", "ast", 1], "env"], ["if", ["=", ["`", "try*"], "a0"], ["if", ["and", [">", ["count", "ast"], 2], ["=", ["`", "catch*"], @@ -119,7 +101,7 @@ ["EVAL", ["nth", "ast", 1], "env"]], ["if", ["=", ["`", "do"], "a0"], ["do", - ["eval-ast", ["slice", "ast", 1, ["-", ["count", "ast"], 1]], "env"], + ["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"]], @@ -134,15 +116,16 @@ ["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"]], + ["let", ["f", ["EVAL", ["first", "ast"], "env"], + "args", ["rest", "ast"]], ["if", ["malfunc?", "f"], - ["EVAL", ["get", "f", ["`", "ast"]], + ["if", ["get", "f", ["`", "macro?"]], + ["EVAL", ["apply", ["get", "f", ["`", "fn"]], "args"], "env"], + ["EVAL", ["get", "f", ["`", "ast"]], ["env-new", ["get", "f", ["`", "env"]], ["get", "f", ["`", "params"]], - "args"]], - ["apply", "f", "args"]]]]]]]]]]]]]]]]]]]]], + ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "args"]]]], + ["apply", "f", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "args"]]]]]]]]]]]]]]]]]]]]]], ["def", "PRINT", ["fn", ["exp"], ["pr-str", "exp", true]]], diff --git a/impls/miniMAL/stepA_mal.json b/impls/miniMAL/stepA_mal.json index 18e88b47c4..0f068a4e2a 100644 --- a/impls/miniMAL/stepA_mal.json +++ b/impls/miniMAL/stepA_mal.json @@ -36,25 +36,24 @@ ["list", ["symbol", ["`", "quote"]], "ast"], "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"], +["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", ["list?", "ast"], - ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], ["if", ["vector?", "ast"], ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], ["if", ["map?", "ast"], @@ -65,21 +64,8 @@ ["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"], + "ast", ["if", ["empty?", "ast"], "ast", ["let", ["a0", ["get", ["first", "ast"], ["`", "val"]]], @@ -93,17 +79,13 @@ ["EVAL", ["nth", "ast", 2], "let-env"]]], ["if", ["=", ["`", "quote"], "a0"], ["nth", "ast", 1], - ["if", ["=", ["`", "quasiquoteexpand"], "a0"], - ["quasiquote", ["nth", "ast", 1]], ["if", ["=", ["`", "quasiquote"], "a0"], ["EVAL", ["quasiquote", ["nth", "ast", 1]], "env"], ["if", ["=", ["`", "defmacro!"], "a0"], - ["let", ["func", ["EVAL", ["nth", "ast", 2], "env"]], + ["let", ["func", ["_clone", ["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", ["and", [">", ["count", "ast"], 2], ["=", ["`", "catch*"], @@ -119,7 +101,7 @@ ["EVAL", ["nth", "ast", 1], "env"]], ["if", ["=", ["`", "do"], "a0"], ["do", - ["eval-ast", ["slice", "ast", 1, ["-", ["count", "ast"], 1]], "env"], + ["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"]], @@ -134,15 +116,16 @@ ["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"]], + ["let", ["f", ["EVAL", ["first", "ast"], "env"], + "args", ["rest", "ast"]], ["if", ["malfunc?", "f"], - ["EVAL", ["get", "f", ["`", "ast"]], + ["if", ["get", "f", ["`", "macro?"]], + ["EVAL", ["apply", ["get", "f", ["`", "fn"]], "args"], "env"], + ["EVAL", ["get", "f", ["`", "ast"]], ["env-new", ["get", "f", ["`", "env"]], ["get", "f", ["`", "params"]], - "args"]], - ["apply", "f", "args"]]]]]]]]]]]]]]]]]]]]], + ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "args"]]]], + ["apply", "f", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "args"]]]]]]]]]]]]]]]]]]]]]], ["def", "PRINT", ["fn", ["exp"], ["pr-str", "exp", true]]], diff --git a/impls/nasm/stepA_mal.asm b/impls/nasm/stepA_mal.asm index 571f14cda4..3d7c5524db 100644 --- a/impls/nasm/stepA_mal.asm +++ b/impls/nasm/stepA_mal.asm @@ -27,6 +27,9 @@ section .data 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" @@ -56,13 +59,13 @@ section .data ;; 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 macroexpand_symbol, 'macroexpand' static_symbol try_symbol, 'try*' static_symbol catch_symbol, 'catch*' @@ -70,7 +73,6 @@ section .data 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' @@ -121,9 +123,48 @@ car_and_incref: ;; ;; 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_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] @@ -148,7 +189,7 @@ eval_ast: call incref_object ; Increment reference count mov rax, rsi - ret + jmp .return .symbol: ; Check if first character of symbol is ':' @@ -205,16 +246,104 @@ eval_ast: ; Just return keywords unaltered call incref_object mov rax, rsi - ret + jmp .return ; ------------------------------ -.list: - ; Evaluate each element of the list - ; - xor r8, r8 ; The list to return - ; r9 contains head of list +.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 @@ -292,32 +421,15 @@ eval_ast: ; 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 + jmp eval.return_from_list_map_eval ; --------------------- .map: @@ -330,7 +442,7 @@ eval_ast: ; map empty. Just return it call incref_object mov rax, rsi - ret + jmp .return .map_not_empty: @@ -456,11 +568,11 @@ eval_ast: .map_done: mov rax, r12 - ret + jmp .return .map_error_missing_value: mov rax, r12 - ret + jmp .return ; ------------------------------ .vector: @@ -571,11 +683,11 @@ eval_ast: .vector_done: mov rax, r8 ; Return the vector - ret + jmp .return ; --------------------- .done: - ret + jmp .return ; Releases Env @@ -594,65 +706,15 @@ eval_ast: 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 + ; Check 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 @@ -684,18 +746,12 @@ eval: 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 @@ -1468,20 +1524,6 @@ eval: ; ----------------------------- -;;; 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 @@ -1523,37 +1565,6 @@ eval: 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: @@ -1773,7 +1784,8 @@ eval: push rsi mov rdi, r15 ; Environment push r15 - call eval_ast ; List of evaluated forms in RAX + jmp .list_map_eval ; List of evaluated forms in RAX +.return_from_list_map_eval pop r15 pop rsi @@ -2198,83 +2210,13 @@ qq_loop: 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 +;; 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: - push r15 - - call is_macro_call - jne .done - mov r13, rsi mov rdi, rax ; Macro in RDI @@ -2312,13 +2254,11 @@ macroexpand: call apply_fn - mov rsi, rax ; Result in RSI - - pop r15 - jmp macroexpand -.done: - pop r15 - ret + 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: diff --git a/impls/nim/env.nim b/impls/nim/env.nim index dcb64f7da8..75f481c42b 100644 --- a/impls/nim/env.nim +++ b/impls/nim/env.nim @@ -15,11 +15,9 @@ 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] + var env = e + while not env.data.hasKey(key): + env = env.outer + if env.isNil: return nil + return env.data[key] diff --git a/impls/nim/step2_eval.nim b/impls/nim/step2_eval.nim index b6b840fffe..ddc1233a20 100644 --- a/impls/nim/step2_eval.nim +++ b/impls/nim/step2_eval.nim @@ -2,33 +2,27 @@ import rdstdin, tables, sequtils, types, reader, printer proc read(str: string): MalType = str.read_str -proc eval(ast: MalType, env: Table[string, MalType]): MalType +proc eval(ast: MalType, env: Table[string, MalType]): MalType = + + # echo "EVAL: " & ast.pr_str -proc eval_ast(ast: MalType, env: Table[string, MalType]): MalType = case ast.kind of Symbol: if not env.hasKey(ast.str): raise newException(ValueError, "'" & ast.str & "' not found") result = env[ast.str] - of List: - result = list ast.list.mapIt(it.eval(env)) 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) - else: - result = ast - -proc eval(ast: MalType, env: Table[string, MalType]): MalType = - case ast.kind of List: if ast.list.len == 0: return ast - let el = ast.eval_ast(env) - el.list[0].fun(el.list[1 .. ^1]) + let el = ast.list.mapIt(it.eval(env)) + result = el[0].fun(el[1 .. ^1]) else: - ast.eval_ast(env) + result = ast proc print(exp: MalType): string = exp.pr_str diff --git a/impls/nim/step3_env.nim b/impls/nim/step3_env.nim index 0a9827885f..4d37316e9d 100644 --- a/impls/nim/step3_env.nim +++ b/impls/nim/step3_env.nim @@ -2,25 +2,23 @@ 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: MalType, env: var Env): MalType = + + let dbgeval = env.get("DEBUG-EVAL") + if not (dbgeval.isNil or dbgeval.kind in {Nil, False}): + echo "EVAL: " & ast.pr_str -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(it.eval(env)) + 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) - else: - result = ast - -proc eval(ast: MalType, env: var Env): MalType = - case ast.kind of List: if ast.list.len == 0: return ast let @@ -41,10 +39,10 @@ proc eval(ast: MalType, env: var Env): MalType = else: discard result = a2.eval(letEnv) else: - let el = ast.eval_ast(env) - result = el.list[0].fun(el.list[1 .. ^1]) + let el = ast.list.mapIt(it.eval(env)) + result = el[0].fun(el[1 .. ^1]) else: - result = ast.eval_ast(env) + result = ast proc print(exp: MalType): string = exp.pr_str diff --git a/impls/nim/step4_if_fn_do.nim b/impls/nim/step4_if_fn_do.nim index e7c965aec2..e81512bf87 100644 --- a/impls/nim/step4_if_fn_do.nim +++ b/impls/nim/step4_if_fn_do.nim @@ -2,36 +2,33 @@ 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: MalType, env: var Env): MalType = + + let dbgeval = env.get("DEBUG-EVAL") + if not (dbgeval.isNil or dbgeval.kind in {Nil, False}): + echo "EVAL: " & ast.pr_str -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(it.eval(env)) + 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) - 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: + if a0.kind == Symbol: case a0.str of "def!": let a1 = ast.list[1] a2 = ast.list[2] - result = env.set(a1.str, a2.eval(env)) + return env.set(a1.str, a2.eval(env)) of "let*": let @@ -45,11 +42,11 @@ proc eval(ast: MalType, env: var Env): MalType = 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) + return a2.eval(letEnv) of "do": - let el = (list ast.list[1 .. ^1]).eval_ast(env) - result = el.list[el.list.high] + let el = ast.list[1 .. ^1].mapIt(it.eval(env)) + return el[el.high] of "if": let @@ -58,29 +55,24 @@ proc eval(ast: MalType, env: var Env): MalType = 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) + 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] var env2 = env - result = fun(proc(a: varargs[MalType]): MalType = + return 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]) + let el = ast.list.mapIt(it.eval(env)) + result = el[0].fun(el[1 .. ^1]) else: - result = ast.eval_ast(env) + result = ast proc print(exp: MalType): string = exp.pr_str diff --git a/impls/nim/step5_tco.nim b/impls/nim/step5_tco.nim index 5b93141e02..ffabd900ea 100644 --- a/impls/nim/step5_tco.nim +++ b/impls/nim/step5_tco.nim @@ -2,44 +2,37 @@ import rdstdin, tables, sequtils, types, reader, printer, env, core proc read(str: string): MalType = str.read_str -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(it.eval(env)) - 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) - 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) + + 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] - case a0.kind - of Symbol: + if a0.kind == Symbol: case a0.str of "def!": let @@ -59,13 +52,13 @@ proc eval(ast: MalType, env: Env): MalType = else: raise newException(ValueError, "Illegal kind in let*") ast = a2 env = let_env - # Continue loop (TCO) + continue # TCO of "do": let last = ast.list.high - discard (list ast.list[1 ..< last]).eval_ast(env) + discard (ast.list[1 ..< last].mapIt(it.eval(env))) ast = ast.list[last] - # Continue loop (TCO) + continue # TCO of "if": let @@ -74,9 +67,14 @@ proc eval(ast: MalType, env: Env): MalType = cond = a1.eval(env) if cond.kind in {Nil, False}: - if ast.list.len > 3: ast = ast.list[3] - else: ast = nilObj - else: ast = a2 + if ast.list.len > 3: + ast = ast.list[3] + continue # TCO + else: + return nilObj + else: + ast = a2 + continue # TCO of "fn*": let @@ -88,11 +86,14 @@ proc eval(ast: MalType, env: Env): MalType = a2.eval(newEnv) return malfun(fn, a2, a1, env) - else: - defaultApply() + 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 - else: - defaultApply() + return f.fun(args) proc print(exp: MalType): string = exp.pr_str diff --git a/impls/nim/step6_file.nim b/impls/nim/step6_file.nim index f42c7f9afb..3b59b781bb 100644 --- a/impls/nim/step6_file.nim +++ b/impls/nim/step6_file.nim @@ -2,44 +2,37 @@ 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 - -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(it.eval(env)) - 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) - 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) + + 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] - case a0.kind - of Symbol: + if a0.kind == Symbol: case a0.str of "def!": let @@ -59,13 +52,13 @@ proc eval(ast: MalType, env: Env): MalType = else: raise newException(ValueError, "Illegal kind in let*") ast = a2 env = let_env - # Continue loop (TCO) + continue # TCO of "do": let last = ast.list.high - discard (list ast.list[1 ..< last]).eval_ast(env) + discard (ast.list[1 ..< last].mapIt(it.eval(env))) ast = ast.list[last] - # Continue loop (TCO) + continue # TCO of "if": let @@ -74,9 +67,14 @@ proc eval(ast: MalType, env: Env): MalType = cond = a1.eval(env) if cond.kind in {Nil, False}: - if ast.list.len > 3: ast = ast.list[3] - else: ast = nilObj - else: ast = a2 + if ast.list.len > 3: + ast = ast.list[3] + continue # TCO + else: + return nilObj + else: + ast = a2 + continue # TCO of "fn*": let @@ -88,11 +86,14 @@ proc eval(ast: MalType, env: Env): MalType = a2.eval(newEnv) return malfun(fn, a2, a1, env) - else: - defaultApply() + 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 - else: - defaultApply() + return f.fun(args) proc print(exp: MalType): string = exp.pr_str diff --git a/impls/nim/step7_quote.nim b/impls/nim/step7_quote.nim index 528a0c47e4..3e27bbd30d 100644 --- a/impls/nim/step7_quote.nim +++ b/impls/nim/step7_quote.nim @@ -29,44 +29,38 @@ proc quasiquote(ast: MalType): MalType = else: result = ast -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(it.eval(env)) - 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) - 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])) + 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 f.fun(el.list[1 .. ^1]) + return ast - 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: + if a0.kind == Symbol: case a0.str of "def!": let @@ -86,23 +80,20 @@ proc eval(ast: MalType, env: Env): MalType = else: raise newException(ValueError, "Illegal kind in let*") ast = a2 env = let_env - # Continue loop (TCO) + continue # TCO of "quote": return ast.list[1] - of "quasiquoteexpand": - return ast.list[1].quasiquote - of "quasiquote": ast = ast.list[1].quasiquote - # Continue loop (TCO) + continue # TCO of "do": let last = ast.list.high - discard (list ast.list[1 ..< last]).eval_ast(env) + discard (ast.list[1 ..< last].mapIt(it.eval(env))) ast = ast.list[last] - # Continue loop (TCO) + continue # TCO of "if": let @@ -111,9 +102,14 @@ proc eval(ast: MalType, env: Env): MalType = cond = a1.eval(env) if cond.kind in {Nil, False}: - if ast.list.len > 3: ast = ast.list[3] - else: ast = nilObj - else: ast = a2 + if ast.list.len > 3: + ast = ast.list[3] + continue # TCO + else: + return nilObj + else: + ast = a2 + continue # TCO of "fn*": let @@ -125,11 +121,14 @@ proc eval(ast: MalType, env: Env): MalType = a2.eval(newEnv) return malfun(fn, a2, a1, env) - else: - defaultApply() + 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 - else: - defaultApply() + return f.fun(args) proc print(exp: MalType): string = exp.pr_str diff --git a/impls/nim/step8_macros.nim b/impls/nim/step8_macros.nim index bd74ecf146..76e21fd78c 100644 --- a/impls/nim/step8_macros.nim +++ b/impls/nim/step8_macros.nim @@ -29,57 +29,38 @@ proc quasiquote(ast: MalType): MalType = else: result = ast -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).fun_is_macro - -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(it.eval(env)) - 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) - 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) + 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] - case a0.kind - of Symbol: + if a0.kind == Symbol: case a0.str of "def!": let @@ -99,31 +80,25 @@ proc eval(ast: MalType, env: Env): MalType = else: raise newException(ValueError, "Illegal kind in let*") ast = a2 env = let_env - # Continue loop (TCO) + continue # TCO of "quote": return ast.list[1] - of "quasiquoteexpand": - return ast.list[1].quasiquote - of "quasiquote": ast = ast.list[1].quasiquote - # Continue loop (TCO) + continue # TCO of "defmacro!": var fun = ast.list[2].eval(env) fun = malfun(fun.malfun.fn, fun.malfun.ast, fun.malfun.params, fun.malfun.env, true) return env.set(ast.list[1].str, fun) - of "macroexpand": - return ast.list[1].macroexpand(env) - of "do": let last = ast.list.high - discard (list ast.list[1 ..< last]).eval_ast(env) + discard (ast.list[1 ..< last].mapIt(it.eval(env))) ast = ast.list[last] - # Continue loop (TCO) + continue # TCO of "if": let @@ -132,9 +107,14 @@ proc eval(ast: MalType, env: Env): MalType = cond = a1.eval(env) if cond.kind in {Nil, False}: - if ast.list.len > 3: ast = ast.list[3] - else: ast = nilObj - else: ast = a2 + if ast.list.len > 3: + ast = ast.list[3] + continue # TCO + else: + return nilObj + else: + ast = a2 + continue # TCO of "fn*": let @@ -146,11 +126,17 @@ proc eval(ast: MalType, env: Env): MalType = a2.eval(newEnv) return malfun(fn, a2, a1, env) - else: - defaultApply() + 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 - else: - defaultApply() + return f.fun(args) proc print(exp: MalType): string = exp.pr_str diff --git a/impls/nim/step9_try.nim b/impls/nim/step9_try.nim index 71dbbb0cda..1b25a11488 100644 --- a/impls/nim/step9_try.nim +++ b/impls/nim/step9_try.nim @@ -29,57 +29,38 @@ proc quasiquote(ast: MalType): MalType = else: result = ast -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).fun_is_macro - -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(it.eval(env)) - 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) - 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) + 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] - case a0.kind - of Symbol: + if a0.kind == Symbol: case a0.str of "def!": let @@ -100,50 +81,44 @@ proc eval(ast: MalType, env: Env): MalType = else: raise newException(ValueError, "Illegal kind in let*") ast = a2 env = let_env - # Continue loop (TCO) + continue # TCO of "quote": return ast.list[1] - of "quasiquoteexpand": - return ast.list[1].quasiquote - of "quasiquote": ast = ast.list[1].quasiquote - # Continue loop (TCO) + continue # TCO of "defmacro!": var fun = ast.list[2].eval(env) fun = malfun(fun.malfun.fn, fun.malfun.ast, fun.malfun.params, fun.malfun.env, true) return env.set(ast.list[1].str, fun) - of "macroexpand": - return ast.list[1].macroexpand(env) - of "try*": let a1 = ast.list[1] if ast.list.len <= 2: - return a1.eval(env) + ast = a1 + continue # TCO let 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: + 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 (list ast.list[1 ..< last]).eval_ast(env) + discard (ast.list[1 ..< last].mapIt(it.eval(env))) ast = ast.list[last] - # Continue loop (TCO) + continue # TCO of "if": let @@ -152,9 +127,14 @@ proc eval(ast: MalType, env: Env): MalType = cond = a1.eval(env) if cond.kind in {Nil, False}: - if ast.list.len > 3: ast = ast.list[3] - else: ast = nilObj - else: ast = a2 + if ast.list.len > 3: + ast = ast.list[3] + continue # TCO + else: + return nilObj + else: + ast = a2 + continue # TCO of "fn*": let @@ -166,9 +146,17 @@ proc eval(ast: MalType, env: Env): MalType = a2.eval(newEnv) return malfun(fn, a2, a1, env) - else: defaultApply() + 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 - else: defaultApply() + return f.fun(args) proc print(exp: MalType): string = exp.pr_str diff --git a/impls/nim/stepA_mal.nim b/impls/nim/stepA_mal.nim index 76a648e3eb..031d598a49 100644 --- a/impls/nim/stepA_mal.nim +++ b/impls/nim/stepA_mal.nim @@ -29,57 +29,38 @@ proc quasiquote(ast: MalType): MalType = else: result = ast -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).fun_is_macro - -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(it.eval(env)) - 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) - 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) + 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] - case a0.kind - of Symbol: + if a0.kind == Symbol: case a0.str of "def!": let @@ -100,50 +81,44 @@ proc eval(ast: MalType, env: Env): MalType = else: raise newException(ValueError, "Illegal kind in let*") ast = a2 env = let_env - # Continue loop (TCO) + continue # TCO of "quote": return ast.list[1] - of "quasiquoteexpand": - return ast.list[1].quasiquote - of "quasiquote": ast = ast.list[1].quasiquote - # Continue loop (TCO) + continue # TCO of "defmacro!": var fun = ast.list[2].eval(env) fun = malfun(fun.malfun.fn, fun.malfun.ast, fun.malfun.params, fun.malfun.env, true) return env.set(ast.list[1].str, fun) - of "macroexpand": - return ast.list[1].macroexpand(env) - of "try*": let a1 = ast.list[1] if ast.list.len <= 2: - return a1.eval(env) + ast = a1 + continue # TCO let 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: + 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 (list ast.list[1 ..< last]).eval_ast(env) + discard (ast.list[1 ..< last].mapIt(it.eval(env))) ast = ast.list[last] - # Continue loop (TCO) + continue # TCO of "if": let @@ -152,9 +127,14 @@ proc eval(ast: MalType, env: Env): MalType = cond = a1.eval(env) if cond.kind in {Nil, False}: - if ast.list.len > 3: ast = ast.list[3] - else: ast = nilObj - else: ast = a2 + if ast.list.len > 3: + ast = ast.list[3] + continue # TCO + else: + return nilObj + else: + ast = a2 + continue # TCO of "fn*": let @@ -166,9 +146,17 @@ proc eval(ast: MalType, env: Env): MalType = a2.eval(newEnv) return malfun(fn, a2, a1, env) - else: defaultApply() + 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 - else: defaultApply() + return f.fun(args) proc print(exp: MalType): string = exp.pr_str diff --git a/impls/objpascal/mal_env.pas b/impls/objpascal/mal_env.pas index 9bbe2ebd61..1fc2ea580d 100644 --- a/impls/objpascal/mal_env.pas +++ b/impls/objpascal/mal_env.pas @@ -20,8 +20,7 @@ type TEnv = class(TObject) Exprs : TMalArray); function Add(Key : TMalSymbol; Val : TMal) : TMal; - function Find(Key : TMalSymbol) : TEnv; - function Get(Key : TMalSymbol) : TMal; + function Get(Key : String) : TMal; end; //////////////////////////////////////////////////////////// @@ -72,30 +71,14 @@ function TEnv.Add(Key : TMalSymbol; Val : TMal) : TMal; Add := Val; end; -function TEnv.Find(Key : TMalSymbol) : TEnv; -var - Sym : string; +function TEnv.Get(Key : String) : TMal; begin - Sym := (Key as TMalSymbol).Val; - if Data.IndexOf(Sym) >= 0 then - Find := Self + if Data.IndexOf(Key) >= 0 then + Get := Data[Key] 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] + Get := Outer.Get(Key) else - raise Exception.Create('''' + Sym + ''' not found'); + Get := nil; end; end. diff --git a/impls/objpascal/step2_eval.pas b/impls/objpascal/step2_eval.pas index 9da3bcbad6..d73846c2fa 100644 --- a/impls/objpascal/step2_eval.pas +++ b/impls/objpascal/step2_eval.pas @@ -25,69 +25,58 @@ function READ(const Str: string) : TMal; 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; +function EVAL(Ast: TMal; Env: TEnv) : TMal; var + Arr : TMalArray; + Arr1 : TMalArray; Sym : string; - OldArr, NewArr : TMalArray; + 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 - eval_ast := Env[Sym]; + Exit(Env[Sym]); end - else if Ast is TMalList then + else if Ast is TMalVector 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); + 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; - 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); + for I := 0 to OldDict.Count-1 do + NewDict[OldDict.Keys[I]]:= EVAL(OldDict[OldDict.Keys[I]], Env); + Exit(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)); + else if not (Ast is TMalList) then + Exit(Ast); // Apply list - Arr := (eval_ast(Ast, Env) as TMalList).Val; + Arr := (Ast as TMalList).Val; if Length(Arr) = 0 then Exit(Ast); - if Arr[0] is TMalFunc then + Cond := EVAL(Arr[0], Env); + Args := copy(Arr, 1, Length(Arr) - 1); + if Cond is TMalFunc then begin - Fn := (Arr[0] as TMalFunc).Val; - EVAL := Fn(copy(Arr, 1, Length(Arr)-1)); + 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'); diff --git a/impls/objpascal/step3_env.pas b/impls/objpascal/step3_env.pas index f51e318beb..d6940a90dc 100644 --- a/impls/objpascal/step3_env.pas +++ b/impls/objpascal/step3_env.pas @@ -23,59 +23,48 @@ function READ(const Str: string) : TMal; 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; +function EVAL(Ast: TMal; Env: TEnv) : TMal; var - OldArr, NewArr : TMalArray; + 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 - eval_ast := Env.Get((Ast as TMalSymbol)); + 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 TMalList then + else if Ast is TMalVector 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); + 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; - 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); + for I := 0 to OldDict.Count-1 do + NewDict[OldDict.Keys[I]]:= EVAL(OldDict[OldDict.Keys[I]], Env); + Exit(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)); + else if not (Ast is TMalList) then + Exit(Ast); // Apply list Arr := (Ast as TMalList).Val; @@ -103,11 +92,14 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; end; else begin - Arr := (eval_ast(Ast, Env) as TMalList).Val; - if Arr[0] is TMalFunc then + Cond := EVAL(Arr[0], Env); + Args := copy(Arr, 1, Length(Arr) - 1); + if Cond is TMalFunc then begin - Fn := (Arr[0] as TMalFunc).Val; - EVAL := Fn(copy(Arr, 1, Length(Arr)-1)); + 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'); diff --git a/impls/objpascal/step4_if_fn_do.pas b/impls/objpascal/step4_if_fn_do.pas index f1204b7160..77cb53bf42 100644 --- a/impls/objpascal/step4_if_fn_do.pas +++ b/impls/objpascal/step4_if_fn_do.pas @@ -26,48 +26,6 @@ function READ(const Str: string) : TMal; 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; @@ -80,9 +38,38 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; I : longint; Fn : TMalFunc; Args : TMalArray; + OldDict, NewDict : TMalDict; begin - if Ast.ClassType <> TMalList then - Exit(eval_ast(Ast, Env)); + 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); @@ -111,8 +98,9 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; end; 'do': begin - Arr := (eval_ast(Lst.Rest, Env) as TMalList).Val; - EVAL := Arr[Length(Arr)-1]; + for I := 1 to Length(Arr) - 2 do + Cond := EVAL(Arr[I], Env); + EVAL := EVAL(Arr[Length(Arr)-1], Env); end; 'if': begin @@ -131,14 +119,13 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; end; else begin - Arr := (eval_ast(Ast, Env) as TMalList).Val; - if Arr[0] is TMalFunc then + Cond := EVAL(Arr[0], Env); + Args := copy(Arr, 1, Length(Arr) - 1); + if Cond 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); + 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 diff --git a/impls/objpascal/step5_tco.pas b/impls/objpascal/step5_tco.pas index 6771931079..776026c594 100644 --- a/impls/objpascal/step5_tco.pas +++ b/impls/objpascal/step5_tco.pas @@ -26,48 +26,6 @@ function READ(const Str: string) : TMal; 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; @@ -79,11 +37,41 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; I : longint; Fn : TMalFunc; Args : TMalArray; + OldDict, NewDict : TMalDict; begin while true do begin - if Ast.ClassType <> TMalList then - Exit(eval_ast(Ast, Env)); + + 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); @@ -113,7 +101,8 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; end; 'do': begin - eval_ast(TMalList.Create(copy(Arr,1, Length(Arr)-2)), Env); + for I := 1 to Length(Arr) - 2 do + Cond := EVAL(Arr[I], Env); Ast := Arr[Length(Arr)-1]; // TCO end; 'if': @@ -133,14 +122,13 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; end; else begin - Arr := (eval_ast(Ast, Env) as TMalList).Val; - if Arr[0] is TMalFunc then + Cond := EVAL(Arr[0], Env); + Args := copy(Arr, 1, Length(Arr) - 1); + if Cond 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); + 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 diff --git a/impls/objpascal/step6_file.pas b/impls/objpascal/step6_file.pas index dfc53f16cd..dca8a85366 100644 --- a/impls/objpascal/step6_file.pas +++ b/impls/objpascal/step6_file.pas @@ -28,48 +28,6 @@ function READ(const Str: string) : TMal; 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; @@ -81,11 +39,41 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; I : longint; Fn : TMalFunc; Args : TMalArray; + OldDict, NewDict : TMalDict; begin while true do begin - if Ast.ClassType <> TMalList then - Exit(eval_ast(Ast, Env)); + + 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); @@ -115,7 +103,8 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; end; 'do': begin - eval_ast(TMalList.Create(copy(Arr,1, Length(Arr)-2)), Env); + for I := 1 to Length(Arr) - 2 do + Cond := EVAL(Arr[I], Env); Ast := Arr[Length(Arr)-1]; // TCO end; 'if': @@ -135,14 +124,13 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; end; else begin - Arr := (eval_ast(Ast, Env) as TMalList).Val; - if Arr[0] is TMalFunc then + Cond := EVAL(Arr[0], Env); + Args := copy(Arr, 1, Length(Arr) - 1); + if Cond 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); + 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 diff --git a/impls/objpascal/step7_quote.pas b/impls/objpascal/step7_quote.pas index c960b1e5db..15c640fd86 100644 --- a/impls/objpascal/step7_quote.pas +++ b/impls/objpascal/step7_quote.pas @@ -71,50 +71,6 @@ function quasiquote(Ast: TMal) : TMal; Exit(Res); 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; @@ -126,11 +82,41 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; I : longint; Fn : TMalFunc; Args : TMalArray; + OldDict, NewDict : TMalDict; begin while true do begin - if Ast.ClassType <> TMalList then - Exit(eval_ast(Ast, Env)); + + 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); @@ -160,13 +146,12 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; end; 'quote': Exit(Arr[1]); - 'quasiquoteexpand': - Exit(quasiquote(Arr[1])); 'quasiquote': Ast := quasiquote(Arr[1]); 'do': begin - eval_ast(TMalList.Create(copy(Arr,1, Length(Arr)-2)), Env); + for I := 1 to Length(Arr) - 2 do + Cond := EVAL(Arr[I], Env); Ast := Arr[Length(Arr)-1]; // TCO end; 'if': @@ -186,14 +171,13 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; end; else begin - Arr := (eval_ast(Ast, Env) as TMalList).Val; - if Arr[0] is TMalFunc then + Cond := EVAL(Arr[0], Env); + Args := copy(Arr, 1, Length(Arr) - 1); + if Cond 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); + 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 diff --git a/impls/objpascal/step8_macros.pas b/impls/objpascal/step8_macros.pas index 1efe3ff2e5..18ccfbbc68 100644 --- a/impls/objpascal/step8_macros.pas +++ b/impls/objpascal/step8_macros.pas @@ -71,91 +71,6 @@ function quasiquote(Ast: TMal) : TMal; Exit(Res); 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; @@ -167,15 +82,41 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; I : longint; Fn : TMalFunc; Args : TMalArray; + OldDict, NewDict : TMalDict; 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)); + 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); @@ -205,8 +146,6 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; end; 'quote': Exit(Arr[1]); - 'quasiquoteexpand': - Exit(quasiquote(Arr[1])); 'quasiquote': Ast := quasiquote(Arr[1]); 'defmacro!': @@ -216,11 +155,10 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; 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); + for I := 1 to Length(Arr) - 2 do + Cond := EVAL(Arr[I], Env); Ast := Arr[Length(Arr)-1]; // TCO end; 'if': @@ -240,14 +178,21 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; end; else begin - Arr := (eval_ast(Ast, Env) as TMalList).Val; - if Arr[0] is TMalFunc then + Cond := EVAL(Arr[0], Env); + Args := copy(Arr, 1, Length(Arr) - 1); + if Cond 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); + 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 diff --git a/impls/objpascal/step9_try.pas b/impls/objpascal/step9_try.pas index 3ce8c89159..4c510eac63 100644 --- a/impls/objpascal/step9_try.pas +++ b/impls/objpascal/step9_try.pas @@ -71,91 +71,6 @@ function quasiquote(Ast: TMal) : TMal; Exit(Res); 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; @@ -168,15 +83,41 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; Fn : TMalFunc; Args : TMalArray; Err : TMalArray; + OldDict, NewDict : TMalDict; 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)); + 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); @@ -206,8 +147,6 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; end; 'quote': Exit(Arr[1]); - 'quasiquoteexpand': - Exit(quasiquote(Arr[1])); 'quasiquote': Ast := quasiquote(Arr[1]); 'defmacro!': @@ -217,8 +156,6 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; Fn.isMacro := true; Exit(Env.Add((Arr[1] as TMalSymbol), Fn)); end; - 'macroexpand': - Exit(macroexpand(Arr[1], Env)); 'try*': begin try @@ -242,7 +179,8 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; end; 'do': begin - eval_ast(TMalList.Create(copy(Arr,1, Length(Arr)-2)), Env); + for I := 1 to Length(Arr) - 2 do + Cond := EVAL(Arr[I], Env); Ast := Arr[Length(Arr)-1]; // TCO end; 'if': @@ -262,14 +200,21 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; end; else begin - Arr := (eval_ast(Ast, Env) as TMalList).Val; - if Arr[0] is TMalFunc then + Cond := EVAL(Arr[0], Env); + Args := copy(Arr, 1, Length(Arr) - 1); + if Cond 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); + 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 diff --git a/impls/objpascal/stepA_mal.pas b/impls/objpascal/stepA_mal.pas index 51174c9934..be05145d4b 100644 --- a/impls/objpascal/stepA_mal.pas +++ b/impls/objpascal/stepA_mal.pas @@ -71,91 +71,6 @@ function quasiquote(Ast: TMal) : TMal; Exit(Res); 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; @@ -168,15 +83,41 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; Fn : TMalFunc; Args : TMalArray; Err : TMalArray; + OldDict, NewDict : TMalDict; 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)); + 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); @@ -206,8 +147,6 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; end; 'quote': Exit(Arr[1]); - 'quasiquoteexpand': - Exit(quasiquote(Arr[1])); 'quasiquote': Ast := quasiquote(Arr[1]); 'defmacro!': @@ -217,8 +156,6 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; Fn.isMacro := true; Exit(Env.Add((Arr[1] as TMalSymbol), Fn)); end; - 'macroexpand': - Exit(macroexpand(Arr[1], Env)); 'try*': begin try @@ -242,7 +179,8 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; end; 'do': begin - eval_ast(TMalList.Create(copy(Arr,1, Length(Arr)-2)), Env); + for I := 1 to Length(Arr) - 2 do + Cond := EVAL(Arr[I], Env); Ast := Arr[Length(Arr)-1]; // TCO end; 'if': @@ -262,14 +200,21 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; end; else begin - Arr := (eval_ast(Ast, Env) as TMalList).Val; - if Arr[0] is TMalFunc then + Cond := EVAL(Arr[0], Env); + Args := copy(Arr, 1, Length(Arr) - 1); + if Cond 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); + 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 diff --git a/impls/ocaml/core.ml b/impls/ocaml/core.ml index da2041e94b..fc665f9a6a 100644 --- a/impls/ocaml/core.ml +++ b/impls/ocaml/core.ml @@ -57,69 +57,69 @@ let rec conj = function | _ -> T.Nil let init env = begin - Env.set env (Types.symbol "throw") + Env.set env "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?") + 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 (Types.symbol "vector") (Types.fn (function xs -> Types.vector xs)); - Env.set env (Types.symbol "vector?") + 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 (Types.symbol "empty?") + 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 (Types.symbol "count") + 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.symbol "=") + Env.set env "=" (Types.fn (function | [a; b] -> T.Bool (Types.mal_equal a b) | _ -> T.Bool false)); - Env.set env (Types.symbol "pr-str") + Env.set env "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") + Env.set env "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") + Env.set env "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") + Env.set env "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") + Env.set env "compare" (Types.fn (function [a; b] -> T.Int (compare a b) | _ -> T.Nil)); - Env.set env (Types.symbol "with-meta") + Env.set env "with-meta" (Types.fn (function [a; b] -> Reader.with_meta a b | _ -> T.Nil)); - Env.set env (Types.symbol "meta") + Env.set env "meta" (Types.fn (function [x] -> Printer.meta x | _ -> T.Nil)); - Env.set env (Types.symbol "read-string") + Env.set env "read-string" (Types.fn (function [T.String x] -> Reader.read_str x | _ -> T.Nil)); - Env.set env (Types.symbol "slurp") + Env.set env "slurp" (Types.fn (function [T.String x] -> T.String (Reader.slurp x) | _ -> T.Nil)); - Env.set env (Types.symbol "cons") + Env.set env "cons" (Types.fn (function [x; xs] -> Types.list (x :: (seq xs)) | _ -> T.Nil)); - Env.set env (Types.symbol "concat") + Env.set env "concat" (Types.fn (let rec concat = function | x :: y :: more -> concat ((Types.list ((seq x) @ (seq y))) :: more) @@ -127,59 +127,59 @@ let init env = begin | [x] -> Types.list (seq x) | [] -> Types.list [] in concat)); - Env.set env (Types.symbol "vec") (Types.fn (function + 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 (Types.symbol "nth") + 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 (Types.symbol "first") + Env.set env "first" (Types.fn (function | [xs] -> (match seq xs with x :: _ -> x | _ -> T.Nil) | _ -> T.Nil)); - Env.set env (Types.symbol "rest") + Env.set env "rest" (Types.fn (function | [xs] -> Types.list (match seq xs with _ :: xs -> xs | _ -> []) | _ -> T.Nil)); - Env.set env (Types.symbol "string?") + Env.set env "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?") + 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 (Types.symbol "keyword") + Env.set env "keyword" (Types.fn (function | [T.String x] -> T.Keyword x | [T.Keyword x] -> T.Keyword x | _ -> T.Nil)); - Env.set env (Types.symbol "keyword?") + Env.set env "keyword?" (Types.fn (function [T.Keyword _] -> T.Bool true | _ -> T.Bool false)); - Env.set env (Types.symbol "number?") + Env.set env "number?" (Types.fn (function [T.Int _] -> T.Bool true | _ -> T.Bool false)); - Env.set env (Types.symbol "fn?") + Env.set env "fn?" (Types.fn (function | [T.Fn { T.meta = T.Map { T.value = meta } }] -> mk_bool (not (Types.MalMap.mem kw_macro meta && Types.to_bool (Types.MalMap.find kw_macro meta))) | [T.Fn _] -> T.Bool true | _ -> T.Bool false)); - Env.set env (Types.symbol "macro?") + Env.set env "macro?" (Types.fn (function | [T.Fn { T.meta = T.Map { T.value = meta } }] -> mk_bool (Types.MalMap.mem kw_macro meta && Types.to_bool (Types.MalMap.find kw_macro meta)) | _ -> T.Bool false)); - Env.set env (Types.symbol "nil?") + Env.set env "nil?" (Types.fn (function [T.Nil] -> T.Bool true | _ -> T.Bool false)); - Env.set env (Types.symbol "true?") + Env.set env "true?" (Types.fn (function [T.Bool true] -> T.Bool true | _ -> T.Bool false)); - Env.set env (Types.symbol "false?") + Env.set env "false?" (Types.fn (function [T.Bool false] -> T.Bool true | _ -> T.Bool false)); - Env.set env (Types.symbol "sequential?") + Env.set env "sequential?" (Types.fn (function [T.List _] | [T.Vector _] -> T.Bool true | _ -> T.Bool false)); - Env.set env (Types.symbol "apply") + Env.set env "apply" (Types.fn (function | (T.Fn { T.value = f } :: apply_args) -> (match List.rev apply_args with @@ -187,56 +187,56 @@ let init env = begin 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") + Env.set env "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") + Env.set env "readline" (Types.fn (function | [T.String x] -> print_string x; T.String (read_line ()) | _ -> T.String (read_line ()))); - Env.set env (Types.symbol "map?") + Env.set env "map?" (Types.fn (function [T.Map _] -> T.Bool true | _ -> T.Bool false)); - Env.set env (Types.symbol "hash-map") + Env.set env "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") + 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 (Types.symbol "keys") + 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 (Types.symbol "vals") + 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 (Types.symbol "contains?") + 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 (Types.symbol "conj") (Types.fn conj); - Env.set env (Types.symbol "seq") (Types.fn mal_seq); + Env.set env "conj" (Types.fn conj); + Env.set env "seq" (Types.fn mal_seq); - Env.set env (Types.symbol "atom?") + Env.set env "atom?" (Types.fn (function [T.Atom _] -> T.Bool true | _ -> T.Bool false)); - Env.set env (Types.symbol "atom") + Env.set env "atom" (Types.fn (function [x] -> T.Atom (ref x) | _ -> T.Nil)); - Env.set env (Types.symbol "deref") + Env.set env "deref" (Types.fn (function [T.Atom x] -> !x | _ -> T.Nil)); - Env.set env (Types.symbol "reset!") + Env.set env "reset!" (Types.fn (function [T.Atom x; v] -> x := v; v | _ -> T.Nil)); - Env.set env (Types.symbol "swap!") + Env.set env "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") + Env.set env "time-ms" (Types.fn (function _ -> T.Int (truncate (1000.0 *. Unix.gettimeofday ())))); end diff --git a/impls/ocaml/env.ml b/impls/ocaml/env.ml index cb32360eb0..769281cf06 100644 --- a/impls/ocaml/env.ml +++ b/impls/ocaml/env.ml @@ -8,26 +8,12 @@ type env = { 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 set env key value = + env.data := Data.add key value !(env.data) -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") +let rec get env key = + match Data.find_opt key !(env.data) with + | Some value -> Some value + | None -> match env.outer with + | Some outer -> get outer key + | None -> None diff --git a/impls/ocaml/printer.ml b/impls/ocaml/printer.ml index 74a8c64502..ed4a21d6c5 100644 --- a/impls/ocaml/printer.ml +++ b/impls/ocaml/printer.ml @@ -5,7 +5,6 @@ let meta obj = | 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 @@ -13,7 +12,7 @@ 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.Symbol s -> s | T.Keyword s -> ":" ^ s | T.Nil -> "nil" | T.Bool true -> "true" diff --git a/impls/ocaml/reader.ml b/impls/ocaml/reader.ml index b9e2bce753..b96561f71b 100644 --- a/impls/ocaml/reader.ml +++ b/impls/ocaml/reader.ml @@ -52,22 +52,20 @@ let read_atom token = match token.[0] with | '0'..'9' -> T.Int (int_of_string token) | '-' -> (match String.length token with - | 1 -> Types.symbol token + | 1 -> T.Symbol token | _ -> (match token.[1] with | '0'..'9' -> T.Int (int_of_string token) - | _ -> Types.symbol token)) + | _ -> T.Symbol token)) | '"' -> T.String (unescape_string token) | ':' -> T.Keyword (Str.replace_first (Str.regexp "^:") "" token) - | _ -> Types.symbol token + | _ -> T.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 }; + | 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.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 = @@ -87,7 +85,7 @@ let rec read_list eol list_reader = tokens = reader.tokens} and read_quote sym tokens = let reader = read_form tokens in - {form = Types.list [ Types.symbol sym; reader.form ]; + {form = Types.list [ T.Symbol sym; reader.form ]; tokens = reader.tokens} and read_form all_tokens = match all_tokens with @@ -103,7 +101,7 @@ and read_form all_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]; + form = Types.list [T.Symbol "with-meta"; value.form; meta.form]; tokens = value.tokens} | "(" -> let list_reader = read_list ")" {list_form = []; tokens = tokens} in diff --git a/impls/ocaml/step2_eval.ml b/impls/ocaml/step2_eval.ml index ce4b5dcff2..85f98b97be 100644 --- a/impls/ocaml/step2_eval.ml +++ b/impls/ocaml/step2_eval.ml @@ -20,14 +20,13 @@ let repl_env = ref (List.fold_left (fun a b -> b a) Env.empty Env.add "*" (num_fun ( * )); Env.add "/" (num_fun ( / )) ]) -let rec eval_ast ast env = +let rec eval ast env = + (* output_string stderr ("EVAL: " ^ (Printer.pr_str ast true) ^ "\n"); *) + (* flush stderr; *) match ast with - | T.Symbol { T.value = s } -> + | T.Symbol 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 } @@ -38,12 +37,11 @@ let rec eval_ast ast env = -> Types.MalMap.add k (eval v env) m) xs Types.MalMap.empty)} + | T.List { T.value = (a0 :: args) } -> + (match eval a0 env with + | T.Fn { T.value = f } -> f (List.map (fun x -> eval x env) args) + | _ -> raise (Invalid_argument "Cannot invoke non-function")) | _ -> 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 diff --git a/impls/ocaml/step3_env.ml b/impls/ocaml/step3_env.ml index dde04dc133..f2bd067112 100644 --- a/impls/ocaml/step3_env.ml +++ b/impls/ocaml/step3_env.ml @@ -8,18 +8,24 @@ let num_fun f = Types.fn 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 ( / )); + Env.set env "+" (num_fun ( + )); + Env.set env "-" (num_fun ( - )); + Env.set env "*" (num_fun ( * )); + Env.set env "/" (num_fun ( / )); end -let rec eval_ast ast env = +let rec eval ast env = + (match Env.get env "DEBUG-EVAL" with + | None -> () + | Some T.Nil -> () + | Some (T.Bool false) -> () + | Some _ -> + output_string stderr ("EVAL: " ^ (Printer.pr_str ast true) ^ "\n"); + flush stderr); 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.Symbol s -> (match Env.get env s with + | Some v -> v + | None -> raise (Invalid_argument ("'" ^ s ^ "' not found"))) | T.Vector { T.value = xs; T.meta = meta } -> T.Vector { T.value = (List.map (fun x -> eval x env) xs); T.meta = meta } @@ -30,29 +36,26 @@ let rec eval_ast ast env = -> Types.MalMap.add k (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] } -> + | T.List { T.value = [T.Symbol "def!"; T.Symbol 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] } -> + | 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 - | sym :: expr :: more -> + | T.Symbol sym :: expr :: more -> Env.set sub_env sym (eval expr sub_env); 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 body sub_env) - | T.List _ -> - (match eval_ast ast env with - | T.List { T.value = ((T.Fn { T.value = f }) :: args) } -> f args + | T.List { T.value = (a0 :: args) } -> + (match eval a0 env with + | T.Fn { T.value = f } -> f (List.map (fun x -> eval x env) args) | _ -> raise (Invalid_argument "Cannot invoke non-function")) - | _ -> eval_ast ast env + | _ -> ast let read str = Reader.read_str str let print exp = Printer.pr_str exp true diff --git a/impls/ocaml/step4_if_fn_do.ml b/impls/ocaml/step4_if_fn_do.ml index a425ffc8cb..977f5083c6 100644 --- a/impls/ocaml/step4_if_fn_do.ml +++ b/impls/ocaml/step4_if_fn_do.ml @@ -2,12 +2,18 @@ module T = Types.Types let repl_env = Env.make (Some Core.ns) -let rec eval_ast ast env = +let rec eval ast env = + (match Env.get env "DEBUG-EVAL" with + | None -> () + | Some T.Nil -> () + | Some (T.Bool false) -> () + | Some _ -> + output_string stderr ("EVAL: " ^ (Printer.pr_str ast true) ^ "\n"); + flush stderr); 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.Symbol s -> (match Env.get env s with + | Some v -> v + | None -> raise (Invalid_argument ("'" ^ s ^ "' not found"))) | T.Vector { T.value = xs; T.meta = meta } -> T.Vector { T.value = (List.map (fun x -> eval x env) xs); T.meta = meta } @@ -18,50 +24,47 @@ let rec eval_ast ast env = -> Types.MalMap.add k (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] } -> + | T.List { T.value = [T.Symbol "def!"; T.Symbol 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] } -> + | 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 - | sym :: expr :: more -> + | T.Symbol sym :: expr :: more -> Env.set sub_env sym (eval expr sub_env); 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 body sub_env) - | T.List { T.value = ((T.Symbol { T.value = "do" }) :: body) } -> + | T.List { T.value = (T.Symbol "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] } -> + | T.List { T.value = [T.Symbol "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] } -> + | T.List { T.value = [T.Symbol "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] } -> + | 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.value = "&" }; name], args -> Env.set sub_env name (Types.list args); - | (name :: names), (arg :: args) -> + | [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 expr sub_env) - | T.List _ -> - (match eval_ast ast env with - | T.List { T.value = ((T.Fn { T.value = f }) :: args) } -> f args + | T.List { T.value = (a0 :: args) } -> + (match eval a0 env with + | T.Fn { T.value = f } -> f (List.map (fun x -> eval x env) args) | _ -> raise (Invalid_argument "Cannot invoke non-function")) - | _ -> eval_ast ast env + | _ -> ast let read str = Reader.read_str str let print exp = Printer.pr_str exp true diff --git a/impls/ocaml/step6_file.ml b/impls/ocaml/step6_file.ml index 0df1c3010f..350027a9aa 100644 --- a/impls/ocaml/step6_file.ml +++ b/impls/ocaml/step6_file.ml @@ -2,12 +2,18 @@ module T = Types.Types let repl_env = Env.make (Some Core.ns) -let rec eval_ast ast env = +let rec eval ast env = + (match Env.get env "DEBUG-EVAL" with + | None -> () + | Some T.Nil -> () + | Some (T.Bool false) -> () + | Some _ -> + output_string stderr ("EVAL: " ^ (Printer.pr_str ast true) ^ "\n"); + flush stderr); 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.Symbol s -> (match Env.get env s with + | Some v -> v + | None -> raise (Invalid_argument ("'" ^ s ^ "' not found"))) | T.Vector { T.value = xs; T.meta = meta } -> T.Vector { T.value = (List.map (fun x -> eval x env) xs); T.meta = meta } @@ -18,50 +24,47 @@ let rec eval_ast ast env = -> Types.MalMap.add k (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] } -> + | T.List { T.value = [T.Symbol "def!"; T.Symbol 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] } -> + | 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 - | sym :: expr :: more -> + | T.Symbol sym :: expr :: more -> Env.set sub_env sym (eval expr sub_env); 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 body sub_env) - | T.List { T.value = ((T.Symbol { T.value = "do" }) :: body) } -> + | T.List { T.value = (T.Symbol "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] } -> + | T.List { T.value = [T.Symbol "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] } -> + | T.List { T.value = [T.Symbol "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] } -> + | 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.value = "&" }; name], args -> Env.set sub_env name (Types.list args); - | (name :: names), (arg :: args) -> + | [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 expr sub_env) - | T.List _ -> - (match eval_ast ast env with - | T.List { T.value = ((T.Fn { T.value = f }) :: args) } -> f args + | T.List { T.value = (a0 :: args) } -> + (match eval a0 env with + | T.Fn { T.value = f } -> f (List.map (fun x -> eval x env) args) | _ -> raise (Invalid_argument "Cannot invoke non-function")) - | _ -> eval_ast ast env + | _ -> ast let read str = Reader.read_str str let print exp = Printer.pr_str exp true @@ -70,11 +73,11 @@ let rep str env = print (eval (read str) env) let rec main = try Core.init Core.ns; - Env.set repl_env (Types.symbol "*ARGV*") + 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 (Types.symbol "eval") + Env.set repl_env "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) \"\nnil)\")))))" repl_env); ignore (rep "(def! not (fn* (a) (if a false true)))" repl_env); diff --git a/impls/ocaml/step7_quote.ml b/impls/ocaml/step7_quote.ml index dcad28fe54..0da8bef8ec 100644 --- a/impls/ocaml/step7_quote.ml +++ b/impls/ocaml/step7_quote.ml @@ -4,24 +4,30 @@ 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.List { T.value = [T.Symbol "unquote"; ast] } -> ast | T.List {T.value = xs} -> List.fold_right qq_folder xs (Types.list []) - | T.Vector {T.value = xs} -> Types.list [Types.symbol "vec"; + | T.Vector {T.value = xs} -> Types.list [T.Symbol "vec"; List.fold_right qq_folder xs (Types.list [])] - | T.Map _ -> Types.list [Types.symbol "quote"; ast] - | T.Symbol _ -> Types.list [Types.symbol "quote"; ast] + | T.Map _ -> Types.list [T.Symbol "quote"; ast] + | T.Symbol _ -> Types.list [T.Symbol "quote"; ast] | _ -> ast and qq_folder elt acc = match elt with - | T.List {T.value = [T.Symbol {T.value = "splice-unquote"}; x]} -> Types.list [Types.symbol "concat"; x; acc] - | _ -> Types.list [Types.symbol "cons"; quasiquote elt; acc] + | 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_ast ast env = +let rec eval ast env = + (match Env.get env "DEBUG-EVAL" with + | None -> () + | Some T.Nil -> () + | Some (T.Bool false) -> () + | Some _ -> + output_string stderr ("EVAL: " ^ (Printer.pr_str ast true) ^ "\n"); + flush stderr); 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.Symbol s -> (match Env.get env s with + | Some v -> v + | None -> raise (Invalid_argument ("'" ^ s ^ "' not found"))) | T.Vector { T.value = xs; T.meta = meta } -> T.Vector { T.value = (List.map (fun x -> eval x env) xs); T.meta = meta } @@ -32,55 +38,50 @@ let rec eval_ast ast env = -> Types.MalMap.add k (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] } -> + | T.List { T.value = [T.Symbol "def!"; T.Symbol 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] } -> + | 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 - | sym :: expr :: more -> + | T.Symbol sym :: expr :: more -> Env.set sub_env sym (eval expr sub_env); 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 body sub_env) - | T.List { T.value = ((T.Symbol { T.value = "do" }) :: body) } -> + | T.List { T.value = (T.Symbol "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] } -> + | T.List { T.value = [T.Symbol "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] } -> + | T.List { T.value = [T.Symbol "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] } -> + | 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.value = "&" }; name], args -> Env.set sub_env name (Types.list args); - | (name :: names), (arg :: args) -> + | [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 expr sub_env) - | T.List { T.value = [T.Symbol { T.value = "quote" }; ast] } -> ast - | T.List { T.value = [T.Symbol { T.value = "quasiquoteexpand" }; ast] } -> - quasiquote ast - | T.List { T.value = [T.Symbol { T.value = "quasiquote" }; ast] } -> + | T.List { T.value = [T.Symbol "quote"; ast] } -> ast + | T.List { T.value = [T.Symbol "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 + | T.List { T.value = (a0 :: args) } -> + (match eval a0 env with + | T.Fn { T.value = f } -> f (List.map (fun x -> eval x env) args) | _ -> raise (Invalid_argument "Cannot invoke non-function")) - | _ -> eval_ast ast env + | _ -> ast let read str = Reader.read_str str let print exp = Printer.pr_str exp true @@ -89,11 +90,11 @@ let rep str env = print (eval (read str) env) let rec main = try Core.init Core.ns; - Env.set repl_env (Types.symbol "*ARGV*") + 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 (Types.symbol "eval") + Env.set repl_env "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) \"\nnil)\")))))" repl_env); ignore (rep "(def! not (fn* (a) (if a false true)))" repl_env); diff --git a/impls/ocaml/step8_macros.ml b/impls/ocaml/step8_macros.ml index b9f35df5ed..87ed34eafd 100644 --- a/impls/ocaml/step8_macros.ml +++ b/impls/ocaml/step8_macros.ml @@ -4,43 +4,30 @@ 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.List { T.value = [T.Symbol "unquote"; ast] } -> ast | T.List {T.value = xs} -> List.fold_right qq_folder xs (Types.list []) - | T.Vector {T.value = xs} -> Types.list [Types.symbol "vec"; + | T.Vector {T.value = xs} -> Types.list [T.Symbol "vec"; List.fold_right qq_folder xs (Types.list [])] - | T.Map _ -> Types.list [Types.symbol "quote"; ast] - | T.Symbol _ -> Types.list [Types.symbol "quote"; ast] + | T.Map _ -> Types.list [T.Symbol "quote"; ast] + | T.Symbol _ -> Types.list [T.Symbol "quote"; ast] | _ -> ast and qq_folder elt acc = match elt with - | T.List {T.value = [T.Symbol {T.value = "splice-unquote"}; x]} -> Types.list [Types.symbol "concat"; x; acc] - | _ -> Types.list [Types.symbol "cons"; quasiquote elt; acc] + | 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 is_macro_call ast env = +let rec eval ast env = + (match Env.get env "DEBUG-EVAL" with + | None -> () + | Some T.Nil -> () + | Some (T.Bool false) -> () + | Some _ -> + output_string stderr ("EVAL: " ^ (Printer.pr_str ast true) ^ "\n"); + flush stderr); 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 Core.kw_macro meta && Types.to_bool (Types.MalMap.find Core.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.Symbol s -> (match Env.get env s with + | Some v -> v + | None -> raise (Invalid_argument ("'" ^ s ^ "' not found"))) | T.Vector { T.value = xs; T.meta = meta } -> T.Vector { T.value = (List.map (fun x -> eval x env) xs); T.meta = meta } @@ -51,63 +38,60 @@ let rec eval_ast ast env = -> Types.MalMap.add k (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] } -> + | T.List { T.value = [T.Symbol "def!"; T.Symbol 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] } -> + | T.List { T.value = [T.Symbol "defmacro!"; T.Symbol 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; Core.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] } -> + | 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 - | sym :: expr :: more -> + | T.Symbol sym :: expr :: more -> Env.set sub_env sym (eval expr sub_env); 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 body sub_env) - | T.List { T.value = ((T.Symbol { T.value = "do" }) :: body) } -> + | T.List { T.value = (T.Symbol "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] } -> + | T.List { T.value = [T.Symbol "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] } -> + | T.List { T.value = [T.Symbol "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] } -> + | 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.value = "&" }; name], args -> Env.set sub_env name (Types.list args); - | (name :: names), (arg :: args) -> + | [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 expr sub_env) - | T.List { T.value = [T.Symbol { T.value = "quote" }; ast] } -> ast - | T.List { T.value = [T.Symbol { T.value = "quasiquoteexpand" }; ast] } -> - quasiquote ast - | T.List { T.value = [T.Symbol { T.value = "quasiquote" }; ast] } -> + | T.List { T.value = [T.Symbol "quote"; ast] } -> ast + | T.List { T.value = [T.Symbol "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 + | T.List { T.value = (a0 :: args) } -> + (match eval a0 env with + | T.Fn { T.value = f; T.meta = T.Map { T.value = meta } } -> + if Types.MalMap.mem Core.kw_macro meta && Types.to_bool (Types.MalMap.find Core.kw_macro meta) + then eval (f args) env + else f (List.map (fun x -> eval x env) args) + | T.Fn { T.value = f } -> f (List.map (fun x -> eval x env) args) | _ -> raise (Invalid_argument "Cannot invoke non-function")) - | ast -> eval_ast ast env + | _ -> ast let read str = Reader.read_str str let print exp = Printer.pr_str exp true @@ -116,11 +100,11 @@ let rep str env = print (eval (read str) env) let rec main = try Core.init Core.ns; - Env.set repl_env (Types.symbol "*ARGV*") + 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 (Types.symbol "eval") + Env.set repl_env "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) \"\nnil)\")))))" repl_env); diff --git a/impls/ocaml/step9_try.ml b/impls/ocaml/step9_try.ml index ba68aab346..ed49e897a8 100644 --- a/impls/ocaml/step9_try.ml +++ b/impls/ocaml/step9_try.ml @@ -4,43 +4,30 @@ 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.List { T.value = [T.Symbol "unquote"; ast] } -> ast | T.List {T.value = xs} -> List.fold_right qq_folder xs (Types.list []) - | T.Vector {T.value = xs} -> Types.list [Types.symbol "vec"; + | T.Vector {T.value = xs} -> Types.list [T.Symbol "vec"; List.fold_right qq_folder xs (Types.list [])] - | T.Map _ -> Types.list [Types.symbol "quote"; ast] - | T.Symbol _ -> Types.list [Types.symbol "quote"; ast] + | T.Map _ -> Types.list [T.Symbol "quote"; ast] + | T.Symbol _ -> Types.list [T.Symbol "quote"; ast] | _ -> ast and qq_folder elt acc = match elt with - | T.List {T.value = [T.Symbol {T.value = "splice-unquote"}; x]} -> Types.list [Types.symbol "concat"; x; acc] - | _ -> Types.list [Types.symbol "cons"; quasiquote elt; acc] + | 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 is_macro_call ast env = +let rec eval ast env = + (match Env.get env "DEBUG-EVAL" with + | None -> () + | Some T.Nil -> () + | Some (T.Bool false) -> () + | Some _ -> + output_string stderr ("EVAL: " ^ (Printer.pr_str ast true) ^ "\n"); + flush stderr); 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 Core.kw_macro meta && Types.to_bool (Types.MalMap.find Core.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.Symbol s -> (match Env.get env s with + | Some v -> v + | None -> raise (Invalid_argument ("'" ^ s ^ "' not found"))) | T.Vector { T.value = xs; T.meta = meta } -> T.Vector { T.value = (List.map (fun x -> eval x env) xs); T.meta = meta } @@ -51,63 +38,56 @@ let rec eval_ast ast env = -> Types.MalMap.add k (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] } -> + | T.List { T.value = [T.Symbol "def!"; T.Symbol 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] } -> + | T.List { T.value = [T.Symbol "defmacro!"; T.Symbol 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; Core.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] } -> + | 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 - | sym :: expr :: more -> + | T.Symbol sym :: expr :: more -> Env.set sub_env sym (eval expr sub_env); 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 body sub_env) - | T.List { T.value = ((T.Symbol { T.value = "do" }) :: body) } -> + | T.List { T.value = (T.Symbol "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] } -> + | T.List { T.value = [T.Symbol "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] } -> + | T.List { T.value = [T.Symbol "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] } -> + | 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.value = "&" }; name], args -> Env.set sub_env name (Types.list args); - | (name :: names), (arg :: args) -> + | [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 expr sub_env) - | T.List { T.value = [T.Symbol { T.value = "quote" }; ast] } -> ast - | T.List { T.value = [T.Symbol { T.value = "quasiquoteexpand" }; ast] } -> - quasiquote ast - | T.List { T.value = [T.Symbol { T.value = "quasiquote" }; ast] } -> + | T.List { T.value = [T.Symbol "quote"; ast] } -> ast + | T.List { T.value = [T.Symbol "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 "try*"; scary]} -> (eval scary env) - | T.List { T.value = [T.Symbol { T.value = "try*" }; scary ; - T.List { T.value = [T.Symbol { T.value = "catch*" }; - local ; handler]}]} -> + | T.List { T.value = [T.Symbol "try*"; scary ; + T.List { T.value = [T.Symbol "catch*"; + T.Symbol local ; handler]}]} -> (try (eval scary env) with exn -> let value = match exn with @@ -117,11 +97,15 @@ and eval ast env = 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 + | T.List { T.value = (a0 :: args) } -> + (match eval a0 env with + | T.Fn { T.value = f; T.meta = T.Map { T.value = meta } } -> + if Types.MalMap.mem Core.kw_macro meta && Types.to_bool (Types.MalMap.find Core.kw_macro meta) + then eval (f args) env + else f (List.map (fun x -> eval x env) args) + | T.Fn { T.value = f } -> f (List.map (fun x -> eval x env) args) | _ -> raise (Invalid_argument "Cannot invoke non-function")) - | ast -> eval_ast ast env + | _ -> ast let read str = Reader.read_str str let print exp = Printer.pr_str exp true @@ -130,11 +114,11 @@ let rep str env = print (eval (read str) env) let rec main = try Core.init Core.ns; - Env.set repl_env (Types.symbol "*ARGV*") + 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 (Types.symbol "eval") + Env.set repl_env "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) \"\nnil)\")))))" repl_env); diff --git a/impls/ocaml/stepA_mal.ml b/impls/ocaml/stepA_mal.ml index d9f56be6f4..0e2d86961b 100644 --- a/impls/ocaml/stepA_mal.ml +++ b/impls/ocaml/stepA_mal.ml @@ -4,43 +4,30 @@ 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.List { T.value = [T.Symbol "unquote"; ast] } -> ast | T.List {T.value = xs} -> List.fold_right qq_folder xs (Types.list []) - | T.Vector {T.value = xs} -> Types.list [Types.symbol "vec"; + | T.Vector {T.value = xs} -> Types.list [T.Symbol "vec"; List.fold_right qq_folder xs (Types.list [])] - | T.Map _ -> Types.list [Types.symbol "quote"; ast] - | T.Symbol _ -> Types.list [Types.symbol "quote"; ast] + | T.Map _ -> Types.list [T.Symbol "quote"; ast] + | T.Symbol _ -> Types.list [T.Symbol "quote"; ast] | _ -> ast and qq_folder elt acc = match elt with - | T.List {T.value = [T.Symbol {T.value = "splice-unquote"}; x]} -> Types.list [Types.symbol "concat"; x; acc] - | _ -> Types.list [Types.symbol "cons"; quasiquote elt; acc] + | 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 is_macro_call ast env = +let rec eval ast env = + (match Env.get env "DEBUG-EVAL" with + | None -> () + | Some T.Nil -> () + | Some (T.Bool false) -> () + | Some _ -> + output_string stderr ("EVAL: " ^ (Printer.pr_str ast true) ^ "\n"); + flush stderr); 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 Core.kw_macro meta && Types.to_bool (Types.MalMap.find Core.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.Symbol s -> (match Env.get env s with + | Some v -> v + | None -> raise (Invalid_argument ("'" ^ s ^ "' not found"))) | T.Vector { T.value = xs; T.meta = meta } -> T.Vector { T.value = (List.map (fun x -> eval x env) xs); T.meta = meta } @@ -51,63 +38,56 @@ let rec eval_ast ast env = -> Types.MalMap.add k (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] } -> + | T.List { T.value = [T.Symbol "def!"; T.Symbol 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] } -> + | T.List { T.value = [T.Symbol "defmacro!"; T.Symbol 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; Core.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] } -> + | 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 - | sym :: expr :: more -> + | T.Symbol sym :: expr :: more -> Env.set sub_env sym (eval expr sub_env); 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 body sub_env) - | T.List { T.value = ((T.Symbol { T.value = "do" }) :: body) } -> + | T.List { T.value = (T.Symbol "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] } -> + | T.List { T.value = [T.Symbol "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] } -> + | T.List { T.value = [T.Symbol "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] } -> + | 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.value = "&" }; name], args -> Env.set sub_env name (Types.list args); - | (name :: names), (arg :: args) -> + | [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 expr sub_env) - | T.List { T.value = [T.Symbol { T.value = "quote" }; ast] } -> ast - | T.List { T.value = [T.Symbol { T.value = "quasiquoteexpand" }; ast] } -> - quasiquote ast - | T.List { T.value = [T.Symbol { T.value = "quasiquote" }; ast] } -> + | T.List { T.value = [T.Symbol "quote"; ast] } -> ast + | T.List { T.value = [T.Symbol "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 "try*"; scary]} -> (eval scary env) - | T.List { T.value = [T.Symbol { T.value = "try*" }; scary ; - T.List { T.value = [T.Symbol { T.value = "catch*" }; - local ; handler]}]} -> + | T.List { T.value = [T.Symbol "try*"; scary ; + T.List { T.value = [T.Symbol "catch*"; + T.Symbol local ; handler]}]} -> (try (eval scary env) with exn -> let value = match exn with @@ -117,11 +97,15 @@ and eval ast env = 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 + | T.List { T.value = (a0 :: args) } -> + (match eval a0 env with + | T.Fn { T.value = f; T.meta = T.Map { T.value = meta } } -> + if Types.MalMap.mem Core.kw_macro meta && Types.to_bool (Types.MalMap.find Core.kw_macro meta) + then eval (f args) env + else f (List.map (fun x -> eval x env) args) + | T.Fn { T.value = f } -> f (List.map (fun x -> eval x env) args) | _ -> raise (Invalid_argument "Cannot invoke non-function")) - | ast -> eval_ast ast env + | _ -> ast let read str = Reader.read_str str let print exp = Printer.pr_str exp true @@ -130,11 +114,11 @@ let rep str env = print (eval (read str) env) let rec main = try Core.init Core.ns; - Env.set repl_env (Types.symbol "*ARGV*") + 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 (Types.symbol "eval") + Env.set repl_env "eval" (Types.fn (function [ast] -> eval ast repl_env | _ -> T.Nil)); ignore (rep "(def! *host-language* \"ocaml\")" repl_env); diff --git a/impls/ocaml/types.ml b/impls/ocaml/types.ml index 45d10bdb30..9d98d566cf 100644 --- a/impls/ocaml/types.ml +++ b/impls/ocaml/types.ml @@ -6,7 +6,7 @@ module rec Types | Vector of t list with_meta | Map of t MalMap.t with_meta | Int of int - | Symbol of string with_meta + | Symbol of string | Keyword of string | Nil | Bool of bool @@ -40,7 +40,6 @@ 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 = diff --git a/impls/perl/env.pm b/impls/perl/env.pm index 5614b2eb87..873cbb7739 100644 --- a/impls/perl/env.pm +++ b/impls/perl/env.pm @@ -23,22 +23,16 @@ use Exporter 'import'; } bless $data => $class } - sub find { + sub get { my ($self, $key) = @_; - if (exists $self->{$$key}) { return $self; } - elsif ($self->{__outer__}) { return $self->{__outer__}->find($key); } + if (exists $self->{$key}) { return $self->{$key}; } + elsif ($self->{__outer__}) { return $self->{__outer__}->get($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}; + $self->{$key} = $value; + return $value; } } @@ -55,9 +49,7 @@ use Exporter 'import'; #$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/impls/perl/step2_eval.pl b/impls/perl/step2_eval.pl index 8fe002e97a..3ef9ce44c8 100644 --- a/impls/perl/step2_eval.pl +++ b/impls/perl/step2_eval.pl @@ -19,31 +19,27 @@ sub READ { } # eval -sub eval_ast { +sub EVAL { my($ast, $env) = @_; + #print "EVAL: " . printer::_pr_str($ast) . "\n"; + if ($ast->isa('Mal::Symbol')) { return $env->{$$ast} // die "'$$ast' not found\n"; - } elsif ($ast->isa('Mal::Sequence')) { + } elsif ($ast->isa('Mal::Vector')) { return ref($ast)->new([ map { EVAL($_, $env) } @$ast ]); } elsif ($ast->isa('Mal::HashMap')) { return Mal::HashMap->new({ pairmap { $a => EVAL($b, $env) } %$ast }); - } else { + } elsif (! $ast->isa('Mal::List')) { return $ast; } -} - -sub EVAL { - my($ast, $env) = @_; - #print "EVAL: " . printer::_pr_str($ast) . "\n"; - if (! $ast->isa('Mal::List')) { - return eval_ast($ast, $env); - } # apply list + unless (@$ast) { return $ast; } - my @el = @{eval_ast($ast, $env)}; - my $f = shift @el; - return &$f(@el); + my ($a0) = @$ast; + my $f = EVAL($a0, $env); + my (undef, @args) = @$ast; + return &$f(map { EVAL($_, $env) } @args); } # print diff --git a/impls/perl/step3_env.pl b/impls/perl/step3_env.pl index 478c1e9ad2..5e6baa1a16 100644 --- a/impls/perl/step3_env.pl +++ b/impls/perl/step3_env.pl @@ -10,7 +10,7 @@ use Scalar::Util qw(blessed); use readline qw(mal_readline set_rl_mode); -use types; +use types qw($nil $false); use reader; use printer; use env; @@ -22,46 +22,48 @@ sub READ { } # eval -sub eval_ast { +sub EVAL { my($ast, $env) = @_; + + my $dbgeval = $env->get('DEBUG-EVAL'); + if ($dbgeval and $dbgeval ne $nil and $dbgeval ne $false) { + print "EVAL: " . printer::_pr_str($ast) . "\n"; + } + if ($ast->isa('Mal::Symbol')) { - return $env->get($ast); - } elsif ($ast->isa('Mal::Sequence')) { + my $val = $env->get($$ast); + die "'$$ast' not found\n" unless $val; + return $val; + } elsif ($ast->isa('Mal::Vector')) { return ref($ast)->new([ map { EVAL($_, $env) } @$ast ]); } elsif ($ast->isa('Mal::HashMap')) { return Mal::HashMap->new({ pairmap { $a => EVAL($b, $env) } %$ast }); - } else { + } elsif (! $ast->isa('Mal::List')) { return $ast; } -} - -sub EVAL { - my($ast, $env) = @_; - #print "EVAL: " . printer::_pr_str($ast) . "\n"; - if (! $ast->isa('Mal::List')) { - return eval_ast($ast, $env); - } # apply list + unless (@$ast) { return $ast; } - given (${$ast->[0]}) { + my ($a0) = @$ast; + given ($a0->isa('Mal::Symbol') ? $$a0 : $a0) { when ('def!') { my (undef, $sym, $val) = @$ast; - return $env->set($sym, EVAL($val, $env)); + return $env->set($$sym, EVAL($val, $env)); } when ('let*') { my (undef, $bindings, $body) = @$ast; my $let_env = Mal::Env->new($env); foreach my $pair (pairs @$bindings) { my ($k, $v) = @$pair; - $let_env->set($k, EVAL($v, $let_env)); + $let_env->set($$k, EVAL($v, $let_env)); } return EVAL($body, $let_env); } default { - my @el = @{eval_ast($ast, $env)}; - my $f = shift @el; - return &$f(@el); + my $f = EVAL($a0, $env); + my (undef, @args) = @$ast; + return &$f(map { EVAL($_, $env) } @args); } } } @@ -79,13 +81,13 @@ sub REP { return PRINT(EVAL(READ($str), $repl_env)); } -$repl_env->set(Mal::Symbol->new('+'), +$repl_env->set('+', sub { Mal::Integer->new(${$_[0]} + ${$_[1]}) } ); -$repl_env->set(Mal::Symbol->new('-'), +$repl_env->set('-', sub { Mal::Integer->new(${$_[0]} - ${$_[1]}) } ); -$repl_env->set(Mal::Symbol->new('*'), +$repl_env->set('*', sub { Mal::Integer->new(${$_[0]} * ${$_[1]}) } ); -$repl_env->set(Mal::Symbol->new('/'), +$repl_env->set('/', sub { Mal::Integer->new(${$_[0]} / ${$_[1]}) } ); if (@ARGV && $ARGV[0] eq "--raw") { diff --git a/impls/perl/step4_if_fn_do.pl b/impls/perl/step4_if_fn_do.pl index be0611bd5e..3958796d27 100644 --- a/impls/perl/step4_if_fn_do.pl +++ b/impls/perl/step4_if_fn_do.pl @@ -23,47 +23,49 @@ sub READ { } # eval -sub eval_ast { +sub EVAL { my($ast, $env) = @_; + + my $dbgeval = $env->get('DEBUG-EVAL'); + if ($dbgeval and $dbgeval ne $nil and $dbgeval ne $false) { + print "EVAL: " . printer::_pr_str($ast) . "\n"; + } + if ($ast->isa('Mal::Symbol')) { - return $env->get($ast); - } elsif ($ast->isa('Mal::Sequence')) { + my $val = $env->get($$ast); + die "'$$ast' not found\n" unless $val; + return $val; + } elsif ($ast->isa('Mal::Vector')) { return ref($ast)->new([ map { EVAL($_, $env) } @$ast ]); } elsif ($ast->isa('Mal::HashMap')) { return Mal::HashMap->new({ pairmap { $a => EVAL($b, $env) } %$ast }); - } else { + } elsif (! $ast->isa('Mal::List')) { return $ast; } -} - -sub EVAL { - my($ast, $env) = @_; - #print "EVAL: " . printer::_pr_str($ast) . "\n"; - if (! $ast->isa('Mal::List')) { - return eval_ast($ast, $env); - } # apply list + unless (@$ast) { return $ast; } my ($a0) = @$ast; given ($a0->isa('Mal::Symbol') ? $$a0 : $a0) { when ('def!') { my (undef, $sym, $val) = @$ast; - return $env->set($sym, EVAL($val, $env)); + return $env->set($$sym, EVAL($val, $env)); } when ('let*') { my (undef, $bindings, $body) = @$ast; my $let_env = Mal::Env->new($env); foreach my $pair (pairs @$bindings) { my ($k, $v) = @$pair; - $let_env->set($k, EVAL($v, $let_env)); + $let_env->set($$k, EVAL($v, $let_env)); } return EVAL($body, $let_env); } when ('do') { my (undef, @todo) = @$ast; - my $el = eval_ast(Mal::List->new(\@todo), $env); - return pop @$el; + my $last = pop @todo; + map { EVAL($_, $env) } @todo; + return EVAL($last, $env); } when ('if') { my (undef, $if, $then, $else) = @$ast; @@ -82,9 +84,9 @@ sub EVAL { }); } default { - my @el = @{eval_ast($ast, $env)}; - my $f = shift @el; - return &$f(@el); + my $f = EVAL($a0, $env); + my (undef, @args) = @$ast; + return &$f(map { EVAL($_, $env) } @args); } } } @@ -104,7 +106,7 @@ sub REP { # core.pl: defined using perl foreach my $n (keys %core::ns) { - $repl_env->set(Mal::Symbol->new($n), $core::ns{$n}); + $repl_env->set($n, $core::ns{$n}); } # core.mal: defined using the language itself diff --git a/impls/perl/step5_tco.pl b/impls/perl/step5_tco.pl index 2c726ecaa3..c7fd80e3e9 100644 --- a/impls/perl/step5_tco.pl +++ b/impls/perl/step5_tco.pl @@ -23,41 +23,41 @@ sub READ { } # eval -sub eval_ast { +sub EVAL { my($ast, $env) = @_; + + my $dbgeval = $env->get('DEBUG-EVAL'); + if ($dbgeval and $dbgeval ne $nil and $dbgeval ne $false) { + print "EVAL: " . printer::_pr_str($ast) . "\n"; + } + if ($ast->isa('Mal::Symbol')) { - return $env->get($ast); - } elsif ($ast->isa('Mal::Sequence')) { + my $val = $env->get($$ast); + die "'$$ast' not found\n" unless $val; + return $val; + } elsif ($ast->isa('Mal::Vector')) { return ref($ast)->new([ map { EVAL($_, $env) } @$ast ]); } elsif ($ast->isa('Mal::HashMap')) { return Mal::HashMap->new({ pairmap { $a => EVAL($b, $env) } %$ast }); - } else { + } elsif (! $ast->isa('Mal::List')) { return $ast; } -} - -sub EVAL { - my($ast, $env) = @_; - - #print "EVAL: " . printer::_pr_str($ast) . "\n"; - if (! $ast->isa('Mal::List')) { - goto &eval_ast; - } # apply list + unless (@$ast) { return $ast; } my ($a0) = @$ast; given ($a0->isa('Mal::Symbol') ? $$a0 : $a0) { when ('def!') { my (undef, $sym, $val) = @$ast; - return $env->set($sym, EVAL($val, $env)); + return $env->set($$sym, EVAL($val, $env)); } when ('let*') { my (undef, $bindings, $body) = @$ast; my $let_env = Mal::Env->new($env); foreach my $pair (pairs @$bindings) { my ($k, $v) = @$pair; - $let_env->set($k, EVAL($v, $let_env)); + $let_env->set($$k, EVAL($v, $let_env)); } @_ = ($body, $let_env); goto &EVAL; @@ -65,7 +65,7 @@ sub EVAL { when ('do') { my (undef, @todo) = @$ast; my $last = pop @todo; - eval_ast(Mal::List->new(\@todo), $env); + map { EVAL($_, $env) } @todo; @_ = ($last, $env); goto &EVAL; } @@ -88,8 +88,9 @@ sub EVAL { }); } default { - @_ = @{eval_ast($ast, $env)}; - my $f = shift; + my $f = EVAL($a0, $env); + my (undef, @args) = @$ast; + @_ = map { EVAL($_, $env) } @args; goto &$f; } } @@ -110,7 +111,7 @@ sub REP { # core.pl: defined using perl foreach my $n (keys %core::ns) { - $repl_env->set(Mal::Symbol->new($n), $core::ns{$n}); + $repl_env->set($n, $core::ns{$n}); } # core.mal: defined using the language itself diff --git a/impls/perl/step6_file.pl b/impls/perl/step6_file.pl index 631d4c59ae..46d12a809b 100644 --- a/impls/perl/step6_file.pl +++ b/impls/perl/step6_file.pl @@ -23,41 +23,41 @@ sub READ { } # eval -sub eval_ast { +sub EVAL { my($ast, $env) = @_; + + my $dbgeval = $env->get('DEBUG-EVAL'); + if ($dbgeval and $dbgeval ne $nil and $dbgeval ne $false) { + print "EVAL: " . printer::_pr_str($ast) . "\n"; + } + if ($ast->isa('Mal::Symbol')) { - return $env->get($ast); - } elsif ($ast->isa('Mal::Sequence')) { + my $val = $env->get($$ast); + die "'$$ast' not found\n" unless $val; + return $val; + } elsif ($ast->isa('Mal::Vector')) { return ref($ast)->new([ map { EVAL($_, $env) } @$ast ]); } elsif ($ast->isa('Mal::HashMap')) { return Mal::HashMap->new({ pairmap { $a => EVAL($b, $env) } %$ast }); - } else { + } elsif (! $ast->isa('Mal::List')) { return $ast; } -} - -sub EVAL { - my($ast, $env) = @_; - - #print "EVAL: " . printer::_pr_str($ast) . "\n"; - if (! $ast->isa('Mal::List')) { - goto &eval_ast; - } # apply list + unless (@$ast) { return $ast; } my ($a0) = @$ast; given ($a0->isa('Mal::Symbol') ? $$a0 : $a0) { when ('def!') { my (undef, $sym, $val) = @$ast; - return $env->set($sym, EVAL($val, $env)); + return $env->set($$sym, EVAL($val, $env)); } when ('let*') { my (undef, $bindings, $body) = @$ast; my $let_env = Mal::Env->new($env); foreach my $pair (pairs @$bindings) { my ($k, $v) = @$pair; - $let_env->set($k, EVAL($v, $let_env)); + $let_env->set($$k, EVAL($v, $let_env)); } @_ = ($body, $let_env); goto &EVAL; @@ -65,7 +65,7 @@ sub EVAL { when ('do') { my (undef, @todo) = @$ast; my $last = pop @todo; - eval_ast(Mal::List->new(\@todo), $env); + map { EVAL($_, $env) } @todo; @_ = ($last, $env); goto &EVAL; } @@ -88,8 +88,9 @@ sub EVAL { }); } default { - @_ = @{eval_ast($ast, $env)}; - my $f = shift; + my $f = EVAL($a0, $env); + my (undef, @args) = @$ast; + @_ = map { EVAL($_, $env) } @args; goto &$f; } } @@ -110,12 +111,12 @@ sub REP { # core.pl: defined using perl foreach my $n (keys %core::ns) { - $repl_env->set(Mal::Symbol->new($n), $core::ns{$n}); + $repl_env->set($n, $core::ns{$n}); } -$repl_env->set(Mal::Symbol->new('eval'), +$repl_env->set('eval', Mal::Function->new(sub { EVAL($_[0], $repl_env) })); my @_argv = map {Mal::String->new($_)} @ARGV[1..$#ARGV]; -$repl_env->set(Mal::Symbol->new('*ARGV*'), Mal::List->new(\@_argv)); +$repl_env->set('*ARGV*', Mal::List->new(\@_argv)); # core.mal: defined using the language itself REP(q[(def! not (fn* (a) (if a false true)))]); diff --git a/impls/perl/step7_quote.pl b/impls/perl/step7_quote.pl index af87a29391..2e52f77bbb 100644 --- a/impls/perl/step7_quote.pl +++ b/impls/perl/step7_quote.pl @@ -54,41 +54,41 @@ sub quasiquote { } } -sub eval_ast { +sub EVAL { my($ast, $env) = @_; + + my $dbgeval = $env->get('DEBUG-EVAL'); + if ($dbgeval and $dbgeval ne $nil and $dbgeval ne $false) { + print "EVAL: " . printer::_pr_str($ast) . "\n"; + } + if ($ast->isa('Mal::Symbol')) { - return $env->get($ast); - } elsif ($ast->isa('Mal::Sequence')) { + my $val = $env->get($$ast); + die "'$$ast' not found\n" unless $val; + return $val; + } elsif ($ast->isa('Mal::Vector')) { return ref($ast)->new([ map { EVAL($_, $env) } @$ast ]); } elsif ($ast->isa('Mal::HashMap')) { return Mal::HashMap->new({ pairmap { $a => EVAL($b, $env) } %$ast }); - } else { + } elsif (! $ast->isa('Mal::List')) { return $ast; } -} - -sub EVAL { - my($ast, $env) = @_; - - #print "EVAL: " . printer::_pr_str($ast) . "\n"; - if (! $ast->isa('Mal::List')) { - goto &eval_ast; - } # apply list + unless (@$ast) { return $ast; } my ($a0) = @$ast; given ($a0->isa('Mal::Symbol') ? $$a0 : $a0) { when ('def!') { my (undef, $sym, $val) = @$ast; - return $env->set($sym, EVAL($val, $env)); + return $env->set($$sym, EVAL($val, $env)); } when ('let*') { my (undef, $bindings, $body) = @$ast; my $let_env = Mal::Env->new($env); foreach my $pair (pairs @$bindings) { my ($k, $v) = @$pair; - $let_env->set($k, EVAL($v, $let_env)); + $let_env->set($$k, EVAL($v, $let_env)); } @_ = ($body, $let_env); goto &EVAL; @@ -96,9 +96,6 @@ sub EVAL { when ('quote') { return $ast->[1]; } - when ('quasiquoteexpand') { - return quasiquote($ast->[1]); - } when ('quasiquote') { @_ = (quasiquote($ast->[1]), $env); goto &EVAL; @@ -106,7 +103,7 @@ sub EVAL { when ('do') { my (undef, @todo) = @$ast; my $last = pop @todo; - eval_ast(Mal::List->new(\@todo), $env); + map { EVAL($_, $env) } @todo; @_ = ($last, $env); goto &EVAL; } @@ -129,8 +126,9 @@ sub EVAL { }); } default { - @_ = @{eval_ast($ast, $env)}; - my $f = shift; + my $f = EVAL($a0, $env); + my (undef, @args) = @$ast; + @_ = map { EVAL($_, $env) } @args; goto &$f; } } @@ -151,12 +149,12 @@ sub REP { # core.pl: defined using perl foreach my $n (keys %core::ns) { - $repl_env->set(Mal::Symbol->new($n), $core::ns{$n}); + $repl_env->set($n, $core::ns{$n}); } -$repl_env->set(Mal::Symbol->new('eval'), +$repl_env->set('eval', Mal::Function->new(sub { EVAL($_[0], $repl_env) })); my @_argv = map {Mal::String->new($_)} @ARGV[1..$#ARGV]; -$repl_env->set(Mal::Symbol->new('*ARGV*'), Mal::List->new(\@_argv)); +$repl_env->set('*ARGV*', Mal::List->new(\@_argv)); # core.mal: defined using the language itself REP(q[(def! not (fn* (a) (if a false true)))]); diff --git a/impls/perl/step8_macros.pl b/impls/perl/step8_macros.pl index 727d2eec7f..6301e9879a 100644 --- a/impls/perl/step8_macros.pl +++ b/impls/perl/step8_macros.pl @@ -54,70 +54,41 @@ sub quasiquote { } } -sub is_macro_call { - my ($ast, $env) = @_; - if ($ast->isa('Mal::List') && - $ast->[0]->isa("Mal::Symbol") && - $env->find($ast->[0])) { - my ($f) = $env->get($ast->[0]); - return $f->isa('Mal::Macro'); - } - return 0; -} +sub EVAL { + my($ast, $env) = @_; -sub macroexpand { - my ($ast, $env) = @_; - while (is_macro_call($ast, $env)) { - my @args = @$ast; - my $mac = $env->get(shift @args); - $ast = &$mac(@args); + my $dbgeval = $env->get('DEBUG-EVAL'); + if ($dbgeval and $dbgeval ne $nil and $dbgeval ne $false) { + print "EVAL: " . printer::_pr_str($ast) . "\n"; } - return $ast; -} - -sub eval_ast { - my($ast, $env) = @_; if ($ast->isa('Mal::Symbol')) { - return $env->get($ast); - } elsif ($ast->isa('Mal::Sequence')) { + my $val = $env->get($$ast); + die "'$$ast' not found\n" unless $val; + return $val; + } elsif ($ast->isa('Mal::Vector')) { return ref($ast)->new([ map { EVAL($_, $env) } @$ast ]); } elsif ($ast->isa('Mal::HashMap')) { return Mal::HashMap->new({ pairmap { $a => EVAL($b, $env) } %$ast }); - } else { + } elsif (! $ast->isa('Mal::List')) { return $ast; } -} - -sub EVAL { - my($ast, $env) = @_; - - #print "EVAL: " . printer::_pr_str($ast) . "\n"; - if (! $ast->isa('Mal::List')) { - goto &eval_ast; - } - @$ast or return $ast; # apply list - $ast = macroexpand($ast, $env); - if (! $ast->isa('Mal::List')) { - @_ = ($ast, $env); - goto &eval_ast; - } unless (@$ast) { return $ast; } my ($a0) = @$ast; given ($a0->isa('Mal::Symbol') ? $$a0 : $a0) { when ('def!') { my (undef, $sym, $val) = @$ast; - return $env->set($sym, EVAL($val, $env)); + return $env->set($$sym, EVAL($val, $env)); } when ('let*') { my (undef, $bindings, $body) = @$ast; my $let_env = Mal::Env->new($env); foreach my $pair (pairs @$bindings) { my ($k, $v) = @$pair; - $let_env->set($k, EVAL($v, $let_env)); + $let_env->set($$k, EVAL($v, $let_env)); } @_ = ($body, $let_env); goto &EVAL; @@ -125,25 +96,18 @@ sub EVAL { when ('quote') { return $ast->[1]; } - when ('quasiquoteexpand') { - return quasiquote($ast->[1]); - } when ('quasiquote') { @_ = (quasiquote($ast->[1]), $env); goto &EVAL; } when ('defmacro!') { my (undef, $sym, $val) = @$ast; - return $env->set($sym, Mal::Macro->new(EVAL($val, $env)->clone)); - } - when ('macroexpand') { - @_ = ($ast->[1], $env); - goto ¯oexpand; + return $env->set($$sym, Mal::Macro->new(EVAL($val, $env)->clone)); } when ('do') { my (undef, @todo) = @$ast; my $last = pop @todo; - eval_ast(Mal::List->new(\@todo), $env); + map { EVAL($_, $env) } @todo; @_ = ($last, $env); goto &EVAL; } @@ -166,8 +130,13 @@ sub EVAL { }); } default { - @_ = @{eval_ast($ast, $env)}; - my $f = shift; + my $f = EVAL($a0, $env); + my (undef, @args) = @$ast; + if ($f->isa('Mal::Macro')) { + @_ = (&$f(@args), $env); + goto &EVAL; + } + @_ = map { EVAL($_, $env) } @args; goto &$f; } } @@ -188,12 +157,12 @@ sub REP { # core.pl: defined using perl foreach my $n (keys %core::ns) { - $repl_env->set(Mal::Symbol->new($n), $core::ns{$n}); + $repl_env->set($n, $core::ns{$n}); } -$repl_env->set(Mal::Symbol->new('eval'), +$repl_env->set('eval', Mal::Function->new(sub { EVAL($_[0], $repl_env) })); my @_argv = map {Mal::String->new($_)} @ARGV[1..$#ARGV]; -$repl_env->set(Mal::Symbol->new('*ARGV*'), Mal::List->new(\@_argv)); +$repl_env->set('*ARGV*', Mal::List->new(\@_argv)); # core.mal: defined using the language itself REP(q[(def! not (fn* (a) (if a false true)))]); diff --git a/impls/perl/step9_try.pl b/impls/perl/step9_try.pl index dd1ca1430c..37d7eda227 100644 --- a/impls/perl/step9_try.pl +++ b/impls/perl/step9_try.pl @@ -15,7 +15,6 @@ use printer; use env; use core; -use interop qw(pl_to_mal); # read sub READ { @@ -55,70 +54,41 @@ sub quasiquote { } } -sub is_macro_call { - my ($ast, $env) = @_; - if ($ast->isa('Mal::List') && - $ast->[0]->isa('Mal::Symbol') && - $env->find($ast->[0])) { - my ($f) = $env->get($ast->[0]); - return $f->isa('Mal::Macro'); - } - return 0; -} +sub EVAL { + my($ast, $env) = @_; -sub macroexpand { - my ($ast, $env) = @_; - while (is_macro_call($ast, $env)) { - my @args = @$ast; - my $mac = $env->get(shift @args); - $ast = &$mac(@args); + my $dbgeval = $env->get('DEBUG-EVAL'); + if ($dbgeval and $dbgeval ne $nil and $dbgeval ne $false) { + print "EVAL: " . printer::_pr_str($ast) . "\n"; } - return $ast; -} - -sub eval_ast { - my($ast, $env) = @_; if ($ast->isa('Mal::Symbol')) { - return $env->get($ast); - } elsif ($ast->isa('Mal::Sequence')) { + my $val = $env->get($$ast); + die "'$$ast' not found\n" unless $val; + return $val; + } elsif ($ast->isa('Mal::Vector')) { return ref($ast)->new([ map { EVAL($_, $env) } @$ast ]); } elsif ($ast->isa('Mal::HashMap')) { return Mal::HashMap->new({ pairmap { $a => EVAL($b, $env) } %$ast }); - } else { + } elsif (! $ast->isa('Mal::List')) { return $ast; } -} - -sub EVAL { - my($ast, $env) = @_; - - #print "EVAL: " . printer::_pr_str($ast) . "\n"; - if (! $ast->isa('Mal::List')) { - goto &eval_ast; - } - @$ast or return $ast; # apply list - $ast = macroexpand($ast, $env); - if (! $ast->isa('Mal::List')) { - @_ = ($ast, $env); - goto &eval_ast; - } unless (@$ast) { return $ast; } my ($a0) = @$ast; given ($a0->isa('Mal::Symbol') ? $$a0 : $a0) { when ('def!') { my (undef, $sym, $val) = @$ast; - return $env->set($sym, EVAL($val, $env)); + return $env->set($$sym, EVAL($val, $env)); } when ('let*') { my (undef, $bindings, $body) = @$ast; my $let_env = Mal::Env->new($env); foreach my $pair (pairs @$bindings) { my ($k, $v) = @$pair; - $let_env->set($k, EVAL($v, $let_env)); + $let_env->set($$k, EVAL($v, $let_env)); } @_ = ($body, $let_env); goto &EVAL; @@ -126,20 +96,13 @@ sub EVAL { when ('quote') { return $ast->[1]; } - when ('quasiquoteexpand') { - return quasiquote($ast->[1]); - } when ('quasiquote') { @_ = (quasiquote($ast->[1]), $env); goto &EVAL; } when ('defmacro!') { my (undef, $sym, $val) = @$ast; - return $env->set($sym, Mal::Macro->new(EVAL($val, $env)->clone)); - } - when ('macroexpand') { - @_ = ($ast->[1], $env); - goto ¯oexpand; + return $env->set($$sym, Mal::Macro->new(EVAL($val, $env)->clone)); } when ('try*') { my (undef, $try, $catch) = @$ast; @@ -165,7 +128,7 @@ sub EVAL { when ('do') { my (undef, @todo) = @$ast; my $last = pop @todo; - eval_ast(Mal::List->new(\@todo), $env); + map { EVAL($_, $env) } @todo; @_ = ($last, $env); goto &EVAL; } @@ -188,8 +151,13 @@ sub EVAL { }); } default { - @_ = @{eval_ast($ast, $env)}; - my $f = shift; + my $f = EVAL($a0, $env); + my (undef, @args) = @$ast; + if ($f->isa('Mal::Macro')) { + @_ = (&$f(@args), $env); + goto &EVAL; + } + @_ = map { EVAL($_, $env) } @args; goto &$f; } } @@ -210,12 +178,12 @@ sub REP { # core.pl: defined using perl foreach my $n (keys %core::ns) { - $repl_env->set(Mal::Symbol->new($n), $core::ns{$n}); + $repl_env->set($n, $core::ns{$n}); } -$repl_env->set(Mal::Symbol->new('eval'), +$repl_env->set('eval', Mal::Function->new(sub { EVAL($_[0], $repl_env) })); my @_argv = map {Mal::String->new($_)} @ARGV[1..$#ARGV]; -$repl_env->set(Mal::Symbol->new('*ARGV*'), Mal::List->new(\@_argv)); +$repl_env->set('*ARGV*', Mal::List->new(\@_argv)); # core.mal: defined using the language itself REP(q[(def! not (fn* (a) (if a false true)))]); diff --git a/impls/perl/stepA_mal.pl b/impls/perl/stepA_mal.pl index f62aa5a7d8..12364e6611 100644 --- a/impls/perl/stepA_mal.pl +++ b/impls/perl/stepA_mal.pl @@ -54,70 +54,41 @@ sub quasiquote { } } -sub is_macro_call { - my ($ast, $env) = @_; - if ($ast->isa('Mal::List') && - $ast->[0]->isa('Mal::Symbol') && - $env->find($ast->[0])) { - my ($f) = $env->get($ast->[0]); - return $f->isa('Mal::Macro'); - } - return 0; -} +sub EVAL { + my($ast, $env) = @_; -sub macroexpand { - my ($ast, $env) = @_; - while (is_macro_call($ast, $env)) { - my @args = @$ast; - my $mac = $env->get(shift @args); - $ast = &$mac(@args); + my $dbgeval = $env->get('DEBUG-EVAL'); + if ($dbgeval and $dbgeval ne $nil and $dbgeval ne $false) { + print "EVAL: " . printer::_pr_str($ast) . "\n"; } - return $ast; -} - -sub eval_ast { - my($ast, $env) = @_; if ($ast->isa('Mal::Symbol')) { - return $env->get($ast); - } elsif ($ast->isa('Mal::Sequence')) { + my $val = $env->get($$ast); + die "'$$ast' not found\n" unless $val; + return $val; + } elsif ($ast->isa('Mal::Vector')) { return ref($ast)->new([ map { EVAL($_, $env) } @$ast ]); } elsif ($ast->isa('Mal::HashMap')) { return Mal::HashMap->new({ pairmap { $a => EVAL($b, $env) } %$ast }); - } else { + } elsif (! $ast->isa('Mal::List')) { return $ast; } -} - -sub EVAL { - my($ast, $env) = @_; - - #print "EVAL: " . printer::_pr_str($ast) . "\n"; - if (! $ast->isa('Mal::List')) { - goto &eval_ast; - } - @$ast or return $ast; # apply list - $ast = macroexpand($ast, $env); - if (! $ast->isa('Mal::List')) { - @_ = ($ast, $env); - goto &eval_ast; - } unless (@$ast) { return $ast; } my ($a0) = @$ast; given ($a0->isa('Mal::Symbol') ? $$a0 : $a0) { when ('def!') { my (undef, $sym, $val) = @$ast; - return $env->set($sym, EVAL($val, $env)); + return $env->set($$sym, EVAL($val, $env)); } when ('let*') { my (undef, $bindings, $body) = @$ast; my $let_env = Mal::Env->new($env); foreach my $pair (pairs @$bindings) { my ($k, $v) = @$pair; - $let_env->set($k, EVAL($v, $let_env)); + $let_env->set($$k, EVAL($v, $let_env)); } @_ = ($body, $let_env); goto &EVAL; @@ -125,20 +96,13 @@ sub EVAL { when ('quote') { return $ast->[1]; } - when ('quasiquoteexpand') { - return quasiquote($ast->[1]); - } when ('quasiquote') { @_ = (quasiquote($ast->[1]), $env); goto &EVAL; } when ('defmacro!') { my (undef, $sym, $val) = @$ast; - return $env->set($sym, Mal::Macro->new(EVAL($val, $env)->clone)); - } - when ('macroexpand') { - @_ = ($ast->[1], $env); - goto ¯oexpand; + return $env->set($$sym, Mal::Macro->new(EVAL($val, $env)->clone)); } when ('try*') { my (undef, $try, $catch) = @$ast; @@ -164,7 +128,7 @@ sub EVAL { when ('do') { my (undef, @todo) = @$ast; my $last = pop @todo; - eval_ast(Mal::List->new(\@todo), $env); + map { EVAL($_, $env) } @todo; @_ = ($last, $env); goto &EVAL; } @@ -187,8 +151,13 @@ sub EVAL { }); } default { - @_ = @{eval_ast($ast, $env)}; - my $f = shift; + my $f = EVAL($a0, $env); + my (undef, @args) = @$ast; + if ($f->isa('Mal::Macro')) { + @_ = (&$f(@args), $env); + goto &EVAL; + } + @_ = map { EVAL($_, $env) } @args; goto &$f; } } @@ -209,12 +178,12 @@ sub REP { # core.pl: defined using perl foreach my $n (keys %core::ns) { - $repl_env->set(Mal::Symbol->new($n), $core::ns{$n}); + $repl_env->set($n, $core::ns{$n}); } -$repl_env->set(Mal::Symbol->new('eval'), +$repl_env->set('eval', Mal::Function->new(sub { EVAL($_[0], $repl_env) })); my @_argv = map {Mal::String->new($_)} @ARGV[1..$#ARGV]; -$repl_env->set(Mal::Symbol->new('*ARGV*'), Mal::List->new(\@_argv)); +$repl_env->set('*ARGV*', Mal::List->new(\@_argv)); # core.mal: defined using the language itself REP(q[(def! *host-language* "perl")]); diff --git a/impls/perl6/env.pm b/impls/perl6/env.pm index c0f483726c..533e915f81 100644 --- a/impls/perl6/env.pm +++ b/impls/perl6/env.pm @@ -26,11 +26,8 @@ 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}; + return %.data{$key} if %.data{$key}; + return $.outer.get($key) if $.outer; + return 0; } diff --git a/impls/perl6/step2_eval.pl b/impls/perl6/step2_eval.pl index a2d010f91b..d4cedad890 100644 --- a/impls/perl6/step2_eval.pl +++ b/impls/perl6/step2_eval.pl @@ -8,21 +8,21 @@ ($str) return read_str($str); } -sub eval_ast ($ast, $env) { +sub eval ($ast, $env) { + + # say "EVAL: " ~ print($ast); + 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 } + 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 } } -} -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 ($func, @args) = $ast.map({ eval($_, $env) }); my $arglist = MalList(@args); return $func.apply($arglist); } diff --git a/impls/perl6/step3_env.pl b/impls/perl6/step3_env.pl index 2730211ced..cb011b42f1 100644 --- a/impls/perl6/step3_env.pl +++ b/impls/perl6/step3_env.pl @@ -9,18 +9,18 @@ ($str) return read_str($str); } -sub eval_ast ($ast, $env) { +sub eval ($ast, $env) { + + say "EVAL: " ~ print($ast) unless $env.get('DEBUG-EVAL') ~~ 0|MalNil|MalFalse; + 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 } + 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 } } -} -sub eval ($ast, $env) { - return eval_ast($ast, $env) if $ast !~~ MalList; return $ast if !$ast.elems; my ($a0, $a1, $a2, $a3) = $ast.val; @@ -36,8 +36,8 @@ ($ast, $env) return eval($a2, $new_env); } default { - my ($func, @args) = eval_ast($ast, $env).val; - return $func.apply(|@args); + my ($func, @args) = $ast.map({ eval($_, $env) }); + return $func.apply(@args); } } } diff --git a/impls/perl6/step4_if_fn_do.pl b/impls/perl6/step4_if_fn_do.pl index 0aa8d61598..b712de5951 100644 --- a/impls/perl6/step4_if_fn_do.pl +++ b/impls/perl6/step4_if_fn_do.pl @@ -10,18 +10,18 @@ ($str) return read_str($str); } -sub eval_ast ($ast, $env) { +sub eval ($ast, $env) { + + say "EVAL: " ~ print($ast) unless $env.get('DEBUG-EVAL') ~~ 0|MalNil|MalFalse; + 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 } + 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 } } -} -sub eval ($ast, $env) { - return eval_ast($ast, $env) if $ast !~~ MalList; return $ast if !$ast.elems; my ($a0, $a1, $a2, $a3) = $ast.val; @@ -37,7 +37,8 @@ ($ast, $env) return eval($a2, $new_env); } when 'do' { - return eval_ast(MalList([$ast[1..*]]), $env)[*-1]; + $ast[1..*-2].map({ eval($_, $env) }); + return eval($ast[*-1], $env); } when 'if' { return eval($a1, $env) !~~ MalNil|MalFalse @@ -51,7 +52,7 @@ ($ast, $env) }); } default { - my ($func, @args) = eval_ast($ast, $env).val; + my ($func, @args) = $ast.map({ eval($_, $env) }); return $func.apply(|@args); } } diff --git a/impls/perl6/step5_tco.pl b/impls/perl6/step5_tco.pl index 7e7cbb7eed..8c253faccb 100644 --- a/impls/perl6/step5_tco.pl +++ b/impls/perl6/step5_tco.pl @@ -10,19 +10,19 @@ ($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; + + 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; @@ -39,7 +39,7 @@ ($ast is copy, $env is copy) $ast = $a2; } when 'do' { - eval_ast(MalList([$ast[1..*-2]]), $env); + $ast[1..*-2].map({ eval($_, $env) }); $ast = $ast[*-1]; } when 'if' { @@ -59,7 +59,7 @@ ($ast is copy, $env is copy) return MalFunction($a2, $env, @binds, &fn); } default { - my ($func, @args) = eval_ast($ast, $env).val; + 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); diff --git a/impls/perl6/step6_file.pl b/impls/perl6/step6_file.pl index 8d97c1754f..7b22c1d3ba 100644 --- a/impls/perl6/step6_file.pl +++ b/impls/perl6/step6_file.pl @@ -10,19 +10,19 @@ ($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; + + 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; @@ -39,7 +39,7 @@ ($ast is copy, $env is copy) $ast = $a2; } when 'do' { - eval_ast(MalList([$ast[1..*-2]]), $env); + $ast[1..*-2].map({ eval($_, $env) }); $ast = $ast[*-1]; } when 'if' { @@ -59,7 +59,7 @@ ($ast is copy, $env is copy) return MalFunction($a2, $env, @binds, &fn); } default { - my ($func, @args) = eval_ast($ast, $env).val; + 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); diff --git a/impls/perl6/step7_quote.pl b/impls/perl6/step7_quote.pl index 8b8379f161..fbb6e8c191 100644 --- a/impls/perl6/step7_quote.pl +++ b/impls/perl6/step7_quote.pl @@ -10,16 +10,6 @@ ($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 qqLoop ($ast) { my $acc = MalList([]); for |$ast.val.reverse -> $elt { @@ -52,7 +42,17 @@ ($ast) sub eval ($ast is copy, $env is copy) { loop { - return eval_ast($ast, $env) if $ast !~~ MalList; + + 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; @@ -69,7 +69,7 @@ ($ast is copy, $env is copy) $ast = $a2; } when 'do' { - eval_ast(MalList([$ast[1..*-2]]), $env); + $ast[1..*-2].map({ eval($_, $env) }); $ast = $ast[*-1]; } when 'if' { @@ -89,10 +89,9 @@ ($ast is copy, $env is copy) return MalFunction($a2, $env, @binds, &fn); } when 'quote' { return $a1 } - when 'quasiquoteexpand' { return quasiquote($a1) } when 'quasiquote' { $ast = quasiquote($a1) } default { - my ($func, @args) = eval_ast($ast, $env).val; + 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); diff --git a/impls/perl6/step8_macros.pl b/impls/perl6/step8_macros.pl index 432d1d2e91..eb8318346c 100644 --- a/impls/perl6/step8_macros.pl +++ b/impls/perl6/step8_macros.pl @@ -10,16 +10,6 @@ ($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 qqLoop ($ast) { my $acc = MalList([]); for |$ast.val.reverse -> $elt { @@ -50,24 +40,19 @@ ($ast) } } -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; + + 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; @@ -84,7 +69,7 @@ ($ast is copy, $env is copy) $ast = $a2; } when 'do' { - eval_ast(MalList([$ast[1..*-2]]), $env); + $ast[1..*-2].map({ eval($_, $env) }); $ast = $ast[*-1]; } when 'if' { @@ -104,7 +89,6 @@ ($ast is copy, $env is copy) return MalFunction($a2, $env, @binds, &fn); } when 'quote' { return $a1 } - when 'quasiquoteexpand' { return quasiquote($a1) } when 'quasiquote' { $ast = quasiquote($a1) } when 'defmacro!' { my $func = eval($a2, $env); @@ -112,9 +96,14 @@ ($ast is copy, $env is copy) $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; + 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); diff --git a/impls/perl6/step9_try.pl b/impls/perl6/step9_try.pl index bd77f2ca20..83caa754a4 100644 --- a/impls/perl6/step9_try.pl +++ b/impls/perl6/step9_try.pl @@ -10,16 +10,6 @@ ($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 qqLoop ($ast) { my $acc = MalList([]); for |$ast.val.reverse -> $elt { @@ -50,24 +40,19 @@ ($ast) } } -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; + + 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; @@ -84,7 +69,7 @@ ($ast is copy, $env is copy) $ast = $a2; } when 'do' { - eval_ast(MalList([$ast[1..*-2]]), $env); + $ast[1..*-2].map({ eval($_, $env) }); $ast = $ast[*-1]; } when 'if' { @@ -104,7 +89,6 @@ ($ast is copy, $env is copy) return MalFunction($a2, $env, @binds, &fn); } when 'quote' { return $a1 } - when 'quasiquoteexpand' { return quasiquote($a1) } when 'quasiquote' { $ast = quasiquote($a1) } when 'defmacro!' { my $func = eval($a2, $env); @@ -112,7 +96,6 @@ ($ast is copy, $env is copy) $func.is_macro = True; return $env.set($a1.val, $func); } - when 'macroexpand' { return macroexpand($a1, $env) } when 'try*' { return eval($a1, $env); CATCH { @@ -124,7 +107,13 @@ ($ast is copy, $env is copy) } } default { - my ($func, @args) = eval_ast($ast, $env).val; + 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); diff --git a/impls/perl6/stepA_mal.pl b/impls/perl6/stepA_mal.pl index e7beec30d9..a80161301f 100644 --- a/impls/perl6/stepA_mal.pl +++ b/impls/perl6/stepA_mal.pl @@ -10,16 +10,6 @@ ($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 qqLoop ($ast) { my $acc = MalList([]); for |$ast.val.reverse -> $elt { @@ -50,24 +40,19 @@ ($ast) } } -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; + + 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; @@ -84,7 +69,7 @@ ($ast is copy, $env is copy) $ast = $a2; } when 'do' { - eval_ast(MalList([$ast[1..*-2]]), $env); + $ast[1..*-2].map({ eval($_, $env) }); $ast = $ast[*-1]; } when 'if' { @@ -104,7 +89,6 @@ ($ast is copy, $env is copy) return MalFunction($a2, $env, @binds, &fn); } when 'quote' { return $a1 } - when 'quasiquoteexpand' { return quasiquote($a1) } when 'quasiquote' { $ast = quasiquote($a1) } when 'defmacro!' { my $func = eval($a2, $env); @@ -112,7 +96,6 @@ ($ast is copy, $env is copy) $func.is_macro = True; return $env.set($a1.val, $func); } - when 'macroexpand' { return macroexpand($a1, $env) } when 'try*' { return eval($a1, $env); CATCH { @@ -124,7 +107,13 @@ ($ast is copy, $env is copy) } } default { - my ($func, @args) = eval_ast($ast, $env).val; + 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); diff --git a/impls/php/env.php b/impls/php/env.php index a660d3b9d4..839da55318 100644 --- a/impls/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/step2_eval.php b/impls/php/step2_eval.php index 7d5a822359..03135bcc96 100644 --- a/impls/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/impls/php/step3_env.php b/impls/php/step3_env.php index 4fb25bd632..3000fb08d4 100644 --- a/impls/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/impls/php/step4_if_fn_do.php b/impls/php/step4_if_fn_do.php index 2d2ab1ec01..54610a5373 100644 --- a/impls/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/impls/php/step5_tco.php b/impls/php/step5_tco.php index 65051fc34e..6ed2dc774c 100644 --- a/impls/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/impls/php/step6_file.php b/impls/php/step6_file.php index 97536767ab..6939535e33 100644 --- a/impls/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); diff --git a/impls/php/step7_quote.php b/impls/php/step7_quote.php index a3f2b1f59d..af84cef040 100644 --- a/impls/php/step7_quote.php +++ b/impls/php/step7_quote.php @@ -46,15 +46,21 @@ function quasiquote($ast) { } } -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)) { @@ -63,18 +69,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; } @@ -97,13 +95,11 @@ function MAL_EVAL($ast, $env) { break; // Continue loop (TCO) case "quote": return $ast[1]; - case "quasiquoteexpand": - return quasiquote($ast[1]); case "quasiquote": $ast = quasiquote($ast[1]); 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": @@ -119,9 +115,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/impls/php/step8_macros.php b/impls/php/step8_macros.php index 1ada35f4b9..dff99689f0 100644 --- a/impls/php/step8_macros.php +++ b/impls/php/step8_macros.php @@ -46,32 +46,21 @@ function quasiquote($ast) { } } -function is_macro_call($ast, $env) { - return _list_Q($ast) && - count($ast) >0 && - _symbol_Q($ast[0]) && - $env->find($ast[0]) && - $env->get($ast[0])->ismacro; -} +function MAL_EVAL($ast, $env) { + while (true) { -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); + $dbgenv = $env->find("DEBUG-EVAL"); + if ($dbgenv) { + $dbgeval = $env->get("DEBUG-EVAL"); + if ($dbgeval !== NULL && $dbgeval !== false) { + echo "EVAL: " . _pr_str($ast) . "\n"; + } } - 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 { + 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)) { @@ -80,24 +69,11 @@ 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); - } // apply list - $ast = macroexpand($ast, $env); - if (!_list_Q($ast)) { - return eval_ast($ast, $env); - } if ($ast->count() === 0) { return $ast; } @@ -119,8 +95,6 @@ function MAL_EVAL($ast, $env) { break; // Continue loop (TCO) case "quote": return $ast[1]; - case "quasiquoteexpand": - return quasiquote($ast[1]); case "quasiquote": $ast = quasiquote($ast[1]); break; // Continue loop (TCO) @@ -129,10 +103,8 @@ function MAL_EVAL($ast, $env) { $func = _function('MAL_EVAL', 'native', $func->ast, $func->env, $func->params); $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); + foreach ($ast->slice(1, -1) as $a) { MAL_EVAL($a, $env); } $ast = $ast[count($ast)-1]; break; // Continue loop (TCO) case "if": @@ -148,9 +120,14 @@ function MAL_EVAL($ast, $env) { 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); + $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); diff --git a/impls/php/step9_try.php b/impls/php/step9_try.php index 16927a60f1..c839bd8036 100644 --- a/impls/php/step9_try.php +++ b/impls/php/step9_try.php @@ -46,32 +46,21 @@ function quasiquote($ast) { } } -function is_macro_call($ast, $env) { - return _list_Q($ast) && - count($ast) >0 && - _symbol_Q($ast[0]) && - $env->find($ast[0]) && - $env->get($ast[0])->ismacro; -} +function MAL_EVAL($ast, $env) { + while (true) { -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); + $dbgenv = $env->find("DEBUG-EVAL"); + if ($dbgenv) { + $dbgeval = $env->get("DEBUG-EVAL"); + if ($dbgeval !== NULL && $dbgeval !== false) { + echo "EVAL: " . _pr_str($ast) . "\n"; + } } - 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 { + 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)) { @@ -80,24 +69,11 @@ 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); - } // apply list - $ast = macroexpand($ast, $env); - if (!_list_Q($ast)) { - return eval_ast($ast, $env); - } if ($ast->count() === 0) { return $ast; } @@ -119,8 +95,6 @@ function MAL_EVAL($ast, $env) { break; // Continue loop (TCO) case "quote": return $ast[1]; - case "quasiquoteexpand": - return quasiquote($ast[1]); case "quasiquote": $ast = quasiquote($ast[1]); break; // Continue loop (TCO) @@ -129,8 +103,6 @@ function MAL_EVAL($ast, $env) { $func = _function('MAL_EVAL', 'native', $func->ast, $func->env, $func->params); $func->ismacro = true; return $env->set($ast[1], $func); - case "macroexpand": - return macroexpand($ast[1], $env); case "try*": $a1 = $ast[1]; $a2 = $ast[2]; @@ -150,7 +122,7 @@ function MAL_EVAL($ast, $env) { return MAL_EVAL($a1, $env); } 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": @@ -166,9 +138,14 @@ function MAL_EVAL($ast, $env) { 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); + $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); diff --git a/impls/php/stepA_mal.php b/impls/php/stepA_mal.php index 6e57ab6445..94bf1568f7 100644 --- a/impls/php/stepA_mal.php +++ b/impls/php/stepA_mal.php @@ -47,32 +47,21 @@ function quasiquote($ast) { } } -function is_macro_call($ast, $env) { - return _list_Q($ast) && - count($ast) >0 && - _symbol_Q($ast[0]) && - $env->find($ast[0]) && - $env->get($ast[0])->ismacro; -} +function MAL_EVAL($ast, $env) { + while (true) { -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); + $dbgenv = $env->find("DEBUG-EVAL"); + if ($dbgenv) { + $dbgeval = $env->get("DEBUG-EVAL"); + if ($dbgeval !== NULL && $dbgeval !== false) { + echo "EVAL: " . _pr_str($ast) . "\n"; + } } - 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 { + 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)) { @@ -81,24 +70,11 @@ 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); - } // apply list - $ast = macroexpand($ast, $env); - if (!_list_Q($ast)) { - return eval_ast($ast, $env); - } if ($ast->count() === 0) { return $ast; } @@ -120,8 +96,6 @@ function MAL_EVAL($ast, $env) { break; // Continue loop (TCO) case "quote": return $ast[1]; - case "quasiquoteexpand": - return quasiquote($ast[1]); case "quasiquote": $ast = quasiquote($ast[1]); break; // Continue loop (TCO) @@ -130,8 +104,6 @@ function MAL_EVAL($ast, $env) { $func = _function('MAL_EVAL', 'native', $func->ast, $func->env, $func->params); $func->ismacro = true; return $env->set($ast[1], $func); - case "macroexpand": - return macroexpand($ast[1], $env); case "php*": $res = eval($ast[1]); return _to_mal($res); @@ -154,7 +126,7 @@ function MAL_EVAL($ast, $env) { return MAL_EVAL($a1, $env); } 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": @@ -172,9 +144,14 @@ function MAL_EVAL($ast, $env) { case "to-native": return _to_native($ast[1]->value, $env); default: - $el = eval_ast($ast, $env); - $f = $el[0]; - $args = array_slice($el->getArrayCopy(), 1); + $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); diff --git a/impls/picolisp/env.l b/impls/picolisp/env.l index 97581cf1c3..29bef1e422 100644 --- a/impls/picolisp/env.l +++ b/impls/picolisp/env.l @@ -15,10 +15,6 @@ (dm set> (Key Value) (put (: data) Key Value) ) -(dm find> (Key) - (or (get (: data) Key) - (and (: outer) (find> @ Key)) ) ) - (dm get> (Key) - (or (find> This Key) - (throw 'err (MAL-error (MAL-string (pack "'" Key "' not found")))) ) ) + (or (get (: data) Key) + (and (: outer) (get> @ Key)) ) ) diff --git a/impls/picolisp/step2_eval.l b/impls/picolisp/step2_eval.l index 424f4b2ddf..6f74561491 100644 --- a/impls/picolisp/step2_eval.l +++ b/impls/picolisp/step2_eval.l @@ -16,21 +16,18 @@ (/ . ((A B) (MAL-number (/ (MAL-value A) (MAL-value B))))) ) ) (de EVAL (Ast Env) - (if (= (MAL-type Ast) 'list) - (if (not (MAL-value Ast)) - Ast - (let Value (MAL-value (eval-ast Ast Env)) - (apply (car Value) (cdr Value)) ) ) - (eval-ast Ast Env) ) ) - -(de eval-ast (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 (MAL-list (mapcar '((Form) (EVAL Form Env)) Value))) + (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) ) ) ) diff --git a/impls/picolisp/step3_env.l b/impls/picolisp/step3_env.l index af3cb206f4..a061b75af3 100644 --- a/impls/picolisp/step3_env.l +++ b/impls/picolisp/step3_env.l @@ -17,14 +17,19 @@ (set> *ReplEnv '/ '((A B) (MAL-number (/ (MAL-value A) (MAL-value B))))) (de EVAL (Ast Env) - (if (= (MAL-type Ast) 'list) - (if (not (MAL-value Ast)) - Ast + (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*) @@ -34,18 +39,15 @@ Value (EVAL (pop 'Bindings) Env*)) (set> Env* Key Value) ) ) (EVAL A2 Env*) ) ) - (T (let Value (MAL-value (eval-ast Ast Env)) + (T (let Value (mapcar '((Form) (EVAL Form Env)) Ast*) (apply (car Value) (cdr Value)) ) ) ) ) ) - (eval-ast Ast Env) ) ) - -(de eval-ast (Ast Env) - (let Value (MAL-value Ast) - (case (MAL-type Ast) - (symbol (get> Env Value)) - (list (MAL-list (mapcar '((Form) (EVAL Form Env)) Value))) - (vector (MAL-vector (mapcar '((Form) (EVAL Form Env)) Value))) - (map (MAL-map (mapcar '((Form) (EVAL Form Env)) Value))) - (T Ast) ) ) ) + (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) ) diff --git a/impls/picolisp/step4_if_fn_do.l b/impls/picolisp/step4_if_fn_do.l index 8d70fdef5b..6d39ec16c5 100644 --- a/impls/picolisp/step4_if_fn_do.l +++ b/impls/picolisp/step4_if_fn_do.l @@ -16,9 +16,12 @@ (for Bind *Ns (set> *ReplEnv (car Bind) (cdr Bind))) (de EVAL (Ast Env) - (if (= (MAL-type Ast) 'list) - (if (not (MAL-value Ast)) - Ast + (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*) @@ -26,6 +29,8 @@ A2 (caddr Ast*) A3 (cadddr Ast*) ) (cond + ((not Ast*) + Ast) ((= A0* 'def!) (set> Env A1* (EVAL A2 Env)) ) ((= A0* 'let*) @@ -52,20 +57,17 @@ (let Env* (MAL-env Env Binds (rest)) (EVAL Body Env*) ) ) ) ) ) (T - (let (Ast* (MAL-value (eval-ast Ast Env)) + (let (Ast* (mapcar '((Form) (EVAL Form Env)) Ast*) Fn (MAL-value (car Ast*)) Args (cdr Ast*)) (apply Fn Args) ) ) ) ) ) - (eval-ast Ast Env) ) ) - -(de eval-ast (Ast Env) - (let Value (MAL-value Ast) - (case (MAL-type Ast) - (symbol (get> Env Value)) - (list (MAL-list (mapcar '((Form) (EVAL Form Env)) Value))) - (vector (MAL-vector (mapcar '((Form) (EVAL Form Env)) Value))) - (map (MAL-map (mapcar '((Form) (EVAL Form Env)) Value))) - (T Ast) ) ) ) + (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) ) diff --git a/impls/picolisp/step5_tco.l b/impls/picolisp/step5_tco.l index 5ae8bdc58e..067db07954 100644 --- a/impls/picolisp/step5_tco.l +++ b/impls/picolisp/step5_tco.l @@ -18,7 +18,12 @@ (de EVAL (Ast Env) (catch 'done (while t - (if (and (= (MAL-type Ast) 'list) (MAL-value Ast)) + (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*) @@ -26,6 +31,8 @@ A2 (caddr Ast*) A3 (cadddr Ast*) ) (cond + ((not Ast*) + (throw 'done Ast)) ((= A0* 'def!) (throw 'done (set> Env A1* (EVAL A2 Env))) ) ((= A0* 'let*) @@ -53,23 +60,24 @@ (EVAL Body Env*) ) ) ) ) (throw 'done (MAL-func Env Body Binds Fn)) ) ) (T - (let (Ast* (MAL-value (eval-ast Ast Env)) + (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*) ) ) ) ) ) ) - (throw 'done (eval-ast Ast Env)) ) ) ) ) - -(de eval-ast (Ast Env) - (let Value (MAL-value Ast) - (case (MAL-type Ast) - (symbol (get> Env Value)) - (list (MAL-list (mapcar '((Form) (EVAL Form Env)) Value))) - (vector (MAL-vector (mapcar '((Form) (EVAL Form Env)) Value))) - (map (MAL-map (mapcar '((Form) (EVAL Form Env)) Value))) - (T Ast) ) ) ) + (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) ) diff --git a/impls/picolisp/step6_file.l b/impls/picolisp/step6_file.l index 93254a9feb..f6c08bf439 100644 --- a/impls/picolisp/step6_file.l +++ b/impls/picolisp/step6_file.l @@ -18,7 +18,12 @@ (de EVAL (Ast Env) (catch 'done (while t - (if (and (= (MAL-type Ast) 'list) (MAL-value Ast)) + (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*) @@ -26,6 +31,8 @@ A2 (caddr Ast*) A3 (cadddr Ast*) ) (cond + ((not Ast*) + (throw 'done Ast)) ((= A0* 'def!) (throw 'done (set> Env A1* (EVAL A2 Env))) ) ((= A0* 'let*) @@ -53,23 +60,24 @@ (EVAL Body Env*) ) ) ) ) (throw 'done (MAL-func Env Body Binds Fn)) ) ) (T - (let (Ast* (MAL-value (eval-ast Ast Env)) + (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*) ) ) ) ) ) ) - (throw 'done (eval-ast Ast Env)) ) ) ) ) - -(de eval-ast (Ast Env) - (let Value (MAL-value Ast) - (case (MAL-type Ast) - (symbol (get> Env Value)) - (list (MAL-list (mapcar '((Form) (EVAL Form Env)) Value))) - (vector (MAL-vector (mapcar '((Form) (EVAL Form Env)) Value))) - (map (MAL-map (mapcar '((Form) (EVAL Form Env)) Value))) - (T Ast) ) ) ) + (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))))) diff --git a/impls/picolisp/step7_quote.l b/impls/picolisp/step7_quote.l index 72fa6450ff..77bc6223a4 100644 --- a/impls/picolisp/step7_quote.l +++ b/impls/picolisp/step7_quote.l @@ -44,7 +44,12 @@ (de EVAL (Ast Env) (catch 'done (while t - (if (and (= (MAL-type Ast) 'list) (MAL-value Ast)) + (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*) @@ -52,12 +57,12 @@ 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* 'quasiquoteexpand) - (throw 'done (quasiquote A1))) ((= A0* 'quasiquote) (setq Ast (quasiquote A1)) ) # TCO ((= A0* 'let*) @@ -85,23 +90,24 @@ (EVAL Body Env*) ) ) ) ) (throw 'done (MAL-func Env Body Binds Fn)) ) ) (T - (let (Ast* (MAL-value (eval-ast Ast Env)) + (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*) ) ) ) ) ) ) - (throw 'done (eval-ast Ast Env)) ) ) ) ) - -(de eval-ast (Ast Env) - (let Value (MAL-value Ast) - (case (MAL-type Ast) - (symbol (get> Env Value)) - (list (MAL-list (mapcar '((Form) (EVAL Form Env)) Value))) - (vector (MAL-vector (mapcar '((Form) (EVAL Form Env)) Value))) - (map (MAL-map (mapcar '((Form) (EVAL Form Env)) Value))) - (T Ast) ) ) ) + (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))))) diff --git a/impls/picolisp/step8_macros.l b/impls/picolisp/step8_macros.l index e5a2572c0f..895d202aea 100644 --- a/impls/picolisp/step8_macros.l +++ b/impls/picolisp/step8_macros.l @@ -41,29 +41,15 @@ ((map symbol) (MAL-list (list (MAL-symbol 'quote) Ast))) (T Ast))) -(de is-macro-call (Ast Env) - (when (= (MAL-type Ast) 'list) - (let A0 (car (MAL-value Ast)) - (when (= (MAL-type A0) 'symbol) - (let Value (find> Env (MAL-value A0)) - (and (isa '+Func Value) (get Value 'is-macro) T) ) ) ) ) ) - -(de macroexpand (Ast Env) - (while (is-macro-call Ast Env) - (let (Ast* (MAL-value Ast) - Macro (get (find> Env (MAL-value (car Ast*))) 'fn) - Args (cdr Ast*) ) - (setq Ast (apply (MAL-value Macro) Args)) ) ) - Ast ) - (de EVAL (Ast Env) (catch 'done (while t - (when (not (= (MAL-type Ast) 'list)) - (throw 'done (eval-ast Ast Env)) ) - (setq Ast (macroexpand Ast Env)) - (when (or (not (= (MAL-type Ast) 'list)) (not (MAL-value Ast))) - (throw 'done (eval-ast 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*) @@ -71,18 +57,16 @@ 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* 'quasiquoteexpand) - (throw 'done (quasiquote A1))) ((= A0* 'quasiquote) (setq Ast (quasiquote A1)) ) # TCO ((= A0* 'defmacro!) (throw 'done (set> Env A1* (MAL-macro (EVAL A2 Env))))) - ((= A0* 'macroexpand) - (throw 'done (macroexpand A1 Env)) ) ((= A0* 'let*) (let Env* (MAL-env Env) (for (Bindings A1* Bindings) @@ -108,22 +92,25 @@ (EVAL Body Env*) ) ) ) ) (throw 'done (MAL-func Env Body Binds Fn)) ) ) (T - (let (Ast* (MAL-value (eval-ast Ast Env)) - Fn (car Ast*) - Args (cdr Ast*) ) + (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*) ) ) ) ) ) ) ) ) ) - -(de eval-ast (Ast Env) - (let Value (MAL-value Ast) - (case (MAL-type Ast) - (symbol (get> Env Value)) - (list (MAL-list (mapcar '((Form) (EVAL Form Env)) Value))) - (vector (MAL-vector (mapcar '((Form) (EVAL Form Env)) Value))) - (map (MAL-map (mapcar '((Form) (EVAL Form Env)) Value))) - (T Ast) ) ) ) + (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))))) diff --git a/impls/picolisp/step9_try.l b/impls/picolisp/step9_try.l index 7101379a4a..1686ee8a60 100644 --- a/impls/picolisp/step9_try.l +++ b/impls/picolisp/step9_try.l @@ -41,29 +41,15 @@ ((map symbol) (MAL-list (list (MAL-symbol 'quote) Ast))) (T Ast))) -(de is-macro-call (Ast Env) - (when (= (MAL-type Ast) 'list) - (let A0 (car (MAL-value Ast)) - (when (= (MAL-type A0) 'symbol) - (let Value (find> Env (MAL-value A0)) - (and (isa '+Func Value) (get Value 'is-macro) T) ) ) ) ) ) - -(de macroexpand (Ast Env) - (while (is-macro-call Ast Env) - (let (Ast* (MAL-value Ast) - Macro (get (find> Env (MAL-value (car Ast*))) 'fn) - Args (cdr Ast*) ) - (setq Ast (apply (MAL-value Macro) Args)) ) ) - Ast ) - (de EVAL (Ast Env) (catch 'done (while t - (when (not (= (MAL-type Ast) 'list)) - (throw 'done (eval-ast Ast Env)) ) - (setq Ast (macroexpand Ast Env)) - (when (or (not (= (MAL-type Ast) 'list)) (not (MAL-value Ast))) - (throw 'done (eval-ast 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*) @@ -71,18 +57,16 @@ 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* 'quasiquoteexpand) - (throw 'done (quasiquote A1))) ((= A0* 'quasiquote) (setq Ast (quasiquote A1)) ) # TCO ((= A0* 'defmacro!) (throw 'done (set> Env A1* (MAL-macro (EVAL A2 Env))))) - ((= A0* 'macroexpand) - (throw 'done (macroexpand A1 Env)) ) ((= A0* 'try*) (let Result (catch 'err (throw 'done (EVAL A1 Env))) (if (isa '+MALError Result) @@ -121,22 +105,25 @@ (EVAL Body Env*) ) ) ) ) (throw 'done (MAL-func Env Body Binds Fn)) ) ) (T - (let (Ast* (MAL-value (eval-ast Ast Env)) - Fn (car Ast*) - Args (cdr Ast*) ) + (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*) ) ) ) ) ) ) ) ) ) - -(de eval-ast (Ast Env) - (let Value (MAL-value Ast) - (case (MAL-type Ast) - (symbol (get> Env Value)) - (list (MAL-list (mapcar '((Form) (EVAL Form Env)) Value))) - (vector (MAL-vector (mapcar '((Form) (EVAL Form Env)) Value))) - (map (MAL-map (mapcar '((Form) (EVAL Form Env)) Value))) - (T Ast) ) ) ) + (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))))) diff --git a/impls/picolisp/stepA_mal.l b/impls/picolisp/stepA_mal.l index 6e587d58ff..33c6e5da89 100644 --- a/impls/picolisp/stepA_mal.l +++ b/impls/picolisp/stepA_mal.l @@ -41,29 +41,15 @@ ((map symbol) (MAL-list (list (MAL-symbol 'quote) Ast))) (T Ast))) -(de is-macro-call (Ast Env) - (when (= (MAL-type Ast) 'list) - (let A0 (car (MAL-value Ast)) - (when (= (MAL-type A0) 'symbol) - (let Value (find> Env (MAL-value A0)) - (and (isa '+Func Value) (get Value 'is-macro) T) ) ) ) ) ) - -(de macroexpand (Ast Env) - (while (is-macro-call Ast Env) - (let (Ast* (MAL-value Ast) - Macro (get (find> Env (MAL-value (car Ast*))) 'fn) - Args (cdr Ast*) ) - (setq Ast (apply (MAL-value Macro) Args)) ) ) - Ast ) - (de EVAL (Ast Env) (catch 'done (while t - (when (not (= (MAL-type Ast) 'list)) - (throw 'done (eval-ast Ast Env)) ) - (setq Ast (macroexpand Ast Env)) - (when (or (not (= (MAL-type Ast) 'list)) (not (MAL-value Ast))) - (throw 'done (eval-ast 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*) @@ -71,18 +57,16 @@ 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* 'quasiquoteexpand) - (throw 'done (quasiquote A1))) ((= A0* 'quasiquote) (setq Ast (quasiquote A1)) ) # TCO ((= A0* 'defmacro!) (throw 'done (set> Env A1* (MAL-macro (EVAL A2 Env))))) - ((= A0* 'macroexpand) - (throw 'done (macroexpand A1 Env)) ) ((= A0* 'try*) (let Result (catch 'err (throw 'done (EVAL A1 Env))) (if (isa '+MALError Result) @@ -121,22 +105,25 @@ (EVAL Body Env*) ) ) ) ) (throw 'done (MAL-func Env Body Binds Fn)) ) ) (T - (let (Ast* (MAL-value (eval-ast Ast Env)) - Fn (car Ast*) - Args (cdr Ast*) ) + (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*) ) ) ) ) ) ) ) ) ) - -(de eval-ast (Ast Env) - (let Value (MAL-value Ast) - (case (MAL-type Ast) - (symbol (get> Env Value)) - (list (MAL-list (mapcar '((Form) (EVAL Form Env)) Value))) - (vector (MAL-vector (mapcar '((Form) (EVAL Form Env)) Value))) - (map (MAL-map (mapcar '((Form) (EVAL Form Env)) Value))) - (T Ast) ) ) ) + (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))))) diff --git a/impls/pike/Env.pmod b/impls/pike/Env.pmod index 93fcb45066..4ff72bc159 100644 --- a/impls/pike/Env.pmod +++ b/impls/pike/Env.pmod @@ -29,17 +29,11 @@ class Env return val; } - Env find(Val key) + Val get(string key) { - if(data[key.value]) return this_object(); - if(outer) return outer.find(key); + Val res = data[key]; + if(res) return res; + if(outer) return outer.get(key); return 0; } - - Val get(Val key) - { - Env found_env = find(key); - if(!found_env) throw("'" + key.value + "' not found"); - return found_env.data[key.value]; - } } diff --git a/impls/pike/step2_eval.pike b/impls/pike/step2_eval.pike index 822b224d35..b31d1297a5 100644 --- a/impls/pike/step2_eval.pike +++ b/impls/pike/step2_eval.pike @@ -8,8 +8,10 @@ Val READ(string str) return read_str(str); } -Val eval_ast(Val ast, mapping(string:function) env) +Val EVAL(Val ast, mapping(string:function) env) { + // write(({ "EVAL: ", PRINT(ast), "\n" })); + switch(ast.mal_type) { case MALTYPE_SYMBOL: @@ -17,7 +19,7 @@ Val eval_ast(Val ast, mapping(string:function) env) if(!f) throw("'" + ast.value + "' not found"); return f; case MALTYPE_LIST: - return List(map(ast.data, lambda(Val e) { return EVAL(e, env); })); + break; case MALTYPE_VECTOR: return Vector(map(ast.data, lambda(Val e) { return EVAL(e, env); })); case MALTYPE_MAP: @@ -29,16 +31,13 @@ Val eval_ast(Val ast, mapping(string:function) env) return Map(elements); default: return ast; - } -} + } -Val EVAL(Val ast, mapping(string:function) env) -{ - if(ast.mal_type != MALTYPE_LIST) return eval_ast(ast, env); if(ast.emptyp()) return ast; - Val evaled_ast = eval_ast(ast, env); - function f = evaled_ast.data[0]; - return f(@evaled_ast.data[1..]); + 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) diff --git a/impls/pike/step3_env.pike b/impls/pike/step3_env.pike index 29488866b9..42f6cd6cac 100644 --- a/impls/pike/step3_env.pike +++ b/impls/pike/step3_env.pike @@ -9,14 +9,22 @@ Val READ(string str) return read_str(str); } -Val eval_ast(Val ast, Env env) +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: - return env.get(ast); + Val key = ast.value; + Val val = env.get(ast.value); + if(!val) throw("'" + key + "' not found"); + return val; case MALTYPE_LIST: - return List(map(ast.data, lambda(Val e) { return EVAL(e, env); })); + break; case MALTYPE_VECTOR: return Vector(map(ast.data, lambda(Val e) { return EVAL(e, env); })); case MALTYPE_MAP: @@ -28,12 +36,8 @@ Val eval_ast(Val ast, Env env) return Map(elements); default: return ast; - } -} + } -Val EVAL(Val ast, Env env) -{ - if(ast.mal_type != MALTYPE_LIST) return eval_ast(ast, env); if(ast.emptyp()) return ast; if(ast.data[0].mal_type == MALTYPE_SYMBOL) { switch(ast.data[0].value) @@ -50,9 +54,10 @@ Val EVAL(Val ast, Env env) return EVAL(ast.data[2], let_env); } } - Val evaled_ast = eval_ast(ast, env); - function f = evaled_ast.data[0]; - return f(@evaled_ast.data[1..]); + 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) diff --git a/impls/pike/step4_if_fn_do.pike b/impls/pike/step4_if_fn_do.pike index 18144d7de1..90bc23434d 100644 --- a/impls/pike/step4_if_fn_do.pike +++ b/impls/pike/step4_if_fn_do.pike @@ -9,14 +9,22 @@ Val READ(string str) return read_str(str); } -Val eval_ast(Val ast, Env env) +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: - return env.get(ast); + Val key = ast.value; + Val val = env.get(ast.value); + if(!val) throw("'" + key + "' not found"); + return val; case MALTYPE_LIST: - return List(map(ast.data, lambda(Val e) { return EVAL(e, env); })); + break; case MALTYPE_VECTOR: return Vector(map(ast.data, lambda(Val e) { return EVAL(e, env); })); case MALTYPE_MAP: @@ -28,12 +36,8 @@ Val eval_ast(Val ast, Env env) return Map(elements); default: return ast; - } -} + } -Val EVAL(Val ast, Env env) -{ - if(ast.mal_type != MALTYPE_LIST) return eval_ast(ast, env); if(ast.emptyp()) return ast; if(ast.data[0].mal_type == MALTYPE_SYMBOL) { switch(ast.data[0].value) @@ -70,9 +74,10 @@ Val EVAL(Val ast, Env env) return lambda(Val ... a) { return EVAL(ast.data[2], Env(env, ast.data[1], List(a))); }; } } - Val evaled_ast = eval_ast(ast, env); - Val f = evaled_ast.data[0]; - return f(@evaled_ast.data[1..]); + 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) diff --git a/impls/pike/step5_tco.pike b/impls/pike/step5_tco.pike index e155262de1..c72183c768 100644 --- a/impls/pike/step5_tco.pike +++ b/impls/pike/step5_tco.pike @@ -9,14 +9,25 @@ Val READ(string str) return read_str(str); } -Val eval_ast(Val ast, Env env) +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: - return env.get(ast); + Val key = ast.value; + Val val = env.get(ast.value); + if(!val) throw("'" + key + "' not found"); + return val; case MALTYPE_LIST: - return List(map(ast.data, lambda(Val e) { return EVAL(e, env); })); + break; case MALTYPE_VECTOR: return Vector(map(ast.data, lambda(Val e) { return EVAL(e, env); })); case MALTYPE_MAP: @@ -28,14 +39,8 @@ Val eval_ast(Val ast, Env env) return Map(elements); default: return ast; - } -} + } -Val EVAL(Val ast, Env env) -{ - while(true) - { - if(ast.mal_type != MALTYPE_LIST) return eval_ast(ast, env); if(ast.emptyp()) return ast; if(ast.data[0].mal_type == MALTYPE_SYMBOL) { switch(ast.data[0].value) @@ -77,15 +82,16 @@ Val EVAL(Val ast, Env env) lambda(Val ... a) { return EVAL(ast.data[2], Env(env, ast.data[1], List(a))); }); } } - Val evaled_ast = eval_ast(ast, env); - Val f = evaled_ast.data[0]; + 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(@evaled_ast.data[1..]); + return f(@args); case MALTYPE_FN: ast = f.ast; - env = Env(f.env, f.params, List(evaled_ast.data[1..])); + env = Env(f.env, f.params, List(args)); continue; // TCO default: throw("Unknown function type"); diff --git a/impls/pike/step6_file.pike b/impls/pike/step6_file.pike index dcec472e1e..c5b3f3c3d1 100644 --- a/impls/pike/step6_file.pike +++ b/impls/pike/step6_file.pike @@ -9,14 +9,25 @@ Val READ(string str) return read_str(str); } -Val eval_ast(Val ast, Env env) +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: - return env.get(ast); + Val key = ast.value; + Val val = env.get(ast.value); + if(!val) throw("'" + key + "' not found"); + return val; case MALTYPE_LIST: - return List(map(ast.data, lambda(Val e) { return EVAL(e, env); })); + break; case MALTYPE_VECTOR: return Vector(map(ast.data, lambda(Val e) { return EVAL(e, env); })); case MALTYPE_MAP: @@ -28,14 +39,8 @@ Val eval_ast(Val ast, Env env) return Map(elements); default: return ast; - } -} + } -Val EVAL(Val ast, Env env) -{ - while(true) - { - if(ast.mal_type != MALTYPE_LIST) return eval_ast(ast, env); if(ast.emptyp()) return ast; if(ast.data[0].mal_type == MALTYPE_SYMBOL) { switch(ast.data[0].value) @@ -77,15 +82,16 @@ Val EVAL(Val ast, Env env) lambda(Val ... a) { return EVAL(ast.data[2], Env(env, ast.data[1], List(a))); }); } } - Val evaled_ast = eval_ast(ast, env); - Val f = evaled_ast.data[0]; + 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(@evaled_ast.data[1..]); + return f(@args); case MALTYPE_FN: ast = f.ast; - env = Env(f.env, f.params, List(evaled_ast.data[1..])); + env = Env(f.env, f.params, List(args)); continue; // TCO default: throw("Unknown function type"); diff --git a/impls/pike/step7_quote.pike b/impls/pike/step7_quote.pike index 55cba4f6bd..222c42cb0d 100644 --- a/impls/pike/step7_quote.pike +++ b/impls/pike/step7_quote.pike @@ -50,14 +50,25 @@ Val quasiquote(Val ast) } } -Val eval_ast(Val ast, Env env) +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: - return env.get(ast); + Val key = ast.value; + Val val = env.get(ast.value); + if(!val) throw("'" + key + "' not found"); + return val; case MALTYPE_LIST: - return List(map(ast.data, lambda(Val e) { return EVAL(e, env); })); + break; case MALTYPE_VECTOR: return Vector(map(ast.data, lambda(Val e) { return EVAL(e, env); })); case MALTYPE_MAP: @@ -69,14 +80,8 @@ Val eval_ast(Val ast, Env env) return Map(elements); default: return ast; - } -} + } -Val EVAL(Val ast, Env env) -{ - while(true) - { - if(ast.mal_type != MALTYPE_LIST) return eval_ast(ast, env); if(ast.emptyp()) return ast; if(ast.data[0].mal_type == MALTYPE_SYMBOL) { switch(ast.data[0].value) @@ -95,8 +100,6 @@ Val EVAL(Val ast, Env env) continue; // TCO case "quote": return ast.data[1]; - case "quasiquoteexpand": - return quasiquote(ast.data[1]); case "quasiquote": ast = quasiquote(ast.data[1]); continue; // TCO @@ -125,15 +128,16 @@ Val EVAL(Val ast, Env env) lambda(Val ... a) { return EVAL(ast.data[2], Env(env, ast.data[1], List(a))); }); } } - Val evaled_ast = eval_ast(ast, env); - Val f = evaled_ast.data[0]; + 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(@evaled_ast.data[1..]); + return f(@args); case MALTYPE_FN: ast = f.ast; - env = Env(f.env, f.params, List(evaled_ast.data[1..])); + env = Env(f.env, f.params, List(args)); continue; // TCO default: throw("Unknown function type"); diff --git a/impls/pike/step8_macros.pike b/impls/pike/step8_macros.pike index 4e051d455c..764b84dfed 100644 --- a/impls/pike/step8_macros.pike +++ b/impls/pike/step8_macros.pike @@ -50,37 +50,25 @@ Val quasiquote(Val ast) } } -bool is_macro_call(Val ast, Env env) +Val EVAL(Val ast, Env env) { - if(ast.mal_type == MALTYPE_LIST && - !ast.emptyp() && - ast.data[0].mal_type == MALTYPE_SYMBOL && - env.find(ast.data[0])) + while(true) { - Val v = env.get(ast.data[0]); - if(objectp(v) && v.macro) return true; - } - return false; -} -Val macroexpand(Val ast, Env env) -{ - while(is_macro_call(ast, env)) - { - Val macro = env.get(ast.data[0]); - ast = macro(@ast.data[1..]); - } - return ast; -} + Val dbgeval = env.get("DEBUG-EVAL"); + if(dbgeval && dbgeval.mal_type != MALTYPE_FALSE + && dbgeval.mal_type != MALTYPE_NIL) + write(({ "EVAL: ", PRINT(ast), "\n" })); -Val eval_ast(Val ast, Env env) -{ switch(ast.mal_type) { case MALTYPE_SYMBOL: - return env.get(ast); + Val key = ast.value; + Val val = env.get(ast.value); + if(!val) throw("'" + key + "' not found"); + return val; case MALTYPE_LIST: - return List(map(ast.data, lambda(Val e) { return EVAL(e, env); })); + break; case MALTYPE_VECTOR: return Vector(map(ast.data, lambda(Val e) { return EVAL(e, env); })); case MALTYPE_MAP: @@ -92,16 +80,8 @@ Val eval_ast(Val ast, Env env) return Map(elements); default: return ast; - } -} + } -Val EVAL(Val ast, Env env) -{ - while(true) - { - if(ast.mal_type != MALTYPE_LIST) return eval_ast(ast, env); - ast = macroexpand(ast, env); - if(ast.mal_type != MALTYPE_LIST) return eval_ast(ast, env); if(ast.emptyp()) return ast; if(ast.data[0].mal_type == MALTYPE_SYMBOL) { switch(ast.data[0].value) @@ -120,16 +100,12 @@ Val EVAL(Val ast, Env env) continue; // TCO case "quote": return ast.data[1]; - case "quasiquoteexpand": - return quasiquote(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 "macroexpand": - return macroexpand(ast.data[1], env); case "do": Val result; foreach(ast.data[1..(sizeof(ast.data) - 2)], Val element) @@ -155,15 +131,20 @@ Val EVAL(Val ast, Env env) lambda(Val ... a) { return EVAL(ast.data[2], Env(env, ast.data[1], List(a))); }); } } - Val evaled_ast = eval_ast(ast, env); - Val f = evaled_ast.data[0]; + Val f = EVAL(ast.data[0], env); + array(Val) args = ast.data[1..]; switch(f.mal_type) { case MALTYPE_BUILTINFN: - return f(@evaled_ast.data[1..]); + 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(evaled_ast.data[1..])); + env = Env(f.env, f.params, List(map(args, lambda(Val e) { return EVAL(e, env);}))); continue; // TCO default: throw("Unknown function type"); diff --git a/impls/pike/step9_try.pike b/impls/pike/step9_try.pike index 63d6bd9d27..6d68525070 100644 --- a/impls/pike/step9_try.pike +++ b/impls/pike/step9_try.pike @@ -50,37 +50,25 @@ Val quasiquote(Val ast) } } -bool is_macro_call(Val ast, Env env) +Val EVAL(Val ast, Env env) { - if(ast.mal_type == MALTYPE_LIST && - !ast.emptyp() && - ast.data[0].mal_type == MALTYPE_SYMBOL && - env.find(ast.data[0])) + while(true) { - Val v = env.get(ast.data[0]); - if(objectp(v) && v.macro) return true; - } - return false; -} -Val macroexpand(Val ast, Env env) -{ - while(is_macro_call(ast, env)) - { - Val macro = env.get(ast.data[0]); - ast = macro(@ast.data[1..]); - } - return ast; -} + Val dbgeval = env.get("DEBUG-EVAL"); + if(dbgeval && dbgeval.mal_type != MALTYPE_FALSE + && dbgeval.mal_type != MALTYPE_NIL) + write(({ "EVAL: ", PRINT(ast), "\n" })); -Val eval_ast(Val ast, Env env) -{ switch(ast.mal_type) { case MALTYPE_SYMBOL: - return env.get(ast); + Val key = ast.value; + Val val = env.get(ast.value); + if(!val) throw("'" + key + "' not found"); + return val; case MALTYPE_LIST: - return List(map(ast.data, lambda(Val e) { return EVAL(e, env); })); + break; case MALTYPE_VECTOR: return Vector(map(ast.data, lambda(Val e) { return EVAL(e, env); })); case MALTYPE_MAP: @@ -92,16 +80,8 @@ Val eval_ast(Val ast, Env env) return Map(elements); default: return ast; - } -} + } -Val EVAL(Val ast, Env env) -{ - while(true) - { - if(ast.mal_type != MALTYPE_LIST) return eval_ast(ast, env); - ast = macroexpand(ast, env); - if(ast.mal_type != MALTYPE_LIST) return eval_ast(ast, env); if(ast.emptyp()) return ast; if(ast.data[0].mal_type == MALTYPE_SYMBOL) { switch(ast.data[0].value) @@ -120,16 +100,12 @@ Val EVAL(Val ast, Env env) continue; // TCO case "quote": return ast.data[1]; - case "quasiquoteexpand": - return quasiquote(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 "macroexpand": - return macroexpand(ast.data[1], env); case "try*": if(ast.count() < 3) return EVAL(ast.data[1], env); if(mixed err = catch { return EVAL(ast.data[1], env); } ) @@ -168,15 +144,20 @@ Val EVAL(Val ast, Env env) lambda(Val ... a) { return EVAL(ast.data[2], Env(env, ast.data[1], List(a))); }); } } - Val evaled_ast = eval_ast(ast, env); - Val f = evaled_ast.data[0]; + Val f = EVAL(ast.data[0], env); + array(Val) args = ast.data[1..]; switch(f.mal_type) { case MALTYPE_BUILTINFN: - return f(@evaled_ast.data[1..]); + 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(evaled_ast.data[1..])); + env = Env(f.env, f.params, List(map(args, lambda(Val e) { return EVAL(e, env);}))); continue; // TCO default: throw("Unknown function type"); diff --git a/impls/pike/stepA_mal.pike b/impls/pike/stepA_mal.pike index f2a9c64a63..7c9b02acdf 100644 --- a/impls/pike/stepA_mal.pike +++ b/impls/pike/stepA_mal.pike @@ -50,37 +50,25 @@ Val quasiquote(Val ast) } } -bool is_macro_call(Val ast, Env env) +Val EVAL(Val ast, Env env) { - if(ast.mal_type == MALTYPE_LIST && - !ast.emptyp() && - ast.data[0].mal_type == MALTYPE_SYMBOL && - env.find(ast.data[0])) + while(true) { - Val v = env.get(ast.data[0]); - if(objectp(v) && v.macro) return true; - } - return false; -} -Val macroexpand(Val ast, Env env) -{ - while(is_macro_call(ast, env)) - { - Val macro = env.get(ast.data[0]); - ast = macro(@ast.data[1..]); - } - return ast; -} + Val dbgeval = env.get("DEBUG-EVAL"); + if(dbgeval && dbgeval.mal_type != MALTYPE_FALSE + && dbgeval.mal_type != MALTYPE_NIL) + write(({ "EVAL: ", PRINT(ast), "\n" })); -Val eval_ast(Val ast, Env env) -{ switch(ast.mal_type) { case MALTYPE_SYMBOL: - return env.get(ast); + Val key = ast.value; + Val val = env.get(ast.value); + if(!val) throw("'" + key + "' not found"); + return val; case MALTYPE_LIST: - return List(map(ast.data, lambda(Val e) { return EVAL(e, env); })); + break; case MALTYPE_VECTOR: return Vector(map(ast.data, lambda(Val e) { return EVAL(e, env); })); case MALTYPE_MAP: @@ -92,16 +80,8 @@ Val eval_ast(Val ast, Env env) return Map(elements); default: return ast; - } -} + } -Val EVAL(Val ast, Env env) -{ - while(true) - { - if(ast.mal_type != MALTYPE_LIST) return eval_ast(ast, env); - ast = macroexpand(ast, env); - if(ast.mal_type != MALTYPE_LIST) return eval_ast(ast, env); if(ast.emptyp()) return ast; if(ast.data[0].mal_type == MALTYPE_SYMBOL) { switch(ast.data[0].value) @@ -120,16 +100,12 @@ Val EVAL(Val ast, Env env) continue; // TCO case "quote": return ast.data[1]; - case "quasiquoteexpand": - return quasiquote(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 "macroexpand": - return macroexpand(ast.data[1], env); case "try*": if(ast.count() < 3) return EVAL(ast.data[1], env); if(mixed err = catch { return EVAL(ast.data[1], env); } ) @@ -168,15 +144,20 @@ Val EVAL(Val ast, Env env) lambda(Val ... a) { return EVAL(ast.data[2], Env(env, ast.data[1], List(a))); }); } } - Val evaled_ast = eval_ast(ast, env); - Val f = evaled_ast.data[0]; + Val f = EVAL(ast.data[0], env); + array(Val) args = ast.data[1..]; switch(f.mal_type) { case MALTYPE_BUILTINFN: - return f(@evaled_ast.data[1..]); + 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(evaled_ast.data[1..])); + env = Env(f.env, f.params, List(map(args, lambda(Val e) { return EVAL(e, env);}))); continue; // TCO default: throw("Unknown function type"); diff --git a/impls/prolog/step3_env.pl b/impls/prolog/step3_env.pl index b7518c9db5..100b31a7f0 100644 --- a/impls/prolog/step3_env.pl +++ b/impls/prolog/step3_env.pl @@ -43,10 +43,14 @@ % The eval function itself. -% Uncomment this to get a trace with environments. -%% eval(Env, Ast, _) :- -%% format("EVAL: ~F in ~V\n", [Ast, Env]), -%% fail. % Proceed with normal alternatives. +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), !, diff --git a/impls/prolog/step4_if_fn_do.pl b/impls/prolog/step4_if_fn_do.pl index 38ce02c38c..b481e639e0 100644 --- a/impls/prolog/step4_if_fn_do.pl +++ b/impls/prolog/step4_if_fn_do.pl @@ -75,10 +75,14 @@ % The eval function itself. -% Uncomment this to get a trace with environments. -%% eval(Env, Ast, _) :- -%% format("EVAL: ~F in ~V\n", [Ast, Env]), -%% fail. % Proceed with normal alternatives. +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), !, diff --git a/impls/prolog/step6_file.pl b/impls/prolog/step6_file.pl index 401ee76906..8c262cef37 100644 --- a/impls/prolog/step6_file.pl +++ b/impls/prolog/step6_file.pl @@ -75,10 +75,14 @@ % The eval function itself. -% Uncomment this to get a trace with environments. -%% eval(Env, Ast, _) :- -%% format("EVAL: ~F in ~V\n", [Ast, Env]), -%% fail. % Proceed with normal alternatives. +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), !, diff --git a/impls/prolog/step7_quote.pl b/impls/prolog/step7_quote.pl index 2a0d61fcb6..03887cb58b 100644 --- a/impls/prolog/step7_quote.pl +++ b/impls/prolog/step7_quote.pl @@ -68,10 +68,6 @@ eval_list(_, quote, Args, Res) :- !, check(Args = [Res], "quote: expects 1 argument, got ~L", [Args]). -eval_list(_, quasiquoteexpand, Args, Res) :- !, - check(Args = [X], "quasiquoteexpand: expects 1 argument, got: ~L", [Args]), - quasiquote(X, Res). - eval_list(Env, quasiquote, Args, Res) :- !, check(Args = [X], "quasiquote: expects 1 argument, got: ~L", [Args]), quasiquote(X, Y), @@ -114,10 +110,14 @@ % The eval function itself. -% Uncomment this to get a trace with environments. -%% eval(Env, Ast, _) :- -%% format("EVAL: ~F in ~V\n", [Ast, Env]), -%% fail. % Proceed with normal alternatives. +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), !, diff --git a/impls/prolog/step8_macros.pl b/impls/prolog/step8_macros.pl index ffb5de38e9..6e0099309e 100644 --- a/impls/prolog/step8_macros.pl +++ b/impls/prolog/step8_macros.pl @@ -68,10 +68,6 @@ eval_list(_, quote, Args, Res) :- !, check(Args = [Res], "quote: expects 1 argument, got ~L", [Args]). -eval_list(_, quasiquoteexpand, Args, Res) :- !, - check(Args = [X], "quasiquoteexpand: expects 1 argument, got: ~L", [Args]), - quasiquote(X, Res). - eval_list(Env, quasiquote, Args, Res) :- !, check(Args = [X], "quasiquote: expects 1 argument, got: ~L", [Args]), quasiquote(X, Y), @@ -113,19 +109,6 @@ mal_macro(Fn, Res), env_set(Env, Key, Res). -eval_list(Env, macroexpand, Args, Res) :- !, - check(Args = [X], "macroexpand: expects 1 argument, got: ~L", [Args]), - macroexpand(Env, X, Res). - -macroexpand(Env, Ast, Res) :- - list([Key | Args], Ast), - env_get(Env, Key, Macro), - mal_macro(Fn, Macro), !, - mal_fn(Goal, Fn), - call(Goal, Args, New_Ast), - macroexpand(Env, New_Ast, Res). -macroexpand(_, Ast, Ast). - % apply phase eval_list(Env, First, Rest, Res) :- @@ -142,10 +125,14 @@ % The eval function itself. -% Uncomment this to get a trace with environments. -%% eval(Env, Ast, _) :- -%% format("EVAL: ~F in ~V\n", [Ast, Env]), -%% fail. % Proceed with normal alternatives. +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), !, @@ -163,8 +150,7 @@ maplist(eval(Env), Xs, Ys), vector(Ys, Res). -eval(Env, Map, Res) :- - map_map(eval(Env), Map, Res). +eval(Env, Map, Res) :- map_map(eval(Env), Map, Res). eval(_, Anything_Else, Anything_Else). diff --git a/impls/prolog/step9_try.pl b/impls/prolog/step9_try.pl index 3c396be101..006cdc7284 100644 --- a/impls/prolog/step9_try.pl +++ b/impls/prolog/step9_try.pl @@ -68,10 +68,6 @@ eval_list(_, quote, Args, Res) :- !, check(Args = [Res], "quote: expects 1 argument, got ~L", [Args]). -eval_list(_, quasiquoteexpand, Args, Res) :- !, - check(Args = [X], "quasiquoteexpand: expects 1 argument, got: ~L", [Args]), - quasiquote(X, Res). - eval_list(Env, quasiquote, Args, Res) :- !, check(Args = [X], "quasiquote: expects 1 argument, got: ~L", [Args]), quasiquote(X, Y), @@ -126,19 +122,6 @@ mal_macro(Fn, Res), env_set(Env, Key, Res). -eval_list(Env, macroexpand, Args, Res) :- !, - check(Args = [X], "macroexpand: expects 1 argument, got: ~L", [Args]), - macroexpand(Env, X, Res). - -macroexpand(Env, Ast, Res) :- - list([Key | Args], Ast), - env_get(Env, Key, Macro), - mal_macro(Fn, Macro), !, - mal_fn(Goal, Fn), - call(Goal, Args, New_Ast), - macroexpand(Env, New_Ast, Res). -macroexpand(_, Ast, Ast). - % apply phase eval_list(Env, First, Rest, Res) :- @@ -155,10 +138,14 @@ % The eval function itself. -% Uncomment this to get a trace with environments. -%% eval(Env, Ast, _) :- -%% format("EVAL: ~F in ~V\n", [Ast, Env]), -%% fail. % Proceed with normal alternatives. +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), !, @@ -176,8 +163,7 @@ maplist(eval(Env), Xs, Ys), vector(Ys, Res). -eval(Env, Map, Res) :- - map_map(eval(Env), Map, Res). +eval(Env, Map, Res) :- map_map(eval(Env), Map, Res). eval(_, Anything_Else, Anything_Else). diff --git a/impls/prolog/stepA_mal.pl b/impls/prolog/stepA_mal.pl index 0f713d70f6..a0b27763af 100644 --- a/impls/prolog/stepA_mal.pl +++ b/impls/prolog/stepA_mal.pl @@ -68,10 +68,6 @@ eval_list(_, quote, Args, Res) :- !, check(Args = [Res], "quote: expects 1 argument, got ~L", [Args]). -eval_list(_, quasiquoteexpand, Args, Res) :- !, - check(Args = [X], "quasiquoteexpand: expects 1 argument, got: ~L", [Args]), - quasiquote(X, Res). - eval_list(Env, quasiquote, Args, Res) :- !, check(Args = [X], "quasiquote: expects 1 argument, got: ~L", [Args]), quasiquote(X, Y), @@ -126,19 +122,6 @@ mal_macro(Fn, Res), env_set(Env, Key, Res). -eval_list(Env, macroexpand, Args, Res) :- !, - check(Args = [X], "macroexpand: expects 1 argument, got: ~L", [Args]), - macroexpand(Env, X, Res). - -macroexpand(Env, Ast, Res) :- - list([Key | Args], Ast), - env_get(Env, Key, Macro), - mal_macro(Fn, Macro), !, - mal_fn(Goal, Fn), - call(Goal, Args, New_Ast), - macroexpand(Env, New_Ast, Res). -macroexpand(_, Ast, Ast). - % apply phase eval_list(Env, First, Rest, Res) :- @@ -155,10 +138,14 @@ % The eval function itself. -% Uncomment this to get a trace with environments. -%% eval(Env, Ast, _) :- -%% format("EVAL: ~F in ~V\n", [Ast, Env]), -%% fail. % Proceed with normal alternatives. +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), !, @@ -176,8 +163,7 @@ maplist(eval(Env), Xs, Ys), vector(Ys, Res). -eval(Env, Map, Res) :- - map_map(eval(Env), Map, Res). +eval(Env, Map, Res) :- map_map(eval(Env), Map, Res). eval(_, Anything_Else, Anything_Else). diff --git a/impls/ps/env.ps b/impls/ps/env.ps index f6d5b88fe46378a0f561acff02d326f78ea512e2..3d7614d04cddcadc63b5ac1b37bd662c68b4dce4 100644 GIT binary patch delta 256 zcmZvXK?=e^3`N0>Fka$sTuQ+M^a_F(7)qOJ=`b_4Gqt4@ui(~&ckqa&p>!bz5<>F+ z4|(sN+s|wBNXT}&rGOE8aF3b>beV~SL#n{xV^9+cDwPuW@&g~zg%1sjI8NuemYHcu z3`VK*?1*RHVBR-Cqg{gwd5p&k$)ebB+GWvoob+sB$7{$ zc067#wcn={$Ns{3UJ;(Ai${gI0w|3amm>hhxmRBwx2u5t2;tSkiMw*+a zEvYxoJl8cntsvIU&s0k3LvlK)zYm_Fu7IW3w#W`g;717NHmLqwHk1?pAJhYkXtZ^r z?%O}2?ECV)dvxd|=;1?mRxs-XAKA`KQGk0QH>%s-+q0l6%BaIHc>eEDJ_{{a9IoOu8M diff --git a/impls/ps/step2_eval.ps b/impls/ps/step2_eval.ps index 57bed6d92819c9b9ca44c1ed765349b766877539..48c9dc914a00d744d8eecbf92cce8c418b39b345 100644 GIT binary patch delta 399 zcmX>h@QrT+ALAqz`^f=}l9MwSbM?3skU&alfkIAdUV2G}LUBn^W?s5Na#=C5iph@| zjf9Z}6yi%Vit@`RH?WF}R&#-65{pX|;>%K#OY)2C6{;u4G3Dw*x$$X5`ML3lMMa5~ zV3oDVIx-TAGvad-3qX3zn7g%+49m$ZF0oh0%P&!=hT9Fa1#ZUVGc0oT$O14g=_eW} zfShBX5T6J1Q%Y(Y#8j9(P&zfQOu;qG(Fau`8muk8C>5w#KP9mwQ6W7QXggfBLajnt zeoS0K*Y) Ap#T5? delta 531 zcmaJ-yH3L}6qQ57fFNSvG3G820tTv%T?zwYVP>_g)FxJ)M;#|pRaJZdqi6mB)K6gH zi!ezD60*uU~JFG$UczRJ`)vzV5;UoD@|*oEeXbU z8pK!NxU}Yrh8IRMHAP{3K5)B!4VnNy}UTf!P=Tk>EE zQaHy0z=ss?k+C|XIjjE3i}qg6A%UIL$x-WU>_>QEkI3!m{nOp!1TLY{vM}D+=*GV7 z$1lB0i_+DR;Ex<){$Ku>Uq|3Y3te&DmA(XERi&0-GX7UY)3U+L5%2}9c6Qy7GY8yT z4|g|Q`7`^GFymrifE=nhmhXU&8c_nZVd;G0#iA)vBg?{8;q}Qj27`JvZ$86K@B{IH Bqf7t* diff --git a/impls/ps/step3_env.ps b/impls/ps/step3_env.ps index 0db73a2dfc53663892ab39afd7c5ba4383eb4474..89d2a8ca4d29d9f6817f99b3db7fe6e9d8f8112b 100644 GIT binary patch delta 866 zcmZuvO=}cE5M}b=&W=HlWC=kDg-OV)67z8h#zQa|yyU1}Bs9%T&(6YZ_t?|3ZrH4w zgSQ+TZ~g->fgE!X|A4>1oBzS9c6D|qz0rb(?pN=A4bR~wjYB0yS9LEom45|=sfGRuH7tLQ~3Bs4472%tQ6*hmS{Y7d%_ z%Qjb)5vFLNK*^E;(Lbl>=G>hAUSGI3fOcX*d(o%f^C8N(a63XITyLV8YhXLg7;mW* z3S~;SAnFzqjBwprC8FeUb0QN79#O@(IpEv_c!t$RK~yTmhe~(TY(KCdPDi>dQbO)S zU;pwto1-U5r05VTB|WjsfvZSqk&+J0QFAqQ{@O9i+J)M`HU4<)36IE(q+ko!d*^33 zOno%-&>wfMzs#%#*z67vu2TJHYH1la!33h)7RA>Nw0X>W0Q&yyLjAfg17EJqwmkjq z&c^i;Arpg|^2P=Kenqv3ch;6jX3RHZswmhMtJpArL`Z6O>=+1+?0ha@X5q$-TQ}BY z5v&2t^GqMt=C!D;Xfa)PPD6jK4ev^pXT&b}6Mg1CSfp`m3gLnmOa)a|fAm-8|3SmY VR?{i7|7w2ttF@8l^0)ul`wOsV>~a7A delta 773 zcmZ`%U2D`p6eaF%vqnKdmQq^evNblf;`T#9)>iSsC&ecbL~$54lkVVb5+~V(vMf^Y ztuMmpPw-vnn?J$_|A>FVdvBVsJ~$7_nVEC$$GP*lch>vS_pYj$G(r|7%wgZ%@pf+l zt}v>Php-K~)oBUDIXZGTEf=kLe^iJZzv_Yi+pSt+%TX zLKBiWSQn98?yvU(mBz4uSS3L)c=r0~3oP{^I`ZIJ7}2(I!u|4A-OtO{UoCZ&W@KQ9 z-4l}RL6e?%DxE>?DPLemY#7KqHz!bz6^q}DCOwGkj2R~9hEvuUEkkvFa3U-M{(wV zy*EHzf__?+8$me^U=M6&Ox*|9Tg@ukaqqk9S7c1XBVFL$bvHW|`qJI>8AStT=~&M$ KXy<>r-@Ly7pXK2I diff --git a/impls/ps/step4_if_fn_do.ps b/impls/ps/step4_if_fn_do.ps index 87b43cf3dbba2a7122a599ace481e6eb22df7bcc..68307fab087f51f215ba0104a63adf4c6d228c4d 100644 GIT binary patch delta 1208 zcmbtT-D(p-6lQDMB)e6qHA2zKxlo%xr7<_bR0*~gLA>xnz3_)&x|z)`Y-ZQp*|ZW$ zs9p*MohR@GM9B+?*9u89k)fmwFW&v(9W&Y9PjC46ccrJW~t9>4&a za@(j6O;C&RK2-1SY(2hr9i25akS-H2&~6OrBq8v`_klB=v2VNJP(Nm=f$~l+8bhiG z)q)y?k;laZ2wgN5Afki;X@wDqMKmL(`kbFkJpj+qIQmDvGd72a#)CXjv{ct>SYxUt z3h){43KvvCk9WcD$5Rp2H4Wti3GdXVJa)isDi~KAa{ngW#A@jx!i|ExN!~HpfvJrs zn)I11f~XAx`N!yOq(|aJL66WVqOWx1K|aH!u}gY1#GD^bBI9;X-8-heR#(+?aS8;PDRIM+eSK%#JTT zW1w84)_m8HKNrqdvLcwE+98O_GUZ2e#ma@hFM?bzS;Gc&RcGO<=jf{HCZHEY41`O$ zV#j>eV_Zx(5pl;9@k_?a8xSYEKw{ss8EkZ@prEH)559g5VGzOrI6*{xKjXNHSjw6X zoj$1#;;Jnl7ArMBJ-{xrgC2|3W7tDy2BC9iNgN#(e;MU*FIAB2mfx&QB~jHab>T?P zl-uV0t!KJ0iI^%sQ$j``UI4+#$W0Y6^;}JPXg1|hY3Xe4s*#}lZr*DDC%jxLFUzvE zdU_&BBVV)X@~Ksu*V5z%>$d!6olEz!JUV5`-`3X)wrVQjv1&DO5^f7G;7IGs;>FS5 H#lqY_A*euQ(MtXAop?3_sR{zEC17N$5UgO2w51IzybE1whuId zX0_dcJ;-&O8sM5<51VUuuTLj-B?|StRH=z&(x>)7C54J3NMfqYG>lbfGL7fgM=!Zo z@IKesiHLMI5>jh<3dkA3WZRlfXJB%I4nUsB*(^9@7ba-nfic-FsJ9 zf!rsv2Ud)A$us(NX3;;L%(|P04*K<)pJzD*HHeE)>VXxgl__-!bWKWyZ?`U;g+v*_ zz>Ky8fMutZnt2rvu(8O7aAKXXS-M)t3>J4XtZ??O5+Pi># zuZ>6E4g6kj;770SxcJWNZLl;vvGesoi?AcQ4_f7kjprtr(pf?-=XnEXJGH99Oe>KV P{4-Rf!0of$-OaUM({B{> diff --git a/impls/ps/step5_tco.ps b/impls/ps/step5_tco.ps index 5b24490e16f9e5723bb6fd4c32c09c7d07a8bb95..7a224223b2821202fecd8a37a8a7a793136524b7 100644 GIT binary patch delta 1283 zcmbtUQEL-H5GM6Zo8;05K_83{Q!(wGsHp`BSTVF(1W}|=6|u6OcYDdfWiP$k#7GFy zNAaobuMm6?@(aWtpzjKT;D7K*+}Y;ta-r=@10g#z-_CsV&1}BH$EDBpTy^Wo#se5Y z9URZ*@QOA)Rs{JOK-CX|4j4Ok9+~3HspXM!Q`Q6H?$+kxdsp$M3DQBDl*2%U@ut)5 z0PFfbFp4Ja+bwV{KcW+d#hfWLLJUlG6HMrY9^*+O3|SEe9(E}ZQPK2knV7N5X0Hsv za}`D%#C~plgjrH@Xwklx78zz^#)^qGGj*^bpRy)zLBu7)CfL0wgD_Tr1svR<%N#Qk zv7ZLawm4<-3wCY{vk*38t>Ygoi;IImGZ%X;YFKRe2@j<(= z5HlA)v`ZuGbqxrUlH(y1)5cNku{`1v`{> zOc`DP!O2f;m3qW-Or`q889}hrlqhJ5-=$j{C$1*S`jur&m+2E7*||xFSl3rYpqpa5 ocvgJU3*wu8MpVkb&e=go35(=^8F9PJ=3c-Mo?EPp8;jc9e=)F5?*IS* delta 1019 zcmah|K~ED=5YARAuyiRVq#lSk7#B*=v|yqJXov=HoIPPS&-N`{+`g@E-!_t_5w1or zPB?n=!i|Kho;-T-9~l3EKf#$-+O!zsCYzmo`^`7sd^3Bt^bO7*IX7iT#DPc+bYTM; zQQg2xc@Qal;rNR{mtP(rHenUoI#LE0UaR3&ZtGsJYu|!YzRsjFk%)JQ$(L~|qY&bV zkcozlteZsR-nG_S&JFmSaW)7-owNd>wKxKz3;N)(Q;0%lbXm}#VpF8epe5S>u4mz# zvb{YFab_Yb5rq#!LPn4(7nQeIa;0iO4;nIb-O97)PxeUV`UBi?ZaIMa&hk2=D{+!g z-B6IGK9o=WGULZxGCIQ_#oMD@tAxGw$sLY_^=K%M-I1yT1J4H?TSGy#+wl>YrW{YI zh^iez6#`|NRuJpqi@pRZii_4HDp_8&jQDF}KG*BwO8zc>oq~_o7gxBdpzg$m6<}NE zh$d@>@_OBiFZly!xlazzPTJ&TBTDN+H>@x%O{NvlQe_fLlTVi}y&@y5RRm}AMi@~~ zp3IH*%&a&+mHa>T;?tDp6t7gk^XYy3;NHN8?(SdTj$Obr_ZUxe#odaGt!-nqdGLeo z_(_;ROP&e^VWcVYAvL1@YLk;OD3nmn)bRJr8lkU98Dk>5YlUt6URYq~3tkl;d-w6g zop)*9F83P`y)}IAP18NMba`e;`U}@z9r-3QHU&?;pOY1m7eW``%`V*GarAe$o@g1U Vlz*`>Q*{$1iu(vJKF{WJe*p00Hf{g_ diff --git a/impls/ps/step6_file.ps b/impls/ps/step6_file.ps index 9173cde0e67c27e3346af2e2c065a67b3a2be0e6..fcf347318574effc3ac522ee175a3e2de4cbb508 100644 GIT binary patch delta 1361 zcmb7E-D(q25N7N4C%+ca3PxlsO}ksv)Iup(u|zFJ@rO!V5DUk3bCN7<&!)R4u@XY; zrFd1&mG9t%kQdM=(0c`;AovJgiDyo;n`~$b?#-Sv^UcgR-^}jknWOxtWi7w9U3>&h zScZ~gb9hB74oiZ3nvi!ruLj2Ey{D%5a%Q%z%#=02xW9IHYyCP#njj6NLOC>*8zW2g z8nC+S0;71P`*sz|mK)Hn!D6L8G(rqabqh?W`3~bzB6L{+2kzG?5Ruc+}_c}5mQ!3R_21Q$)uyN9$HuwBhXo^4D?w#(HlznfPSiWz)iIPMu z4J4>qL6z)UHB9ksCN_4;LCjpJmEh3D7o-lYTxRlR>bxgYB zk3QGL-?61jdBB~I3d`LH&th}@;A){{aSPP8M=YTxKa!Rly>Gd$_%-gGlB83g$Y^87 zMZ{rZN4y-Y@2UNkx1r1v`;;MEM|l zeiXk^IhWM(^ne1GyH5qYilfx+|4T1hw5uYMzBY^Tu};tspNuq!mGpw}(x%u*UJxJC z3Gp?3PUJE_r)4dZ79UJ$!6cqeD8bT`{vDW_v_Tjed~tY7ojH- z4Q*J2dQj8wOzs8|?pW>w(BqbRh$SdPQw5O*hF7b&oLau!X`4SUkuO^^(t!w9iOH2= zA_E`7fRM3*eOc47!p$ptuQ}J_b;g;%^Hsd(38lmV5S`Zr53EAqGo#IddKDWYX?T00 z`R{rL&M7M^{SdQ5ts+sl&?jUBsj@M0CW^L<>d=9@^liKHXlregR4&}bRqLh&xNS`@ zFuD@PG1c`2Y3f3G)h#i8&?T)}n7MxIeAiLTUc2NDN5Xj2m&fkNXdil>_c}I)f@n6w z1JDgQm{bw-<`Cw=i*&;XVm!&L=! zCl-wW(>h0Vvbry?(?0z?ylYK&$pM;ilboyvNlmD_5vHVWsR(GOS`v#R4=2yOA|s4d z1ZVTkF`^ndDxB|`S#c~K|3CHgW7@Iu7b@UMW*gtz*YKXberfN}2K;0n;&Cd!UXh`( zZJ;(Ee6KtH62?=KPlW_q(bt1Xye<_@kKt4 z?(EiLCA}!&E9SSNnhxTK`|xSokCg~R+g$51ejA;d;SIYqyY^&bYqkteVdwI_WXNeb TzhR|&IDAuhJY<%C6tbzm*Tzsl diff --git a/impls/ps/step7_quote.ps b/impls/ps/step7_quote.ps index c26c78870ff514f53accca2c4ade6062cda71f8c..45eef62f7d9797c74e9029aa778e8817738f0434 100644 GIT binary patch delta 1401 zcmbtT&rcIk5DpDcSbmmLK#4FKge?iSkQgEw2}D9P1QQaufNq}c>yKpFU3XtA+7Qr# z3FkSg7ykm2CMF&{nt1cz#iQ}8!Ni2KZyw!tmlQ7UrJb2?X1@7m-mhyPQtwl39V?ql zYfyoCd>y@nAET4|8pw}ZWzg@eEI(MCAwZHGMxG0(s4zjYB?qjMX@bR7#%`tnIc9pi z=3rJffF_7er4}Fwj$5=uy%2?%CqTF*4#tAx8lG^QVDxS4bm|@ybE=N|gNJQ5hp1YE zBw2j7DDZ1!vUf7Bk$}1?bv59^O=)GXWafNTa&lnQy^k?fS*5 zVA{4*mvXOivH*#}wXPdulzDa;{Mq&Ryb8Sg#pP6%2?pvRs5hcsk7GNMP|kLlY2tCW zeNK_;tDc^g_7j@;u6Mh`r-Z+IbH4wmbzBQDf7y4C@?nk9Lh@5sZh&MZMjAfqzqh=l z^fg>ARc^}L=L`?Qpo+tz#71#^Ad2e)-*F>87?F^f_~@8FqULhPG-_w3^D;A& wRONYmVp;zB=N1A@FKw)DP7@5ankm%CtA38JwhW(fMV8#)~Ka3b}FdNc=b(6W@EK4Hly|X)-(SH@}(r&CL7a;pMkQt)Ffa+a!Jf zb(n?1!7ob@gTXv=&k)V8p&Dm<($B zlv!Xifpj@+({kW)yxq06DPv9PmpEmZ7I(Ky!a3OmL1#9>zj=XKk})X@YGtevziMs~ z?=ShjcD*tsf81W|odMME%71r>>}<7c9cI-XCA;eO)AxTGdiBF(hQB5MU{iOHyTC6mx@?_FXe zg6UX%*mFIhOojPn!Ye8>r$NXa5DO7fOs8&*90?KdQ0XAxQkix~BKy!(8|C%yHR3)Qtz-?!QC#sy#iC-i{uy zo_>Vi(#t3OCA|;VdQ%wmKEwTJCQI#(iQ)HXE-$<$r*e|QuoxGX0e(Qro3jdTg-$tO zu7jhQd-x$UDKzgWpsikW9vIJF$CudwDafa62~X*la7rJ-n3lzdx{hml;t&7K$k9P4 zw&uDvmyhnS02<<6km(0qMNzB;b$pT=n3nTysC6#8oSKd=@2^#_?8*|)mdlB4C)Ldt s@KtVXTs|c86Y~!iRwfFt3Xe}7t%U6T%q>LXEgY`)-Hj>to4!=^7eg&(-v9sr diff --git a/impls/ps/step8_macros.ps b/impls/ps/step8_macros.ps index b79966804b51081d1da64f2b9c1b8ecb021136dc..07a64b050073da545499a1688a66c35680c09d74 100644 GIT binary patch delta 1556 zcmb_bOHWf#5DraiX)VRlmO=#?6B=4n9!6t8A^{;p!$L8#0dsS_J$>Nqz4i9CU>X9r zV?DpZxG`y>3pa$NE4G-Z3l_SQg)#2*%;_5oap6hs`xrucr)t2ZMU=S z7Vf(H+uXS5h-|q*EUp(IIyXQ2c;VXo^2}n44wNLfpeW4*iRZJR=QRyP`jJ1l-hSIo z-tf@bhle)rR&*#vuA4$p-Wu1FRtiL%w4MaDkZVFjhd?(hNEmrN9&56whORP;>*9fi z|0axLrA%X89^p${SBO%SJJP5WxM~^ZG!*f3d*)7Mt0YV#qcGECFKVv%M!KB0lva0; zV!4!(VOetV*0mcYy{BQdbk3TVT8eHQ_XHxR0aYQ@f-&IFMau~3ZARjbqp!W18ZLMS zapXcbUU7Bw(V&P$+QvcAMN!4N4rx8kH*mn)gI}FKS6RO>lny+}HeB=G3`amSjBM2< zY!+)6-1AQ0kuz9l;d1BGvj~TsBO;%%UJCt>iQxW)oy((fW-*XcEeD>)6S77YHbw7E zrfK-dXPgnZbmZ%3J6BeMzq?k2UI%`2dhmz67d8K!olN-9=f?woXM>zC{%sN%u1TiE zfr;{qVp0-rd>^>qOM^O^VXA3N%OvIfpbp`-Ke(lsT-2P?t&503X6my^U}iE0l2I$H zbS+*9&0z8B22N0PzOIPaf01NCT95>ONjZ712v?bgDy5bf1)$Ef3R0T{+_MkNtjG?Q z#kK5DwKwnt6q@gbyCbWCKLb;)y3b>Kzn{`+7%uzUT38+?7_77^M4eZ<+cRJbHASeCaV>n$SqV^j7d~(M1Kpsgw*UYD delta 1860 zcma)7O>7%g5LQ-e692`U*e)q)k}1SAE)?gdQk6moMMV^m6M|kqTD{nBoh9pCdv_fr zvaEo_0j|s$i38%m2`OASA&|HsaV@7@_>p>`Q^YhL3CJ(Rw zu=#Z@wO|KkOVoYOtP984h8}D{!>)(0E1R~9@1!a?t)=k`-9SBEJchwXtb!RFwRSyq zrD9t^7CV5*mWg5fE8PQj(vNA`ZUfw|ww+mdt`LB!rqjndBJaIydFwxss@ z(2!Op6O|+n+k$N8NmWGll5`>n6;I>CNC3$!Ss}gA2gmc;phD2C%y2XEKsY9c>cRS$JQg`! zWhF-3getUs+l?}BZQ;ffFFsF9sX7AL=}I@WMWh;LoRs6(6xj3OK-NRg$J>*weT8N_ z3)19+Y588u6uvKxfWny(c*Ht9!#Lxf2=++dZH`lUe7*;hpIjt(1x5tG3{YdZTDpYK zq>9?w2Hr?5OaQ)}dbY|f*O;yCfiBd@*;-j4a(5CE@Xyqf_~k|8c&H)QV;Wied=jet zWNwV(2NTn&99$h22cq3}jv(BV!j|vGwn;vmgJ3gAaq(s2|^ImZ6WGSpvRRj3>R7vaia4Efv_tGz4;m~4@(CeyM zrcCV#GmwgPjzq~$zDYMHa9W>QY?Cl6B)p(5{DvaHmtog;fppoGIGug<@?ak7`BUcv z=K&?eQug<=o2%48tD*P^F8Hn8DZf6skr3=aT^0sJ`c{dW;3Gt>Er!WbL4TzC)v z)@Sgm!tHau2l~=P4;PFN@SbMONSf=22=OnixJ1@yi}1m+eL_?q2t|GWCd2U`;{yI- zY~e?<*A~ZeCv8PT#rv}_;bC!}S^c)SioX@F;X}QIkMyT-vouQ&Zhr8c#bd4fbo{DS znCQ(#FGwERp<2E8X6baYM&()1!&l1l>#UY&4c9$inr^^L#Ok{B(Dq#J!y>ok`ScGj tqZU^ckIKt=c4Str-g@ixyH~6DUHO8}mXp)+k~Wo?%X4o;W;vJD{sp^^KAivn diff --git a/impls/ps/step9_try.ps b/impls/ps/step9_try.ps index e13f2a8a879b4d2a9663cdff2479ad0d6e422359..4e72356d254823cbe0e7a97d4cd03b3eaf0767a5 100644 GIT binary patch delta 1556 zcmb_c&rcIk5KfymrAu3=(9)Kz9SIFBDijPcB9Rm&M1l}Z4A`wO{g+6g=ESlP|Jz}s?0ogr95Os z#gMH7QO$IqDI`Hd%|a4NdO1yR?{>WrTG(}*I%X*r2Ae6Kc?2$6-qM~s4 zE)>OW|N14j*N^?vE_@$xoMAc?_S$+oSmMV}5LY8@-oB)fi2WRt^>(ZJ~g>B@Z?n zvGgV@p1|@xw=~VNz!nI!wL8X!5yf$S&Sk~K{Yc!~r60cL=l;VTpZFW3HvRx5)*elZ zCjQ`4=#M7x#1X*Ns2dNXfUc|G*Cb7s1=WBm2-&hKnFURyF1lP&1gg|6GCjIR{+DDU z801&lS delta 1833 zcma)7O>7%g5LQ+;{!i@Manm@Cr?jSVe{g<;5P=W{idv*71q78)E3IDax5<+AuD!dC z8d+9biA!%tbL7GSaYhQ<;eZ4ZQZF2OxtlE{AygO6AQ-8*P) zJL*W)G=MCo2Z1d)gz;P2`@Bgn-7xJY*j>v4TT-N>V-%@gn4TPg?noam&#YoL65Bd* zKvt-$bk~8`zT1@`JIYf_xO=h*!UF|3mILR}?|~sKPvX*aF&_SS?{r}^utOhALlQup z90HE4l5+1uQyR%+kb=C^7Gyig*j*0S3lk8YuSghYIs`DBT`Ck%1wIhHw!ceurj0A* zxQrWq>Wtz?cO`xEX~S|v6W+PG5#3}sKGbIL=X4JLEGAa^U^z}3lnXkQ94$uf3rlBL zJy;&oexAcs7lw#cs6pE`?I7~n8m_$X`ekBD<>ARrSK7WQf|g(=sVyv%96K)T%ZBf` zcs17AQ)sqxx9Pml4cBSu!ga*~%cKY3W7aWkl#gBE?Nal$*-!Pq<2{Z&I71$*5DLo` z(P?G^@0I58Tr{sOt>CNC@&w?A(U*81>de;qpf8lP*Vlq7x9AD?_niz9v>y%yuhx-5}}t> zvCLA?xt>%+vnLYv@SDWW1l~9mpKntyR;ky#hH#sT09X25*9L0EuEfdITW1Fns0pXa z3C@~?#8UK6Qm-u%mGw?ncxI>T_;NrL-!>iSu_WVr_*?1{Xa0R^`#B=4rC-KBGFkjV z%j5OJ6mBI_ct1Uh$y8>FBaf(q*V7lyE(KFNCfsPwzo+l#Muh-kB8eOMGJchL|Nk>O z%uO!GDE~t-otc;#qX_-tZTvfu!>7foC-xpkDib|yoxX>Uv}{h2*vC2(pJ@3CS%cez z7l!E)q6(fb8hfh@$E}$n)@Ii5mor!9$6|*y21?`V>>K#wY>BB(los)o(iQwGQov`C zS$t4BMT1uwJb<5S*%yb?t=t5&7mSs>WBTd}#?MQ?#_E)w0X_U|uC&Z86kNv*$CbM6 z@nvFk?S^kUHrHX$w&A$+ua;C7SPg%gJD=f=`53b$3Si`AuF~XL^dby&-L$j>B L8<@YXq_lqlp|m*p diff --git a/impls/ps/stepA_mal.ps b/impls/ps/stepA_mal.ps index 53c087478f1e52fda4924d54c1cfbaa8af787e6e..5254e4ff80df336852801d87c5e36b673560fc4e 100644 GIT binary patch delta 1605 zcmb_cOHUI~6ix}XbS&jrDW%h%2$dFN;06Zdp>&Mh1wVtdfRAQLjTphe1&dNT~%S8MEKu`$2!N{Qv|b zqp9m0#)CdTi-FxzH9}EJ7^)VB68>n*-KuVdl&0ncQPafN7LT-%J&v$}AS3D-At&Z3 z#Ygu}lqx$3D`#~h&Y~`HIN|AyoCHh|Q3i~Iv_^_Uk=}YFZaaf*W@xzJ8N$)db9m9+ z9;7Wn7S%QZfPH0yTSn~+!Yut^H9iL%V$ zA3u+uyC0kqP-UcN(p67hc^+tYoH-VaZw6NJw%>_IE)O2{dv=}ecsMX;-j+i?Tne7G z$$uIwQ?`JWA}SO_QZABw8X91FOk}H z`Ira#F4@zFL!ohe5{h9t6xs~~J`R6dN~oG7C_0otNEMWXkyRCHt4Vp8RspV%Inz|~ zz>Hs9$qlYS&k&kT*zj?<TVVIF|7S7^vo7~qt`|@7$ z-b-l-p$@na1;Mj%Be?Jn7>VFoa3hExJ8>g!1VI>e<6=ZS=e{I;?FbquxjpB1zJBL- zZ{FGdZ0AuWI%Bw6LsT7Gs|wTHgbu7h&8T{?EB6cwUyGJ89ggA0kt{}Hv6`nvIR_hAR<5z@>b~JI!=gzRSa6LuLS@wqj6-t9D z6aeFia?7iegQ?`gSDqgr)?opfj$!$wH#TtX-1Aq7L=M(m*=kG6GlZ`b zrk}K88sxJbIFMD(cJTU0V_%`!&Jxu4py`g?(1hcNBcODe4?blLE_6__F5EgPy2*LU z|6cF$$lG~>m*JEem;wB{Si(!uTzF*-uSI7q>7(MYq%YG`1JQbY!&DBq5ebXl_+FHAR3Uy|!Zk(bSfhPP}xn zzXEmTX>x+|P6FBRjl^@yG(n}+7Ov51+n($b#qUoGI=qszK7`aH{*@T#?mtiL{*Njf z$t8Rxlf}hU9KWHr(YTPo+pz>bOip7wk;-rffi2<7$;)_@Pvir(K-0aSlQ%+K{AT*$ zSa2gil*DlfpDNZ{jbh%=wC>)t}NS{vIBmC9D6k@If~mLX^SvM0J0i;rPi^9^akXz-xuY z(wPFofmuQ{?1zOH@Y!O4=QfMW_(5?Ie~aYsNn{#-D9+)p#q)u`34AM@y)?M&DwTg5 zeWlAo!&6T<{$2d>UWHoJ>H0acX==>p8mxe0lbGordXGHjwf~$~ZAWUB%P)@JwyK_C zTRfpoZryh1_b{$rxdpshn#-^wK7VEF)$RLN7T^J93%Ll}dheHRhernv{1a~a=Ix8u G!~Xyh8cw|c diff --git a/impls/python.2/env.py b/impls/python.2/env.py index 6f0e20a761..a8dd3962d3 100644 --- a/impls/python.2/env.py +++ b/impls/python.2/env.py @@ -27,23 +27,13 @@ def set(self, key: str, value: MalExpression) -> MalExpression: self._data[key] = value return value - def find(self, key: MalExpression) -> Optional["Env"]: - if str(key) in self._data: - return self + def get(self, key: str) -> Optional["Env"]: + if key in self._data: + return self._data[key] if self._outer is not None: - return self._outer.find(key) + return self._outer.get(key) return None - def get(self, key: MalExpression) -> MalExpression: - strkey = str(key) - if strkey in self._data: - return self._data[strkey] - - location = self.find(key) - if location is None: - raise MalUnknownSymbolException(strkey) - return location.get(key) - def __repr__(self) -> str: env_str = "{" for d in self._data: diff --git a/impls/python.2/step2_eval.py b/impls/python.2/step2_eval.py index 142de22434..7c2fcf9ec2 100644 --- a/impls/python.2/step2_eval.py +++ b/impls/python.2/step2_eval.py @@ -19,14 +19,13 @@ def READ(x: str) -> MalExpression: return reader.read(x) -def eval_ast(ast: MalExpression, env: Dict[str, MalFunctionCompiled]) -> MalExpression: +def EVAL(ast: MalExpression, env: Dict[str, MalFunctionCompiled]) -> MalExpression: + # print("EVAL: " + str(ast)) if isinstance(ast, MalSymbol): try: return env[str(ast)] except KeyError: raise MalUnknownSymbolException(str(ast)) - if isinstance(ast, MalList): - return MalList([EVAL(x, env) for x in ast.native()]) if isinstance(ast, MalVector): return MalVector([EVAL(x, env) for x in ast.native()]) if isinstance(ast, MalHash_map): @@ -34,17 +33,11 @@ def eval_ast(ast: MalExpression, env: Dict[str, MalFunctionCompiled]) -> MalExpr for key in ast.native(): new_dict[key] = EVAL(ast.native()[key], env) return MalHash_map(new_dict) - return ast - - -def EVAL(ast: MalExpression, env: Dict[str, MalFunctionCompiled]) -> MalExpression: if not isinstance(ast, MalList): - return eval_ast(ast, env) + return ast if len(ast.native()) == 0: return ast - eval_result = eval_ast(ast, env) - f = eval_result.native()[0] - args = eval_result.native()[1:] + f, *args = (EVAL(form, env) for form in ast.native()) return f.call(args) diff --git a/impls/python.2/step3_env.py b/impls/python.2/step3_env.py index db828c930e..02689f4f4c 100644 --- a/impls/python.2/step3_env.py +++ b/impls/python.2/step3_env.py @@ -5,7 +5,7 @@ from env import Env from mal_types import ( MalExpression, - MalSymbol, + MalBoolean, MalNil, MalSymbol, MalInvalidArgumentException, MalUnknownSymbolException, MalSyntaxException, @@ -25,11 +25,17 @@ def READ(x: str) -> MalExpression: return reader.read(x) -def eval_ast(ast: MalExpression, env: Env) -> MalExpression: +def EVAL(ast: MalExpression, env: Env) -> MalExpression: + dbgeval = env.get("DEBUG-EVAL") + if (dbgeval is not None + and not isinstance(dbgeval, MalNil) + and (not isinstance(dbgeval, MalBoolean) or dbgeval.native())): + print("EVAL: " + str(ast)) if isinstance(ast, MalSymbol): - return env.get(ast) - if isinstance(ast, MalList): - return MalList([EVAL(x, env) for x in ast.native()]) + key = str(ast) + val = env.get(key) + if val is None: raise MalUnknownSymbolException(key) + return val if isinstance(ast, MalVector): return MalVector([EVAL(x, env) for x in ast.native()]) if isinstance(ast, MalHash_map): @@ -37,13 +43,8 @@ def eval_ast(ast: MalExpression, env: Env) -> MalExpression: for key in ast.native(): new_dict[key] = EVAL(ast.native()[key], env) return MalHash_map(new_dict) - - return ast - - -def EVAL(ast: MalExpression, env: Env) -> MalExpression: if not isinstance(ast, MalList): - return eval_ast(ast, env) + return ast if len(ast.native()) == 0: return ast first = str(ast.native()[0]) @@ -65,9 +66,7 @@ def EVAL(ast: MalExpression, env: Env) -> MalExpression: let_env.set(str(bindings_list[i]), EVAL(bindings_list[i + 1], let_env)) expr = rest[1] return EVAL(expr, let_env) - evaled_ast = eval_ast(ast, env) - f = evaled_ast.native()[0] - args = evaled_ast.native()[1:] + f, *args = (EVAL(form, env) for form in ast.native()) try: return f.call(args) except AttributeError: diff --git a/impls/python.2/step4_if_fn_do.py b/impls/python.2/step4_if_fn_do.py index ae4e0b55c4..7bc6d97eb9 100644 --- a/impls/python.2/step4_if_fn_do.py +++ b/impls/python.2/step4_if_fn_do.py @@ -29,11 +29,17 @@ def READ(x: str) -> MalExpression: return reader.read(x) -def eval_ast(ast: MalExpression, env: Env) -> MalExpression: +def EVAL(ast: MalExpression, env: Env) -> MalExpression: + dbgeval = env.get("DEBUG-EVAL") + if (dbgeval is not None + and not isinstance(dbgeval, MalNil) + and (not isinstance(dbgeval, MalBoolean) or dbgeval.native())): + print("EVAL: " + str(ast)) if isinstance(ast, MalSymbol): - return env.get(ast) - if isinstance(ast, MalList): - return MalList([EVAL(x, env) for x in ast.native()]) + key = str(ast) + val = env.get(key) + if val is None: raise MalUnknownSymbolException(key) + return val if isinstance(ast, MalVector): return MalVector([EVAL(x, env) for x in ast.native()]) if isinstance(ast, MalHash_map): @@ -41,13 +47,8 @@ def eval_ast(ast: MalExpression, env: Env) -> MalExpression: for key in ast.native(): new_dict[key] = EVAL(ast.native()[key], env) return MalHash_map(new_dict) - return ast - - -def EVAL(ast: MalExpression, env: Env) -> MalExpression: - # print("EVAL: " + str(ast)) if not isinstance(ast, MalList): - return eval_ast(ast, env) + return ast if len(ast.native()) == 0: return ast first = str(ast.native()[0]) @@ -93,9 +94,7 @@ def func_body(x): return MalFunctionCompiled(func_body) - evaled_ast = eval_ast(ast, env) - f = evaled_ast.native()[0] - args = evaled_ast.native()[1:] + f, *args = (EVAL(form, env) for form in ast.native()) try: return f.call(args) except AttributeError: diff --git a/impls/python.2/step5_tco.py b/impls/python.2/step5_tco.py index 73337dd745..1b1ab21a0d 100644 --- a/impls/python.2/step5_tco.py +++ b/impls/python.2/step5_tco.py @@ -29,26 +29,28 @@ def READ(x: str) -> MalExpression: return reader.read(x) -def eval_ast(ast: MalExpression, env: Env) -> MalExpression: - if isinstance(ast, MalSymbol): - return env.get(ast) - if isinstance(ast, MalList): - return MalList([EVAL(x, env) for x in ast.native()]) - if isinstance(ast, MalVector): - return MalVector([EVAL(x, env) for x in ast.native()]) - if isinstance(ast, MalHash_map): - new_dict: Dict[str, MalExpression] = {} - for key in ast.native(): - new_dict[key] = EVAL(ast.native()[key], env) - return MalHash_map(new_dict) - return ast - - def EVAL(ast: MalExpression, env: Env) -> MalExpression: while True: + dbgeval = env.get("DEBUG-EVAL") + if (dbgeval is not None + and not isinstance(dbgeval, MalNil) + and (not isinstance(dbgeval, MalBoolean) or dbgeval.native())): + print("EVAL: " + str(ast)) ast_native = ast.native() + if isinstance(ast, MalSymbol): + key = str(ast) + val = env.get(key) + if val is None: raise MalUnknownSymbolException(key) + return val + if isinstance(ast, MalVector): + return MalVector([EVAL(x, env) for x in ast_native]) + if isinstance(ast, MalHash_map): + new_dict = {} # type: Dict[str, MalExpression] + for key in ast_native: + new_dict[key] = EVAL(ast_native[key], env) + return MalHash_map(new_dict) if not isinstance(ast, MalList): - return eval_ast(ast, env) + return ast elif len(ast_native) == 0: return ast @@ -101,16 +103,14 @@ def fn(args: List[MalExpression]) -> MalExpression: return MalFunctionRaw(fn=fn, ast=raw_ast, params=raw_params, env=env) else: - evaled_ast = eval_ast(ast, env) - f = evaled_ast.native()[0] - args = evaled_ast.native()[1:] + f, *args = (EVAL(form, env) for form in ast_native) if isinstance(f, MalFunctionRaw): ast = f.ast() env = Env( outer=f.env(), binds=f.params().native(), - exprs=evaled_ast.native()[1:], + exprs=args, ) continue elif isinstance(f, MalFunctionCompiled): diff --git a/impls/python.2/step6_file.py b/impls/python.2/step6_file.py index 832a36a757..ac6c9d6e15 100644 --- a/impls/python.2/step6_file.py +++ b/impls/python.2/step6_file.py @@ -49,26 +49,28 @@ def READ(x: str) -> MalExpression: return reader.read(x) -def eval_ast(ast: MalExpression, env: Env) -> MalExpression: - if isinstance(ast, MalSymbol): - return env.get(ast) - if isinstance(ast, MalList): - return MalList([EVAL(x, env) for x in ast.native()]) - if isinstance(ast, MalVector): - return MalVector([EVAL(x, env) for x in ast.native()]) - if isinstance(ast, MalHash_map): - new_dict = {} # type: Dict[str, MalExpression] - for key in ast.native(): - new_dict[key] = EVAL(ast.native()[key], env) - return MalHash_map(new_dict) - return ast - - def EVAL(ast: MalExpression, env: Env) -> MalExpression: while True: + dbgeval = env.get("DEBUG-EVAL") + if (dbgeval is not None + and not isinstance(dbgeval, MalNil) + and (not isinstance(dbgeval, MalBoolean) or dbgeval.native())): + print("EVAL: " + str(ast)) ast_native = ast.native() + if isinstance(ast, MalSymbol): + key = str(ast) + val = env.get(key) + if val is None: raise MalUnknownSymbolException(key) + return val + if isinstance(ast, MalVector): + return MalVector([EVAL(x, env) for x in ast_native]) + if isinstance(ast, MalHash_map): + new_dict = {} # type: Dict[str, MalExpression] + for key in ast_native: + new_dict[key] = EVAL(ast_native[key], env) + return MalHash_map(new_dict) if not isinstance(ast, MalList): - return eval_ast(ast, env) + return ast elif len(ast_native) == 0: return ast @@ -121,16 +123,14 @@ def fn(args: List[MalExpression]) -> MalExpression: return MalFunctionRaw(fn=fn, ast=raw_ast, params=raw_params, env=env) else: - evaled_ast = eval_ast(ast, env) - f = evaled_ast.native()[0] - args = evaled_ast.native()[1:] + f, *args = (EVAL(form, env) for form in ast_native) if isinstance(f, MalFunctionRaw): ast = f.ast() env = Env( outer=f.env(), binds=f.params().native(), - exprs=evaled_ast.native()[1:], + exprs=args, ) continue elif isinstance(f, MalFunctionCompiled): diff --git a/impls/python.2/step7_quote.py b/impls/python.2/step7_quote.py index ad293715cd..b441a73390 100644 --- a/impls/python.2/step7_quote.py +++ b/impls/python.2/step7_quote.py @@ -49,20 +49,6 @@ def swap(args: List[MalExpression]) -> MalExpression: def READ(x: str) -> MalExpression: return reader.read(x) -def eval_ast(ast: MalExpression, env: Env) -> MalExpression: - if isinstance(ast, MalSymbol): - return env.get(ast) - if isinstance(ast, MalList): - return MalList([EVAL(x, env) for x in ast.native()]) - if isinstance(ast, MalVector): - return MalVector([EVAL(x, env) for x in ast.native()]) - if isinstance(ast, MalHash_map): - new_dict = {} # type: Dict[str, MalExpression] - for key in ast.native(): - new_dict[key] = EVAL(ast.native()[key], env) - return MalHash_map(new_dict) - return ast - def qq_loop(acc: MalList, elt: MalExpression) -> MalList: if isinstance(elt, MalList): @@ -94,9 +80,26 @@ def quasiquote(ast: MalExpression) -> MalExpression: def EVAL(ast: MalExpression, env: Env) -> MalExpression: while True: + dbgeval = env.get("DEBUG-EVAL") + if (dbgeval is not None + and not isinstance(dbgeval, MalNil) + and (not isinstance(dbgeval, MalBoolean) or dbgeval.native())): + print("EVAL: " + str(ast)) ast_native = ast.native() + if isinstance(ast, MalSymbol): + key = str(ast) + val = env.get(key) + if val is None: raise MalUnknownSymbolException(key) + return val + if isinstance(ast, MalVector): + return MalVector([EVAL(x, env) for x in ast_native]) + if isinstance(ast, MalHash_map): + new_dict = {} # type: Dict[str, MalExpression] + for key in ast_native: + new_dict[key] = EVAL(ast_native[key], env) + return MalHash_map(new_dict) if not isinstance(ast, MalList): - return eval_ast(ast, env) + return ast elif len(ast_native) == 0: return ast @@ -154,22 +157,18 @@ def fn(args: List[MalExpression]) -> MalExpression: if isinstance(ast_native[1], MalVector) else ast_native[1] ) - elif first_str == "quasiquoteexpand": - return quasiquote(ast_native[1]) elif first_str == "quasiquote": ast = quasiquote(ast_native[1]) continue else: - evaled_ast = eval_ast(ast, env) - f = evaled_ast.native()[0] - args = evaled_ast.native()[1:] + f, *args = (EVAL(form, env) for form in ast_native) if isinstance(f, MalFunctionRaw): ast = f.ast() env = Env( outer=f.env(), binds=f.params().native(), - exprs=evaled_ast.native()[1:], + exprs=args, ) continue elif isinstance(f, MalFunctionCompiled): diff --git a/impls/python.2/step8_macros.py b/impls/python.2/step8_macros.py index 10bad332c6..d34ee0efe2 100644 --- a/impls/python.2/step8_macros.py +++ b/impls/python.2/step8_macros.py @@ -30,21 +30,6 @@ def READ(x: str) -> MalExpression: return reader.read(x) -def eval_ast(ast: MalExpression, env: Env) -> MalExpression: - if isinstance(ast, MalSymbol): - return env.get(ast) - if isinstance(ast, MalList): - return MalList([EVAL(x, env) for x in ast.native()]) - if isinstance(ast, MalVector): - return MalVector([EVAL(x, env) for x in ast.native()]) - if isinstance(ast, MalHash_map): - new_dict = {} # type: Dict[str, MalExpression] - for key in ast.native(): - new_dict[key] = EVAL(ast.native()[key], env) - return MalHash_map(new_dict) - return ast - - def qq_loop(acc: MalList, elt: MalExpression) -> MalList: if isinstance(elt, MalList): lst = elt.native() @@ -75,17 +60,31 @@ def quasiquote(ast: MalExpression) -> MalExpression: def EVAL(ast: MalExpression, env: Env) -> MalExpression: while True: - ast = macroexpand(ast, env) + dbgeval = env.get("DEBUG-EVAL") + if (dbgeval is not None + and not isinstance(dbgeval, MalNil) + and (not isinstance(dbgeval, MalBoolean) or dbgeval.native())): + print("EVAL: " + str(ast)) ast_native = ast.native() + if isinstance(ast, MalSymbol): + key = str(ast) + val = env.get(key) + if val is None: raise MalUnknownSymbolException(key) + return val + if isinstance(ast, MalVector): + return MalVector([EVAL(x, env) for x in ast_native]) + if isinstance(ast, MalHash_map): + new_dict = {} # type: Dict[str, MalExpression] + for key in ast_native: + new_dict[key] = EVAL(ast_native[key], env) + return MalHash_map(new_dict) if not isinstance(ast, MalList): - return eval_ast(ast, env) + return ast elif len(ast_native) == 0: return ast first_str = str(ast_native[0]) - if first_str == "macroexpand": - return macroexpand(ast.native()[1], env) - elif first_str == "def!": + if first_str == "def!": name: str = str(ast_native[1]) value: MalExpression = EVAL(ast_native[2], env) return env.set(name, value) @@ -146,22 +145,22 @@ def fn(args: List[MalExpression]) -> MalExpression: if isinstance(ast_native[1], MalVector) else ast_native[1] ) - elif first_str == "quasiquoteexpand": - return quasiquote(ast_native[1]) elif first_str == "quasiquote": ast = quasiquote(ast_native[1]) continue else: - evaled_ast = eval_ast(ast, env) - f = evaled_ast.native()[0] - args = evaled_ast.native()[1:] + f = EVAL(ast_native[0], env) + if isinstance(f, (MalFunctionCompiled, MalFunctionRaw)) and f.is_macro(): + ast = f.call(ast_native[1:]) + continue + args = [EVAL(ast_native[i], env) for i in range(1, len(ast_native))] if isinstance(f, MalFunctionRaw): ast = f.ast() env = Env( outer=f.env(), binds=f.params().native(), - exprs=evaled_ast.native()[1:], + exprs=args, ) continue elif isinstance(f, MalFunctionCompiled): @@ -212,37 +211,6 @@ def swap(args: List[MalExpression], env: Env) -> MalExpression: return repl_env -def is_macro_call(ast: MalExpression, env: Env) -> bool: - try: - x = env.get(ast.native()[0].native()) - try: - assert isinstance(x, MalFunctionRaw) or isinstance(x, MalFunctionCompiled) - except AssertionError: - return False - return x.is_macro() # type: ignore - except TypeError: - return False - except MalUnknownSymbolException: - return False - except AttributeError: - return False - except IndexError: - return False - - -def macroexpand(ast: MalExpression, env: Env) -> MalExpression: - while True: - if not is_macro_call(ast, env): - return ast - assert isinstance(ast, MalList) - macro_func = env.get(ast.native()[0].native()) - assert isinstance(macro_func, MalFunctionRaw) or isinstance( - macro_func, MalFunctionCompiled - ) - ast = macro_func.call(ast.native()[1:]) - continue - - if __name__ == "__main__": # repl loop eof: bool = False diff --git a/impls/python.2/step9_try.py b/impls/python.2/step9_try.py index 2e6f8327da..7ce8444475 100644 --- a/impls/python.2/step9_try.py +++ b/impls/python.2/step9_try.py @@ -24,21 +24,6 @@ def READ(x: str) -> MalExpression: return reader.read(x) -def eval_ast(ast: MalExpression, env: Env) -> MalExpression: - if isinstance(ast, MalSymbol): - return env.get(ast) - if isinstance(ast, MalList): - return MalList([EVAL(x, env) for x in ast.native()]) - if isinstance(ast, MalVector): - return MalVector([EVAL(x, env) for x in ast.native()]) - if isinstance(ast, MalHash_map): - new_dict = {} # type: Dict[str, MalExpression] - for key in ast.native(): - new_dict[key] = EVAL(ast.native()[key], env) - return MalHash_map(new_dict) - return ast - - def qq_loop(acc: MalList, elt: MalExpression) -> MalList: if isinstance(elt, MalList): lst = elt.native() @@ -69,17 +54,31 @@ def quasiquote(ast: MalExpression) -> MalExpression: def EVAL(ast: MalExpression, env: Env) -> MalExpression: while True: - ast = macroexpand(ast, env) + dbgeval = env.get("DEBUG-EVAL") + if (dbgeval is not None + and not isinstance(dbgeval, MalNil) + and (not isinstance(dbgeval, MalBoolean) or dbgeval.native())): + print("EVAL: " + str(ast)) ast_native = ast.native() + if isinstance(ast, MalSymbol): + key = str(ast) + val = env.get(key) + if val is None: raise MalUnknownSymbolException(key) + return val + if isinstance(ast, MalVector): + return MalVector([EVAL(x, env) for x in ast_native]) + if isinstance(ast, MalHash_map): + new_dict = {} # type: Dict[str, MalExpression] + for key in ast_native: + new_dict[key] = EVAL(ast_native[key], env) + return MalHash_map(new_dict) if not isinstance(ast, MalList): - return eval_ast(ast, env) + return ast elif len(ast_native) == 0: return ast first_str = str(ast_native[0]) - if first_str == "macroexpand": - return macroexpand(ast.native()[1], env) - elif first_str == "def!": + if first_str == "def!": name: str = str(ast_native[1]) value: MalExpression = EVAL(ast_native[2], env) return env.set(name, value) @@ -140,8 +139,6 @@ def fn(args: List[MalExpression]) -> MalExpression: if isinstance(ast_native[1], MalVector) else ast_native[1] ) - elif first_str == "quasiquoteexpand": - return quasiquote(ast_native[1]) elif first_str == "quasiquote": ast = quasiquote(ast_native[1]) continue @@ -165,16 +162,18 @@ def fn(args: List[MalExpression]) -> MalExpression: ast = catch_block.native()[2] continue else: - evaled_ast = eval_ast(ast, env) - f = evaled_ast.native()[0] - args = evaled_ast.native()[1:] + f = EVAL(ast_native[0], env) + if isinstance(f, (MalFunctionCompiled, MalFunctionRaw)) and f.is_macro(): + ast = f.call(ast_native[1:]) + continue + args = [EVAL(ast_native[i], env) for i in range(1, len(ast_native))] if isinstance(f, MalFunctionRaw): ast = f.ast() env = Env( outer=f.env(), binds=f.params().native(), - exprs=evaled_ast.native()[1:], + exprs=args, ) continue elif isinstance(f, MalFunctionCompiled): @@ -226,31 +225,6 @@ def swap(args: List[MalExpression], env: Env) -> MalExpression: return repl_env -def is_macro_call(ast: MalExpression, env: Env) -> bool: - try: - x = env.get(ast.native()[0].native()) - try: - assert isinstance(x, MalFunctionRaw) or isinstance(x, MalFunctionCompiled) - except AssertionError: - return False - return x.is_macro() # type: ignore - except (TypeError, MalUnknownSymbolException, AttributeError, IndexError, KeyError): - return False - - -def macroexpand(ast: MalExpression, env: Env) -> MalExpression: - while True: - if not is_macro_call(ast, env): - return ast - assert isinstance(ast, MalList) - macro_func = env.get(ast.native()[0].native()) - assert isinstance(macro_func, MalFunctionRaw) or isinstance( - macro_func, MalFunctionCompiled - ) - ast = macro_func.call(ast.native()[1:]) - continue - - def rep_handling_exceptions(line: str, repl_env: Env) -> str: try: return rep(line, repl_env) diff --git a/impls/python.2/stepA_mal.py b/impls/python.2/stepA_mal.py index 0cbb09f4a3..065b10e121 100644 --- a/impls/python.2/stepA_mal.py +++ b/impls/python.2/stepA_mal.py @@ -27,21 +27,6 @@ def READ(x: str) -> MalExpression: return reader.read(x) -def eval_ast(ast: MalExpression, env: Env) -> MalExpression: - if isinstance(ast, MalSymbol): - return env.get(ast) - if isinstance(ast, MalList): - return MalList([EVAL(x, env) for x in ast.native()]) - if isinstance(ast, MalVector): - return MalVector([EVAL(x, env) for x in ast.native()]) - if isinstance(ast, MalHash_map): - new_dict = {} # type: Dict[str, MalExpression] - for key in ast.native(): - new_dict[key] = EVAL(ast.native()[key], env) - return MalHash_map(new_dict) - return ast - - def qq_loop(acc: MalList, elt: MalExpression) -> MalList: if isinstance(elt, MalList): lst = elt.native() @@ -72,18 +57,31 @@ def quasiquote(ast: MalExpression) -> MalExpression: def EVAL(ast: MalExpression, env: Env) -> MalExpression: while True: - # print("EVAL: " + str(ast)) - ast = macroexpand(ast, env) + dbgeval = env.get("DEBUG-EVAL") + if (dbgeval is not None + and not isinstance(dbgeval, MalNil) + and (not isinstance(dbgeval, MalBoolean) or dbgeval.native())): + print("EVAL: " + str(ast)) ast_native = ast.native() + if isinstance(ast, MalSymbol): + key = str(ast) + val = env.get(key) + if val is None: raise MalUnknownSymbolException(key) + return val + if isinstance(ast, MalVector): + return MalVector([EVAL(x, env) for x in ast_native]) + if isinstance(ast, MalHash_map): + new_dict = {} # type: Dict[str, MalExpression] + for key in ast_native: + new_dict[key] = EVAL(ast_native[key], env) + return MalHash_map(new_dict) if not isinstance(ast, MalList): - return eval_ast(ast, env) + return ast elif len(ast_native) == 0: return ast first_str = str(ast_native[0]) - if first_str == "macroexpand": - return macroexpand(ast.native()[1], env) - elif first_str == "def!": + if first_str == "def!": name: str = str(ast_native[1]) value: MalExpression = EVAL(ast_native[2], env) return env.set(name, value) @@ -144,8 +142,6 @@ def fn(args: List[MalExpression]) -> MalExpression: if isinstance(ast_native[1], MalVector) else ast_native[1] ) - elif first_str == "quasiquoteexpand": - return quasiquote(ast_native[1]) elif first_str == "quasiquote": ast = quasiquote(ast_native[1]) continue @@ -169,16 +165,18 @@ def fn(args: List[MalExpression]) -> MalExpression: ast = catch_block.native()[2] continue else: - evaled_ast = eval_ast(ast, env) - f = evaled_ast.native()[0] - args = evaled_ast.native()[1:] + f = EVAL(ast_native[0], env) + if isinstance(f, (MalFunctionCompiled, MalFunctionRaw)) and f.is_macro(): + ast = f.call(ast_native[1:]) + continue + args = [EVAL(ast_native[i], env) for i in range(1, len(ast_native))] if isinstance(f, MalFunctionRaw): ast = f.ast() env = Env( outer=f.env(), binds=f.params().native(), - exprs=evaled_ast.native()[1:], + exprs=args, ) continue elif isinstance(f, MalFunctionCompiled): @@ -224,39 +222,6 @@ def eval_func(args: List[MalExpression], env: Env) -> MalExpression: return env -def is_macro_call(ast: MalExpression, env: Env) -> bool: - try: - x = env.get(ast.native()[0].native()) - try: - assert isinstance(x, MalFunctionRaw) or isinstance(x, MalFunctionCompiled) - except AssertionError: - return False - return x.is_macro() # type: ignore - except TypeError: - return False - except MalUnknownSymbolException: - return False - except AttributeError: - return False - except IndexError: - return False - except KeyError: - return False - - -def macroexpand(ast: MalExpression, env: Env) -> MalExpression: - while True: - if not is_macro_call(ast, env): - return ast - assert isinstance(ast, MalList) - macro_func = env.get(ast.native()[0].native()) - assert isinstance(macro_func, MalFunctionRaw) or isinstance( - macro_func, MalFunctionCompiled - ) - ast = macro_func.call(ast.native()[1:]) - continue - - def rep_handling_exceptions(line: str, repl_env: Env) -> str: try: return rep(line, repl_env) diff --git a/impls/python/env.py b/impls/python/env.py index 4cd8e0574d..d2efb88d5b 100644 --- a/impls/python/env.py +++ b/impls/python/env.py @@ -26,3 +26,7 @@ def get(self, key): env = self.find(key) if not env: raise Exception("'" + key + "' not found") return env.data[key] + + def get_or_nil(self, key): + env = self.find(key) + if env: return env.data[key] diff --git a/impls/python/step2_eval.py b/impls/python/step2_eval.py index b2f17f1822..8a40d836c2 100644 --- a/impls/python/step2_eval.py +++ b/impls/python/step2_eval.py @@ -8,38 +8,34 @@ def READ(str): return reader.read_str(str) # eval -def eval_ast(ast, env): +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._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): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) - else: + elif not types._list_Q(ast): 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) + else: # apply list if len(ast) == 0: return ast - el = eval_ast(ast, env) - f = el[0] - return f(*el[1:]) + f = EVAL(ast[0], env) + args = ast[1:] + return f(*(EVAL(a, env) for a in args)) # print def PRINT(exp): return printer._pr_str(exp) # repl -repl_env = {} +repl_env = {} def REP(str): return PRINT(EVAL(READ(str), repl_env)) diff --git a/impls/python/step3_env.py b/impls/python/step3_env.py index 1496305795..73f9699e2d 100644 --- a/impls/python/step3_env.py +++ b/impls/python/step3_env.py @@ -9,22 +9,20 @@ def READ(str): return reader.read_str(str) # eval -def eval_ast(ast, env): +def EVAL(ast, env): + dbgeval = env.get_or_nil('DEBUG-EVAL') + 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._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): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) - else: + elif not types._list_Q(ast): 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) + else: # apply list if len(ast) == 0: return ast @@ -41,9 +39,9 @@ def EVAL(ast, env): 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:]) + f = EVAL(a0, env) + args = ast[1:] + return f(*(EVAL(a, env) for a in args)) # print def PRINT(exp): diff --git a/impls/python/step4_if_fn_do.py b/impls/python/step4_if_fn_do.py index 3567a14cc9..e04e98e5ef 100644 --- a/impls/python/step4_if_fn_do.py +++ b/impls/python/step4_if_fn_do.py @@ -10,22 +10,20 @@ def READ(str): return reader.read_str(str) # eval -def eval_ast(ast, env): +def EVAL(ast, env): + dbgeval = env.get_or_nil('DEBUG-EVAL') + 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._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): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) - else: + elif not types._list_Q(ast): 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) + else: # apply list if len(ast) == 0: return ast @@ -42,8 +40,9 @@ def EVAL(ast, env): 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] + 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) @@ -56,9 +55,9 @@ def EVAL(ast, env): 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:]) + f = EVAL(a0, env) + args = ast[1:] + return f(*(EVAL(a, env) for a in args)) # print def PRINT(exp): diff --git a/impls/python/step5_tco.py b/impls/python/step5_tco.py index 5d783d3d08..74eedbee09 100644 --- a/impls/python/step5_tco.py +++ b/impls/python/step5_tco.py @@ -10,23 +10,22 @@ def READ(str): return reader.read_str(str) # eval -def eval_ast(ast, env): +def EVAL(ast, env): + while True: + + dbgeval = env.get_or_nil('DEBUG-EVAL') + 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._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): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) - else: + elif not types._list_Q(ast): 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) + else: # apply list if len(ast) == 0: return ast @@ -45,7 +44,8 @@ def EVAL(ast, env): env = let_env # Continue loop (TCO) elif "do" == a0: - eval_ast(ast[1:-1], env) + for i in range(1, len(ast)-1): + EVAL(ast[i], env) ast = ast[-1] # Continue loop (TCO) elif "if" == a0: @@ -61,13 +61,13 @@ def EVAL(ast, env): a1, a2 = ast[1], ast[2] return types._function(EVAL, Env, a2, env, a1) else: - el = eval_ast(ast, env) - f = el[0] + f = EVAL(a0, env) + args = ast[1:] if hasattr(f, '__ast__'): ast = f.__ast__ - env = f.__gen_env__(el[1:]) + env = f.__gen_env__(types.List(EVAL(a, env) for a in args)) else: - return f(*el[1:]) + return f(*(EVAL(a, env) for a in args)) # print def PRINT(exp): diff --git a/impls/python/step6_file.py b/impls/python/step6_file.py index 2fd02eb0ea..4c0278e977 100644 --- a/impls/python/step6_file.py +++ b/impls/python/step6_file.py @@ -10,23 +10,22 @@ def READ(str): return reader.read_str(str) # eval -def eval_ast(ast, env): +def EVAL(ast, env): + while True: + + dbgeval = env.get_or_nil('DEBUG-EVAL') + 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._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): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) - else: + elif not types._list_Q(ast): 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) + else: # apply list if len(ast) == 0: return ast @@ -45,7 +44,8 @@ def EVAL(ast, env): env = let_env # Continue loop (TCO) elif "do" == a0: - eval_ast(ast[1:-1], env) + for i in range(1, len(ast)-1): + EVAL(ast[i], env) ast = ast[-1] # Continue loop (TCO) elif "if" == a0: @@ -61,13 +61,13 @@ def EVAL(ast, env): a1, a2 = ast[1], ast[2] return types._function(EVAL, Env, a2, env, a1) else: - el = eval_ast(ast, env) - f = el[0] + f = EVAL(a0, env) + args = ast[1:] if hasattr(f, '__ast__'): ast = f.__ast__ - env = f.__gen_env__(el[1:]) + env = f.__gen_env__(types.List(EVAL(a, env) for a in args)) else: - return f(*el[1:]) + return f(*(EVAL(a, env) for a in args)) # print def PRINT(exp): diff --git a/impls/python/step7_quote.py b/impls/python/step7_quote.py index 7bdb312efd..89e8265cb1 100644 --- a/impls/python/step7_quote.py +++ b/impls/python/step7_quote.py @@ -33,23 +33,22 @@ def quasiquote(ast): else: return ast -def eval_ast(ast, env): +def EVAL(ast, env): + while True: + + dbgeval = env.get_or_nil('DEBUG-EVAL') + 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._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): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) - else: + elif not types._list_Q(ast): 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) + else: # apply list if len(ast) == 0: return ast @@ -69,13 +68,12 @@ def EVAL(ast, env): # Continue loop (TCO) elif "quote" == a0: return ast[1] - elif "quasiquoteexpand" == a0: - return quasiquote(ast[1]); elif "quasiquote" == a0: ast = quasiquote(ast[1]); # Continue loop (TCO) elif "do" == a0: - eval_ast(ast[1:-1], env) + for i in range(1, len(ast)-1): + EVAL(ast[i], env) ast = ast[-1] # Continue loop (TCO) elif "if" == a0: @@ -91,13 +89,13 @@ def EVAL(ast, env): a1, a2 = ast[1], ast[2] return types._function(EVAL, Env, a2, env, a1) else: - el = eval_ast(ast, env) - f = el[0] + f = EVAL(a0, env) + args = ast[1:] if hasattr(f, '__ast__'): ast = f.__ast__ - env = f.__gen_env__(el[1:]) + env = f.__gen_env__(types.List(EVAL(a, env) for a in args)) else: - return f(*el[1:]) + return f(*(EVAL(a, env) for a in args)) # print def PRINT(exp): diff --git a/impls/python/step8_macros.py b/impls/python/step8_macros.py index 4d67304e5c..25044b5235 100644 --- a/impls/python/step8_macros.py +++ b/impls/python/step8_macros.py @@ -33,40 +33,24 @@ def quasiquote(ast): else: return ast -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 EVAL(ast, env): + while True: -def macroexpand(ast, env): - while is_macro_call(ast, env): - mac = env.get(ast[0]) - ast = mac(*ast[1:]) - return ast + dbgeval = env.get_or_nil('DEBUG-EVAL') + if dbgeval is not None and dbgeval is not False: + print('EVAL: ' + printer._pr_str(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): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) - else: + elif not types._list_Q(ast): 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) + else: # 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] @@ -84,8 +68,6 @@ def EVAL(ast, env): # Continue loop (TCO) elif "quote" == a0: return ast[1] - elif "quasiquoteexpand" == a0: - return quasiquote(ast[1]); elif "quasiquote" == a0: ast = quasiquote(ast[1]); # Continue loop (TCO) @@ -93,10 +75,9 @@ def EVAL(ast, env): func = types._clone(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) + for i in range(1, len(ast)-1): + EVAL(ast[i], env) ast = ast[-1] # Continue loop (TCO) elif "if" == a0: @@ -112,13 +93,16 @@ def EVAL(ast, env): a1, a2 = ast[1], ast[2] return types._function(EVAL, Env, a2, env, a1) else: - el = eval_ast(ast, env) - f = el[0] + f = EVAL(a0, env) + args = ast[1:] + if hasattr(f, '_ismacro_'): + ast = f(*args) + continue # TCO if hasattr(f, '__ast__'): ast = f.__ast__ - env = f.__gen_env__(el[1:]) + env = f.__gen_env__(types.List(EVAL(a, env) for a in args)) else: - return f(*el[1:]) + return f(*(EVAL(a, env) for a in args)) # print def PRINT(exp): diff --git a/impls/python/step9_try.py b/impls/python/step9_try.py index 8162ab3cdc..17aff4d171 100644 --- a/impls/python/step9_try.py +++ b/impls/python/step9_try.py @@ -33,40 +33,24 @@ def quasiquote(ast): else: return ast -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 EVAL(ast, env): + while True: -def macroexpand(ast, env): - while is_macro_call(ast, env): - mac = env.get(ast[0]) - ast = mac(*ast[1:]) - return ast + dbgeval = env.get_or_nil('DEBUG-EVAL') + if dbgeval is not None and dbgeval is not False: + print('EVAL: ' + printer._pr_str(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): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) - else: + elif not types._list_Q(ast): 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) + else: # 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] @@ -84,8 +68,6 @@ def EVAL(ast, env): # Continue loop (TCO) elif "quote" == a0: return ast[1] - elif "quasiquoteexpand" == a0: - return quasiquote(ast[1]); elif "quasiquote" == a0: ast = quasiquote(ast[1]); # Continue loop (TCO) @@ -93,13 +75,8 @@ def EVAL(ast, env): func = types._clone(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()) + exec(compile(ast[1], '', 'single'), globals()) return None elif "try*" == a0: if len(ast) < 3: @@ -118,7 +95,8 @@ def EVAL(ast, env): else: return EVAL(a1, env); elif "do" == a0: - eval_ast(ast[1:-1], env) + for i in range(1, len(ast)-1): + EVAL(ast[i], env) ast = ast[-1] # Continue loop (TCO) elif "if" == a0: @@ -134,13 +112,16 @@ def EVAL(ast, env): a1, a2 = ast[1], ast[2] return types._function(EVAL, Env, a2, env, a1) else: - el = eval_ast(ast, env) - f = el[0] + f = EVAL(a0, env) + args = ast[1:] + if hasattr(f, '_ismacro_'): + ast = f(*args) + continue # TCO if hasattr(f, '__ast__'): ast = f.__ast__ - env = f.__gen_env__(el[1:]) + env = f.__gen_env__(types.List(EVAL(a, env) for a in args)) else: - return f(*el[1:]) + return f(*(EVAL(a, env) for a in args)) # print def PRINT(exp): diff --git a/impls/python/stepA_mal.py b/impls/python/stepA_mal.py index 2ac1d679c3..b8455ac105 100644 --- a/impls/python/stepA_mal.py +++ b/impls/python/stepA_mal.py @@ -33,40 +33,24 @@ def quasiquote(ast): else: return ast -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 EVAL(ast, env): + while True: -def macroexpand(ast, env): - while is_macro_call(ast, env): - mac = env.get(ast[0]) - ast = mac(*ast[1:]) - return ast + dbgeval = env.get_or_nil('DEBUG-EVAL') + if dbgeval is not None and dbgeval is not False: + print('EVAL: ' + printer._pr_str(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): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) - else: + elif not types._list_Q(ast): 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) + else: # 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] @@ -84,8 +68,6 @@ def EVAL(ast, env): # Continue loop (TCO) elif "quote" == a0: return ast[1] - elif "quasiquoteexpand" == a0: - return quasiquote(ast[1]); elif "quasiquote" == a0: ast = quasiquote(ast[1]); # Continue loop (TCO) @@ -93,15 +75,13 @@ def EVAL(ast, env): func = types._clone(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) + el = (EVAL(ast[i], env) for i in range(2, len(ast))) f = eval(ast[1]) return f(*el) elif "try*" == a0: @@ -121,7 +101,8 @@ def EVAL(ast, env): else: return EVAL(a1, env); elif "do" == a0: - eval_ast(ast[1:-1], env) + for i in range(1, len(ast)-1): + EVAL(ast[i], env) ast = ast[-1] # Continue loop (TCO) elif "if" == a0: @@ -137,13 +118,16 @@ def EVAL(ast, env): a1, a2 = ast[1], ast[2] return types._function(EVAL, Env, a2, env, a1) else: - el = eval_ast(ast, env) - f = el[0] + f = EVAL(a0, env) + args = ast[1:] + if hasattr(f, '_ismacro_'): + ast = f(*args) + continue # TCO if hasattr(f, '__ast__'): ast = f.__ast__ - env = f.__gen_env__(el[1:]) + env = f.__gen_env__(types.List(EVAL(a, env) for a in args)) else: - return f(*el[1:]) + return f(*(EVAL(a, env) for a in args)) # print def PRINT(exp): diff --git a/impls/r/step2_eval.r b/impls/r/step2_eval.r index 68cd4061bc..aa457c7cdc 100644 --- a/impls/r/step2_eval.r +++ b/impls/r/step2_eval.r @@ -7,38 +7,34 @@ READ <- function(str) { return(read_str(str)) } -eval_ast <- function(ast, env) { +EVAL <- function(ast, env) { + + # cat("EVAL: ", .pr_str(ast,TRUE), "\n", sep="") + if (.symbol_q(ast)) { - env[[as.character(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 - } -} - -EVAL <- function(ast, env) { - #cat("EVAL: ", .pr_str(ast,TRUE), "\n", sep="") - if (!.list_q(ast)) { - return(eval_ast(ast, env)) + return(ast) } # apply list if (length(ast) == 0) { return(ast) } - el <- eval_ast(ast, env) - f <- el[[1]] - return(do.call(f,el[-1])) + 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) { diff --git a/impls/r/step3_env.r b/impls/r/step3_env.r index 142f43dd9d..37519e825b 100644 --- a/impls/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/impls/r/step4_if_fn_do.r b/impls/r/step4_if_fn_do.r index 567e18d70b..8948f2aa33 100644 --- a/impls/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/impls/r/step5_tco.r b/impls/r/step5_tco.r index 913c78fbd9..b6db00747b 100644 --- a/impls/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/impls/r/step6_file.r b/impls/r/step6_file.r index c3a2297505..4184351f48 100644 --- a/impls/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)) } } diff --git a/impls/r/step7_quote.r b/impls/r/step7_quote.r index 52b68d0db7..a5dd3828c0 100644 --- a/impls/r/step7_quote.r +++ b/impls/r/step7_quote.r @@ -46,32 +46,35 @@ quasiquote <- function(ast) { } } -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=""), @@ -93,12 +96,12 @@ EVAL <- function(ast, env) { env <- let_env } else if (a0sym == "quote") { return(a1) - } else if (a0sym == "quasiquoteexpand") { - return(quasiquote(a1)) } else if (a0sym == "quasiquote") { ast <- quasiquote(a1) } 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) @@ -111,13 +114,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/impls/r/step8_macros.r b/impls/r/step8_macros.r index c6434a388d..aa5f6cc926 100644 --- a/impls/r/step8_macros.r +++ b/impls/r/step8_macros.r @@ -46,54 +46,37 @@ quasiquote <- function(ast) { } } -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 -} +EVAL <- function(ast, env) { -macroexpand <- function(ast, env) { - while(is_macro_call(ast, env)) { - mac <- Env.get(env, ast[[1]]) - ast <- fapply(mac, slice(ast, 2)) + 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="") } - ast -} -eval_ast <- function(ast, env) { 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 - 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 }, @@ -113,18 +96,16 @@ EVAL <- function(ast, env) { env <- let_env } else if (a0sym == "quote") { return(a1) - } else if (a0sym == "quasiquoteexpand") { - return(quasiquote(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) + 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) @@ -137,13 +118,17 @@ 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) + 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(slice(el,2)) + env <- f$gen_env(args) } else { - return(do.call(f,slice(el,2))) + return(do.call(f, args)) } } diff --git a/impls/r/step9_try.r b/impls/r/step9_try.r index c1be773a3d..c557f8adc1 100644 --- a/impls/r/step9_try.r +++ b/impls/r/step9_try.r @@ -46,54 +46,37 @@ quasiquote <- function(ast) { } } -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 -} +EVAL <- function(ast, env) { -macroexpand <- function(ast, env) { - while(is_macro_call(ast, env)) { - mac <- Env.get(env, ast[[1]]) - ast <- fapply(mac, slice(ast, 2)) + 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="") } - ast -} -eval_ast <- function(ast, env) { 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 - 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 }, @@ -113,16 +96,12 @@ EVAL <- function(ast, env) { env <- let_env } else if (a0sym == "quote") { return(a1) - } else if (a0sym == "quasiquoteexpand") { - return(quasiquote(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({ @@ -138,7 +117,9 @@ EVAL <- function(ast, env) { throw(edata$exc) } } 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) @@ -151,13 +132,17 @@ 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) + 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(slice(el,2)) + env <- f$gen_env(args) } else { - return(do.call(f,slice(el,2))) + return(do.call(f, args)) } } diff --git a/impls/r/stepA_mal.r b/impls/r/stepA_mal.r index ca77531c2d..be2398fe7e 100644 --- a/impls/r/stepA_mal.r +++ b/impls/r/stepA_mal.r @@ -46,54 +46,37 @@ quasiquote <- function(ast) { } } -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 -} +EVAL <- function(ast, env) { -macroexpand <- function(ast, env) { - while(is_macro_call(ast, env)) { - mac <- Env.get(env, ast[[1]]) - ast <- fapply(mac, slice(ast, 2)) + 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="") } - ast -} -eval_ast <- function(ast, env) { 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 - 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 }, @@ -113,16 +96,12 @@ EVAL <- function(ast, env) { env <- let_env } else if (a0sym == "quote") { return(a1) - } else if (a0sym == "quasiquoteexpand") { - return(quasiquote(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({ @@ -138,7 +117,9 @@ EVAL <- function(ast, env) { throw(edata$exc) } } 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) @@ -151,13 +132,17 @@ 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) + 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(slice(el,2)) + env <- f$gen_env(args) } else { - return(do.call(f,slice(el,2))) + return(do.call(f, args)) } } diff --git a/impls/racket/env.rkt b/impls/racket/env.rkt index 8e47b634a7..9868933f30 100644 --- a/impls/racket/env.rkt +++ b/impls/racket/env.rkt @@ -28,20 +28,6 @@ (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)))))) - - - + (hash-ref data k + (lambda () (unless (null? _outer) (send _outer get k))))))) diff --git a/impls/racket/step2_eval.rkt b/impls/racket/step2_eval.rkt index 7f987dfa5f..7ea1ce8f5d 100755 --- a/impls/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 index 91eff03e5b..8ecd818507 100755 --- a/impls/racket/step3_env.rkt +++ b/impls/racket/step3_env.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) @@ -32,10 +36,11 @@ (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))])))) + [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/impls/racket/step4_if_fn_do.rkt b/impls/racket/step4_if_fn_do.rkt index 0a098029e6..44af35c119 100755 --- a/impls/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/impls/racket/step5_tco.rkt b/impls/racket/step5_tco.rkt index cdc5230894..880e05ae5c 100755 --- a/impls/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/impls/racket/step6_file.rkt b/impls/racket/step6_file.rkt index 1db7a081f6..6e1645bce9 100755 --- a/impls/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) diff --git a/impls/racket/step7_quote.rkt b/impls/racket/step7_quote.rkt index 3f2610aed9..d9257f4889 100755 --- a/impls/racket/step7_quote.rkt +++ b/impls/racket/step7_quote.rkt @@ -32,18 +32,22 @@ [else (foldr qq-loop null ast)])) -(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) @@ -57,12 +61,10 @@ (EVAL (_nth ast 2) let-env))] [(eq? 'quote a0) (_nth ast 1)] - [(eq? 'quasiquoteexpand a0) - (quasiquote (cadr ast))] [(eq? 'quasiquote a0) (EVAL (quasiquote (_nth ast 1)) 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)]) @@ -78,16 +80,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/impls/racket/step8_macros.rkt b/impls/racket/step8_macros.rkt index ccffa82286..864093047e 100755 --- a/impls/racket/step8_macros.rkt +++ b/impls/racket/step8_macros.rkt @@ -32,35 +32,22 @@ [else (foldr qq-loop null 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) +(define (EVAL ast env) + (let ([dbgeval (send env get 'DEBUG-EVAL)]) + (unless (or (void? dbgeval) (eq? dbgeval nil) (eq? dbgeval #f)) + (printf "EVAL: ~a~n" (pr_str ast true)))) (cond - [(symbol? ast) (send env get ast)] - [(_sequential? ast) (_map (lambda (x) (EVAL x env)) ast)] + [(symbol? ast) + (let ([val (send env get ast)]) + (if (void? val) + (raise (string-append "'" (symbol->string ast) "' not found")) + val))] + [(vector? ast) (vector-map (lambda (x) (EVAL x env)) ast)] [(hash? ast) (make-hash (dict-map ast (lambda (k v) (cons k (EVAL v env)))))] - [else ast])) - -(define (EVAL ast env) - (if (not (list? ast)) - (eval-ast ast env) - - (let ([ast (macroexpand 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) @@ -74,18 +61,14 @@ (EVAL (_nth ast 2) let-env))] [(eq? 'quote a0) (_nth ast 1)] - [(eq? 'quasiquoteexpand a0) - (quasiquote (cadr ast))] [(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) + (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)]) @@ -101,16 +84,19 @@ [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)]) + (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)))])))))) + (apply f args)))))])))] + [else ast])) ;; print (define (PRINT exp) diff --git a/impls/racket/step9_try.rkt b/impls/racket/step9_try.rkt index 633fe1c04f..c8534d3b2b 100755 --- a/impls/racket/step9_try.rkt +++ b/impls/racket/step9_try.rkt @@ -32,36 +32,22 @@ [else (foldr qq-loop null 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) +(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) - ;(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) + [(list? ast) + (if (empty? ast) + ast (let ([a0 (_nth ast 0)]) (cond [(eq? 'def! a0) @@ -75,16 +61,12 @@ (EVAL (_nth ast 2) let-env))] [(eq? 'quote a0) (_nth ast 1)] - [(eq? 'quasiquoteexpand a0) - (quasiquote (cadr ast))] [(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 (or (< (length ast) 3) (not (eq? 'catch* (_nth (_nth ast 2) 0)))) @@ -101,7 +83,7 @@ [exn:fail? (lambda (exc) (efn (format "~a" exc)))]) (EVAL (_nth ast 1) 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)]) @@ -117,16 +99,19 @@ [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)]) + (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)))])))))) + (apply f args)))))])))] + [else ast])) ;; print (define (PRINT exp) diff --git a/impls/racket/stepA_mal.rkt b/impls/racket/stepA_mal.rkt index 9b68e7097d..c94bb80137 100755 --- a/impls/racket/stepA_mal.rkt +++ b/impls/racket/stepA_mal.rkt @@ -32,36 +32,22 @@ [else (foldr qq-loop null 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) +(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) - ;(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) + [(list? ast) + (if (empty? ast) + ast (let ([a0 (_nth ast 0)]) (cond [(eq? 'def! a0) @@ -75,16 +61,12 @@ (EVAL (_nth ast 2) let-env))] [(eq? 'quote a0) (_nth ast 1)] - [(eq? 'quasiquoteexpand a0) - (quasiquote (cadr ast))] [(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 (or (< (length ast) 3) (not (eq? 'catch* (_nth (_nth ast 2) 0)))) @@ -101,7 +83,7 @@ [exn:fail? (lambda (exc) (efn (format "~a" exc)))]) (EVAL (_nth ast 1) 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)]) @@ -117,16 +99,19 @@ [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)]) + (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)))])))))) + (apply f args)))))])))] + [else ast])) ;; print (define (PRINT exp) diff --git a/impls/rpython/stepA_mal.py b/impls/rpython/stepA_mal.py index 79f266211c..9592851066 100644 --- a/impls/rpython/stepA_mal.py +++ b/impls/rpython/stepA_mal.py @@ -49,30 +49,12 @@ def quasiquote(ast): else: return ast -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): +def EVAL(ast, env): + while True: + #print("EVAL %s" % printer._pr_str(ast)) 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: @@ -83,20 +65,10 @@ def eval_ast(ast, env): for k in ast.dct.keys(): new_dct[k] = EVAL(ast.dct[k], env) return MalHashMap(new_dct) - else: + elif not types._list_Q(ast): 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) - if len(ast) == 0: return ast - + else: # 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): @@ -117,16 +89,12 @@ def EVAL(ast, env): env = let_env # Continue loop (TCO) elif u"quote" == a0sym: return ast[1] - elif u"quasiquoteexpand" == a0sym: - return quasiquote(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: if len(ast) < 3: return EVAL(ast[1], env); @@ -148,8 +116,8 @@ def EVAL(ast, env): elif u"do" == a0sym: if len(ast) == 0: return nil - elif len(ast) > 1: - eval_ast(ast.slice2(1, len(ast)-1), env) + 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] @@ -163,14 +131,21 @@ def EVAL(ast, env): a1, a2 = ast[1], ast[2] return MalFunc(None, a2, env, a1, EVAL) else: - el = eval_ast(ast, env) - f = el.values[0] + f = EVAL(a0, env) + args = ast.rest() + if f.ismacro: + ast = f.apply(ast.rest()) # Continue loop (TCO) + else: + res = [] + for a in args.values: + res.append(EVAL(a, env)) + el = MalList(res) if isinstance(f, MalFunc): if f.ast: ast = f.ast - env = f.gen_env(el.rest()) # Continue loop (TCO) + env = f.gen_env(el) # Continue loop (TCO) else: - return f.apply(el.rest()) + return f.apply(el) else: raise Exception("%s is not callable" % f) diff --git a/impls/ruby.2/env.rb b/impls/ruby.2/env.rb index e6bb765bbd..0e8d612545 100644 --- a/impls/ruby.2/env.rb +++ b/impls/ruby.2/env.rb @@ -26,29 +26,14 @@ def set(k, v) @data[k] = v end - def find(k) + def get(k) if @data.key?(k) - self + @data[k] elsif !@outer.nil? - @outer.find(k) + @outer.get(k) else - Types::Nil.instance - end - end - - def get(k) - environment = find(k) - - case environment - when self.class - environment.get_value(k) - when Types::Nil - raise SymbolNotFoundError, "'#{k.value}' not found" + 0 end end - - def get_value(k) - @data[k] - end end end diff --git a/impls/ruby.2/step2_eval.rb b/impls/ruby.2/step2_eval.rb index 5642d4e53b..681068ebd4 100644 --- a/impls/ruby.2/step2_eval.rb +++ b/impls/ruby.2/step2_eval.rb @@ -19,8 +19,31 @@ def READ(input) end def EVAL(ast, environment) - if Types::List === ast && ast.size > 0 - evaluated = eval_ast(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) @@ -28,10 +51,8 @@ def EVAL(ast, environment) else raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." end - elsif Types::List === ast && ast.size == 0 - ast else - eval_ast(ast, environment) + return ast end end @@ -59,30 +80,6 @@ def rep(input) "Error! Detected unbalanced list. Check for matching ']'." end - def eval_ast(mal, environment) - case mal - when Types::Symbol - if @repl_env.key?(mal.value) - @repl_env[mal.value] - else - raise SymbolNotFoundError, "Error! Symbol #{mal.value} not found." - end - when Types::List - list = Types::List.new - mal.each { |i| list << EVAL(i, environment) } - list - when Types::Vector - vec = Types::Vector.new - mal.each { |i| vec << EVAL(i, environment) } - vec - when Types::Hashmap - hashmap = Types::Hashmap.new - mal.each { |k, v| hashmap[k] = EVAL(v, environment) } - hashmap - else - mal - end - end end while input = Readline.readline("user> ") diff --git a/impls/ruby.2/step3_env.rb b/impls/ruby.2/step3_env.rb index dc908a70b6..59d08f0868 100644 --- a/impls/ruby.2/step3_env.rb +++ b/impls/ruby.2/step3_env.rb @@ -19,7 +19,31 @@ def READ(input) end def EVAL(ast, environment) - if Types::List === ast && ast.size > 0 + 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 @@ -47,7 +71,8 @@ def EVAL(ast, environment) Types::Nil.instance end else - evaluated = eval_ast(ast, environment) + evaluated = Types::List.new + ast.each { |i| evaluated << EVAL(i, environment) } maybe_callable = evaluated.first if maybe_callable.respond_to?(:call) @@ -56,10 +81,8 @@ def EVAL(ast, environment) raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." end end - elsif Types::List === ast && ast.size == 0 - ast else - eval_ast(ast, environment) + return ast end end @@ -87,26 +110,6 @@ def rep(input) "Error! Detected unbalanced list. Check for matching ']'." end - def eval_ast(mal, environment) - case mal - when Types::Symbol - environment.get(mal) - when Types::List - list = Types::List.new - mal.each { |i| list << EVAL(i, environment) } - list - when Types::Vector - vec = Types::Vector.new - mal.each { |i| vec << EVAL(i, environment) } - vec - when Types::Hashmap - hashmap = Types::Hashmap.new - mal.each { |k, v| hashmap[k] = EVAL(v, environment) } - hashmap - else - mal - end - end end while input = Readline.readline("user> ") diff --git a/impls/ruby.2/step4_if_fn_do.rb b/impls/ruby.2/step4_if_fn_do.rb index 5133f51756..506026facb 100644 --- a/impls/ruby.2/step4_if_fn_do.rb +++ b/impls/ruby.2/step4_if_fn_do.rb @@ -24,7 +24,31 @@ def READ(input) end def EVAL(ast, environment) - if Types::List === ast && ast.size > 0 + 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 @@ -89,7 +113,8 @@ def EVAL(ast, environment) EVAL(to_eval, Env.new(environment, binds, exprs)) end else - evaluated = eval_ast(ast, environment) + evaluated = Types::List.new + ast.each { |i| evaluated << EVAL(i, environment) } maybe_callable = evaluated.first if maybe_callable.respond_to?(:call) @@ -98,10 +123,8 @@ def EVAL(ast, environment) raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." end end - elsif Types::List === ast && ast.size == 0 - ast else - eval_ast(ast, environment) + return ast end end @@ -129,26 +152,6 @@ def rep(input) "Error! Detected unbalanced list. Check for matching ']'." end - def eval_ast(mal, environment) - case mal - when Types::Symbol - environment.get(mal) - when Types::List - list = Types::List.new - mal.each { |i| list << EVAL(i, environment) } - list - when Types::Vector - vec = Types::Vector.new - mal.each { |i| vec << EVAL(i, environment) } - vec - when Types::Hashmap - hashmap = Types::Hashmap.new - mal.each { |k, v| hashmap[k] = EVAL(v, environment) } - hashmap - else - mal - end - end end Mal.boot_repl! diff --git a/impls/ruby.2/step5_tco.rb b/impls/ruby.2/step5_tco.rb index d6b4085c78..311468527a 100644 --- a/impls/ruby.2/step5_tco.rb +++ b/impls/ruby.2/step5_tco.rb @@ -25,7 +25,32 @@ def READ(input) def EVAL(ast, environment) loop do - if Types::List === ast && ast.size > 0 + + 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 @@ -93,27 +118,26 @@ def EVAL(ast, environment) EVAL(to_eval, Env.new(environment, binds, exprs)) end else - evaluated = eval_ast(ast, environment) - maybe_callable = evaluated.first - - if maybe_callable.respond_to?(:call) && !maybe_callable.is_mal_fn? - return maybe_callable.call(Types::Args.new(evaluated[1..])) - elsif maybe_callable.respond_to?(:call) && maybe_callable.is_mal_fn? + 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, - evaluated[1..], + args, ) else - raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." + return maybe_callable.call(Types::Args.new(args)) end end - elsif Types::List === ast && ast.size == 0 - return ast else - return eval_ast(ast, environment) + return ast end end end @@ -142,26 +166,6 @@ def rep(input) "Error! Detected unbalanced list. Check for matching ']'." end - def eval_ast(mal, environment) - case mal - when Types::Symbol - environment.get(mal) - when Types::List - list = Types::List.new - mal.each { |i| list << EVAL(i, environment) } - list - when Types::Vector - vec = Types::Vector.new - mal.each { |i| vec << EVAL(i, environment) } - vec - when Types::Hashmap - hashmap = Types::Hashmap.new - mal.each { |k, v| hashmap[k] = EVAL(v, environment) } - hashmap - else - mal - end - end end Mal.boot_repl! diff --git a/impls/ruby.2/step6_file.rb b/impls/ruby.2/step6_file.rb index 3325d5e7eb..4efc9e8449 100644 --- a/impls/ruby.2/step6_file.rb +++ b/impls/ruby.2/step6_file.rb @@ -44,7 +44,32 @@ def READ(input) def EVAL(ast, environment) loop do - if Types::List === ast && ast.size > 0 + + 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 @@ -112,27 +137,26 @@ def EVAL(ast, environment) EVAL(to_eval, Env.new(environment, binds, exprs)) end else - evaluated = eval_ast(ast, environment) - maybe_callable = evaluated.first - - if maybe_callable.respond_to?(:call) && maybe_callable.is_mal_fn? + 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, - evaluated[1..], + args, ) - elsif maybe_callable.respond_to?(:call) && !maybe_callable.is_mal_fn? - return maybe_callable.call(Types::Args.new(evaluated[1..])) else - raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." + return maybe_callable.call(Types::Args.new(args)) end end - elsif Types::List === ast && ast.size == 0 - return ast else - return eval_ast(ast, environment) + return ast end end end @@ -163,26 +187,6 @@ def rep(input) nil end - def eval_ast(mal, environment) - case mal - when Types::Symbol - environment.get(mal) - when Types::List - list = Types::List.new - mal.each { |i| list << EVAL(i, environment) } - list - when Types::Vector - vec = Types::Vector.new - mal.each { |i| vec << EVAL(i, environment) } - vec - when Types::Hashmap - hashmap = Types::Hashmap.new - mal.each { |k, v| hashmap[k] = EVAL(v, environment) } - hashmap - else - mal - end - end end Mal.boot_repl! diff --git a/impls/ruby.2/step7_quote.rb b/impls/ruby.2/step7_quote.rb index 837ac721e0..7d362fa806 100644 --- a/impls/ruby.2/step7_quote.rb +++ b/impls/ruby.2/step7_quote.rb @@ -44,7 +44,32 @@ def READ(input) def EVAL(ast, environment) loop do - if Types::List === ast && ast.size > 0 + + 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 @@ -117,31 +142,27 @@ def EVAL(ast, environment) when Types::Symbol.for("quasiquote") _, ast_rest = ast ast = quasiquote(ast_rest) - when Types::Symbol.for("quasiquoteexpand") - _, ast_rest = ast - return quasiquote(ast_rest) else - evaluated = eval_ast(ast, environment) - maybe_callable = evaluated.first - - if maybe_callable.respond_to?(:call) && maybe_callable.is_mal_fn? + 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, - evaluated[1..], + args, ) - elsif maybe_callable.respond_to?(:call) && !maybe_callable.is_mal_fn? - return maybe_callable.call(Types::Args.new(evaluated[1..])) else - raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." + return maybe_callable.call(Types::Args.new(args)) end end - elsif Types::List === ast && ast.size == 0 - return ast else - return eval_ast(ast, environment) + return ast end end end @@ -172,27 +193,6 @@ def rep(input) nil end - def eval_ast(mal, environment) - case mal - when Types::Symbol - environment.get(mal) - when Types::List - list = Types::List.new - mal.each { |i| list << EVAL(i, environment) } - list - when Types::Vector - vec = Types::Vector.new - mal.each { |i| vec << EVAL(i, environment) } - vec - when Types::Hashmap - hashmap = Types::Hashmap.new - mal.each { |k, v| hashmap[k] = EVAL(v, environment) } - hashmap - else - mal - end - end - def quasiquote_list(mal) result = Types::List.new diff --git a/impls/ruby.2/step8_macros.rb b/impls/ruby.2/step8_macros.rb index f65deea581..1ed751d010 100644 --- a/impls/ruby.2/step8_macros.rb +++ b/impls/ruby.2/step8_macros.rb @@ -26,8 +26,12 @@ def boot_repl! 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? 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? @@ -45,9 +49,32 @@ def READ(input) def EVAL(ast, environment) loop do - ast = macro_expand(ast, environment) - if Types::List === ast && ast.size > 0 + 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 @@ -62,9 +89,6 @@ def EVAL(ast, environment) else raise TypeError end - when Types::Symbol.for("macroexpand") - _, ast_rest = ast - return macro_expand(ast_rest, environment) when Types::Symbol.for("let*") e = Env.new(environment) _, bindings, val = ast @@ -133,31 +157,36 @@ def EVAL(ast, environment) when Types::Symbol.for("quasiquote") _, ast_rest = ast ast = quasiquote(ast_rest) - when Types::Symbol.for("quasiquoteexpand") - _, ast_rest = ast - return quasiquote(ast_rest) else - evaluated = eval_ast(ast, environment) - maybe_callable = evaluated.first - - if maybe_callable.respond_to?(:call) && maybe_callable.is_mal_fn? + 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, - evaluated[1..], + args, ) - elsif maybe_callable.respond_to?(:call) && !maybe_callable.is_mal_fn? - return maybe_callable.call(Types::Args.new(evaluated[1..])) else - raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." + return maybe_callable.call(Types::Args.new(args)) end end - elsif Types::List === ast && ast.size == 0 - return ast else - return eval_ast(ast, environment) + return ast end end end @@ -190,27 +219,6 @@ def rep(input) nil end - def eval_ast(mal, environment) - case mal - when Types::Symbol - environment.get(mal) - when Types::List - list = Types::List.new - mal.each { |i| list << EVAL(i, environment) } - list - when Types::Vector - vec = Types::Vector.new - mal.each { |i| vec << EVAL(i, environment) } - vec - when Types::Hashmap - hashmap = Types::Hashmap.new - mal.each { |k, v| hashmap[k] = EVAL(v, environment) } - hashmap - else - mal - end - end - def quasiquote_list(mal) result = Types::List.new @@ -256,29 +264,6 @@ def quasiquote(mal) end end - def is_macro_call?(mal, env) - return false unless Types::List === mal - return false unless Types::Symbol === mal.first - val = env.get(mal.first) - return false unless Types::Callable === val - val.is_macro? - rescue SymbolNotFoundError - false - end - - def macro_expand(mal, env) - while is_macro_call?(mal, env) - macro_fn = env.get(mal.first) - - if (args = mal[1..]).any? - mal = macro_fn.call(Types::Args.new(mal[1..])) - else - mal = macro_fn.call - end - end - - mal - end end Mal.boot_repl! diff --git a/impls/ruby.2/step9_try.rb b/impls/ruby.2/step9_try.rb index 68e93c0180..f2c901921b 100644 --- a/impls/ruby.2/step9_try.rb +++ b/impls/ruby.2/step9_try.rb @@ -26,8 +26,12 @@ def boot_repl! 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? 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? @@ -43,7 +47,11 @@ def run! Mal.rep("(def! *ARGV* (list))") end - puts Mal.rep("(load-file #{ARGV.first.inspect})") + file = File.absolute_path(ARGV.first) + + Dir.chdir(File.dirname(file)) do + Mal.rep("(load-file #{file.inspect})") + end end def READ(input) @@ -52,9 +60,32 @@ def READ(input) def EVAL(ast, environment) loop do - ast = macro_expand(ast, environment) - if Types::List === ast && ast.size > 0 + 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 @@ -69,9 +100,6 @@ def EVAL(ast, environment) else raise TypeError end - when Types::Symbol.for("macroexpand") - _, ast_rest = ast - return macro_expand(ast_rest, environment) when Types::Symbol.for("let*") e = Env.new(environment) _, bindings, val = ast @@ -140,9 +168,6 @@ def EVAL(ast, environment) when Types::Symbol.for("quasiquote") _, ast_rest = ast ast = quasiquote(ast_rest) - when Types::Symbol.for("quasiquoteexpand") - _, ast_rest = ast - return quasiquote(ast_rest) when Types::Symbol.for("try*") _, to_try, catch_list = ast @@ -171,27 +196,35 @@ def EVAL(ast, environment) ) end else - evaluated = eval_ast(ast, environment) - maybe_callable = evaluated.first - - if maybe_callable.respond_to?(:call) && maybe_callable.is_mal_fn? + 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, - evaluated[1..], + args, ) - elsif maybe_callable.respond_to?(:call) && !maybe_callable.is_mal_fn? - return maybe_callable.call(Types::Args.new(evaluated[1..])) else - raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." + return maybe_callable.call(Types::Args.new(args)) end end - elsif Types::List === ast && ast.size == 0 - return ast else - return eval_ast(ast, environment) + return ast end end end @@ -226,27 +259,6 @@ def rep(input) nil end - def eval_ast(mal, environment) - case mal - when Types::Symbol - environment.get(mal) - when Types::List - list = Types::List.new - mal.each { |i| list << EVAL(i, environment) } - list - when Types::Vector - vec = Types::Vector.new - mal.each { |i| vec << EVAL(i, environment) } - vec - when Types::Hashmap - hashmap = Types::Hashmap.new - mal.each { |k, v| hashmap[k] = EVAL(v, environment) } - hashmap - else - mal - end - end - def quasiquote_list(mal) result = Types::List.new @@ -292,29 +304,6 @@ def quasiquote(mal) end end - def is_macro_call?(mal, env) - return false unless Types::List === mal - return false unless Types::Symbol === mal.first - val = env.get(mal.first) - return false unless Types::Callable === val - val.is_macro? - rescue SymbolNotFoundError - false - end - - def macro_expand(mal, env) - while is_macro_call?(mal, env) - macro_fn = env.get(mal.first) - - if (args = mal[1..]).any? - mal = macro_fn.call(Types::Args.new(mal[1..])) - else - mal = macro_fn.call - end - end - - mal - end end Mal.boot_repl! diff --git a/impls/ruby.2/stepA_mal.rb b/impls/ruby.2/stepA_mal.rb index 16283a15c4..6ccb1ca05d 100644 --- a/impls/ruby.2/stepA_mal.rb +++ b/impls/ruby.2/stepA_mal.rb @@ -61,9 +61,32 @@ def READ(input) def EVAL(ast, environment) loop do - ast = macro_expand(ast, environment) - if Types::List === ast && ast.size > 0 + 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 @@ -78,9 +101,6 @@ def EVAL(ast, environment) else raise TypeError, "defmacro! must be bound to a function" end - when Types::Symbol.for("macroexpand") - _, ast_rest = ast - return macro_expand(ast_rest, environment) when Types::Symbol.for("let*") e = Env.new(environment) _, bindings, val = ast @@ -150,9 +170,6 @@ def EVAL(ast, environment) when Types::Symbol.for("quasiquote") _, ast_rest = ast ast = quasiquote(ast_rest) - when Types::Symbol.for("quasiquoteexpand") - _, ast_rest = ast - return quasiquote(ast_rest) when Types::Symbol.for("try*") _, to_try, catch_list = ast @@ -181,31 +198,37 @@ def EVAL(ast, environment) ) end else - evaluated = eval_ast(ast, environment) - maybe_callable = evaluated.first - - if maybe_callable.respond_to?(:call) && maybe_callable.is_mal_fn? + 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, - evaluated[1..], + args, ) - elsif maybe_callable.respond_to?(:call) && !maybe_callable.is_mal_fn? - if (args = evaluated[1..]).any? - return maybe_callable.call(Types::Args.new(args)) - else - return maybe_callable.call(Types::Args.new) - end + elsif args.any? + return maybe_callable.call(Types::Args.new(args)) else - raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." + return maybe_callable.call(Types::Args.new) end end - elsif Types::List === ast && ast.size == 0 - return ast else - return eval_ast(ast, environment) + return ast end end end @@ -240,27 +263,6 @@ def rep(input) nil end - def eval_ast(mal, environment) - case mal - when Types::Symbol - environment.get(mal) - when Types::List - list = Types::List.new - mal.each { |i| list << EVAL(i, environment) } - list - when Types::Vector - vec = Types::Vector.new - mal.each { |i| vec << EVAL(i, environment) } - vec - when Types::Hashmap - hashmap = Types::Hashmap.new - mal.each { |k, v| hashmap[k] = EVAL(v, environment) } - hashmap - else - mal - end - end - def quasiquote_list(mal) result = Types::List.new @@ -306,29 +308,6 @@ def quasiquote(mal) end end - def is_macro_call?(mal, env) - return false unless Types::List === mal - return false unless Types::Symbol === mal.first - val = env.get(mal.first) - return false unless Types::Callable === val - val.is_macro? - rescue SymbolNotFoundError - false - end - - def macro_expand(mal, env) - while is_macro_call?(mal, env) - macro_fn = env.get(mal.first) - - if (args = mal[1..]).any? - mal = macro_fn.call(Types::Args.new(mal[1..])) - else - mal = macro_fn.call - end - end - - mal - end end Mal.boot_repl! diff --git a/impls/ruby/env.rb b/impls/ruby/env.rb index 97dfa13ef6..d67a65b8e0 100644 --- a/impls/ruby/env.rb +++ b/impls/ruby/env.rb @@ -34,4 +34,10 @@ def get(key) raise "'" + key.to_s + "' not found" if not env env.data[key] end + + def get_or_nil(key) + env = find(key) + return nil if not env + env.data[key] + end end diff --git a/impls/ruby/step2_eval.rb b/impls/ruby/step2_eval.rb index 23e47b3ff0..66376f2ce5 100644 --- a/impls/ruby/step2_eval.rb +++ b/impls/ruby/step2_eval.rb @@ -9,38 +9,32 @@ def READ(str) end # eval -def eval_ast(ast, env) - return case ast +def EVAL(ast, env) + #puts "EVAL: #{_pr_str(ast, true)}" + + case ast when Symbol raise "'" + ast.to_s + "' not found" if not env.key? ast - env[ast] + return env[ast] when List - List.new ast.map{|a| EVAL(a, env)} when Vector - Vector.new ast.map{|a| EVAL(a, env)} + return Vector.new ast.map{|a| EVAL(a, env)} when Hash new_hm = {} ast.each{|k,v| new_hm[k] = EVAL(v, env)} - new_hm + return new_hm else - ast + return ast end -end - -def EVAL(ast, env) - #puts "EVAL: #{_pr_str(ast, true)}" - if not ast.is_a? List - return eval_ast(ast, env) - end + # apply list if ast.empty? return ast end - # apply list - el = eval_ast(ast, env) - f = el[0] - return f[*el.drop(1)] + f = EVAL(ast[0], env) + args = ast.drop(1) + return f[*args.map{|a| EVAL(a, env)}] end # print diff --git a/impls/ruby/step3_env.rb b/impls/ruby/step3_env.rb index ece32bd57f..258e2e815d 100644 --- a/impls/ruby/step3_env.rb +++ b/impls/ruby/step3_env.rb @@ -10,34 +10,30 @@ def READ(str) end # eval -def eval_ast(ast, env) - return case ast +def EVAL(ast, env) + if env.get_or_nil(:"DEBUG-EVAL") + puts "EVAL: #{_pr_str(ast, true)}" + end + + case ast when Symbol - env.get(ast) + return env.get(ast) when List - List.new ast.map{|a| EVAL(a, env)} when Vector - Vector.new ast.map{|a| EVAL(a, env)} + return Vector.new ast.map{|a| EVAL(a, env)} when Hash new_hm = {} ast.each{|k,v| new_hm[k] = EVAL(v, env)} - new_hm + return new_hm else - ast + return ast end -end -def EVAL(ast, env) - #puts "EVAL: #{_pr_str(ast, true)}" - - if not ast.is_a? List - return eval_ast(ast, env) - end + # apply list if ast.empty? return ast end - # apply list a0,a1,a2,a3 = ast case a0 when :def! @@ -49,9 +45,9 @@ def EVAL(ast, env) end return EVAL(a2, let_env) else - el = eval_ast(ast, env) - f = el[0] - return f[*el.drop(1)] + f = EVAL(a0, env) + args = ast.drop(1) + return f[*args.map{|a| EVAL(a, env)}] end end diff --git a/impls/ruby/step4_if_fn_do.rb b/impls/ruby/step4_if_fn_do.rb index 204dde6f5d..d0e8983bd7 100644 --- a/impls/ruby/step4_if_fn_do.rb +++ b/impls/ruby/step4_if_fn_do.rb @@ -11,34 +11,30 @@ def READ(str) end # eval -def eval_ast(ast, env) - return case ast +def EVAL(ast, env) + if env.get_or_nil(:"DEBUG-EVAL") + puts "EVAL: #{_pr_str(ast, true)}" + end + + case ast when Symbol - env.get(ast) + return env.get(ast) when List - List.new ast.map{|a| EVAL(a, env)} when Vector - Vector.new ast.map{|a| EVAL(a, env)} + return Vector.new ast.map{|a| EVAL(a, env)} when Hash new_hm = {} ast.each{|k,v| new_hm[k] = EVAL(v, env)} - new_hm + return new_hm else - ast + return ast end -end -def EVAL(ast, env) - #puts "EVAL: #{_pr_str(ast, true)}" - - if not ast.is_a? List - return eval_ast(ast, env) - end + # apply list if ast.empty? return ast end - # apply list a0,a1,a2,a3 = ast case a0 when :def! @@ -50,8 +46,8 @@ def EVAL(ast, env) end return EVAL(a2, let_env) when :do - el = eval_ast(ast.drop(1), env) - return el.last + ast[1..-2].map{|a| EVAL(a, env)} + return EVAL(ast[-1], env) when :if cond = EVAL(a1, env) if not cond @@ -65,9 +61,9 @@ def EVAL(ast, env) EVAL(a2, Env.new(env, a1, List.new(args))) } else - el = eval_ast(ast, env) - f = el[0] - return f[*el.drop(1)] + f = EVAL(a0, env) + args = ast.drop(1) + return f[*args.map{|a| EVAL(a, env)}] end end diff --git a/impls/ruby/step5_tco.rb b/impls/ruby/step5_tco.rb index 06e5767012..f149c4f55f 100644 --- a/impls/ruby/step5_tco.rb +++ b/impls/ruby/step5_tco.rb @@ -11,36 +11,32 @@ def READ(str) end # eval -def eval_ast(ast, env) - return case ast +def EVAL(ast, env) + while true + + if env.get_or_nil(:"DEBUG-EVAL") + puts "EVAL: #{_pr_str(ast, true)}" + end + + case ast when Symbol - env.get(ast) + return env.get(ast) when List - List.new ast.map{|a| EVAL(a, env)} when Vector - Vector.new ast.map{|a| EVAL(a, env)} + return Vector.new ast.map{|a| EVAL(a, env)} when Hash new_hm = {} ast.each{|k,v| new_hm[k] = EVAL(v, env)} - new_hm + return new_hm else - ast + return 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 if ast.empty? return ast end - # apply list a0,a1,a2,a3 = ast case a0 when :def! @@ -53,7 +49,7 @@ def EVAL(ast, env) env = let_env ast = a2 # Continue loop (TCO) when :do - eval_ast(ast[1..-2], env) + ast[1..-2].map{|a| EVAL(a, env)} ast = ast.last # Continue loop (TCO) when :if cond = EVAL(a1, env) @@ -68,13 +64,14 @@ def EVAL(ast, env) EVAL(a2, Env.new(env, a1, List.new(args))) } else - el = eval_ast(ast, env) - f = el[0] + f = EVAL(a0, env) + args = ast.drop(1) if f.class == Function ast = f.ast - env = f.gen_env(el.drop(1)) # Continue loop (TCO) + env = f.gen_env(List.new args.map{|a| EVAL(a, env)}) + # Continue loop (TCO) else - return f[*el.drop(1)] + return f[*args.map{|a| EVAL(a, env)}] end end diff --git a/impls/ruby/step6_file.rb b/impls/ruby/step6_file.rb index ab2b825229..c639926836 100644 --- a/impls/ruby/step6_file.rb +++ b/impls/ruby/step6_file.rb @@ -11,36 +11,32 @@ def READ(str) end # eval -def eval_ast(ast, env) - return case ast +def EVAL(ast, env) + while true + + if env.get_or_nil(:"DEBUG-EVAL") + puts "EVAL: #{_pr_str(ast, true)}" + end + + case ast when Symbol - env.get(ast) + return env.get(ast) when List - List.new ast.map{|a| EVAL(a, env)} when Vector - Vector.new ast.map{|a| EVAL(a, env)} + return Vector.new ast.map{|a| EVAL(a, env)} when Hash new_hm = {} ast.each{|k,v| new_hm[k] = EVAL(v, env)} - new_hm + return new_hm else - ast + return 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 if ast.empty? return ast end - # apply list a0,a1,a2,a3 = ast case a0 when :def! @@ -53,7 +49,7 @@ def EVAL(ast, env) env = let_env ast = a2 # Continue loop (TCO) when :do - eval_ast(ast[1..-2], env) + ast[1..-2].map{|a| EVAL(a, env)} ast = ast.last # Continue loop (TCO) when :if cond = EVAL(a1, env) @@ -68,13 +64,14 @@ def EVAL(ast, env) EVAL(a2, Env.new(env, a1, List.new(args))) } else - el = eval_ast(ast, env) - f = el[0] + f = EVAL(a0, env) + args = ast.drop(1) if f.class == Function ast = f.ast - env = f.gen_env(el.drop(1)) # Continue loop (TCO) + env = f.gen_env(List.new args.map{|a| EVAL(a, env)}) + # Continue loop (TCO) else - return f[*el.drop(1)] + return f[*args.map{|a| EVAL(a, env)}] end end diff --git a/impls/ruby/step7_quote.rb b/impls/ruby/step7_quote.rb index c942fcf74e..a9a4e33ca5 100644 --- a/impls/ruby/step7_quote.rb +++ b/impls/ruby/step7_quote.rb @@ -42,36 +42,32 @@ def quasiquote(ast) end end -def eval_ast(ast, env) - return case ast +def EVAL(ast, env) + while true + + if env.get_or_nil(:"DEBUG-EVAL") + puts "EVAL: #{_pr_str(ast, true)}" + end + + case ast when Symbol - env.get(ast) + return env.get(ast) when List - List.new ast.map{|a| EVAL(a, env)} when Vector - Vector.new ast.map{|a| EVAL(a, env)} + return Vector.new ast.map{|a| EVAL(a, env)} when Hash new_hm = {} ast.each{|k,v| new_hm[k] = EVAL(v, env)} - new_hm + return new_hm else - ast + return 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 if ast.empty? return ast end - # apply list a0,a1,a2,a3 = ast case a0 when :def! @@ -85,12 +81,10 @@ def EVAL(ast, env) ast = a2 # Continue loop (TCO) when :quote return a1 - when :quasiquoteexpand - return quasiquote(a1); when :quasiquote ast = quasiquote(a1); # Continue loop (TCO) when :do - eval_ast(ast[1..-2], env) + ast[1..-2].map{|a| EVAL(a, env)} ast = ast.last # Continue loop (TCO) when :if cond = EVAL(a1, env) @@ -105,13 +99,14 @@ def EVAL(ast, env) EVAL(a2, Env.new(env, a1, List.new(args))) } else - el = eval_ast(ast, env) - f = el[0] + f = EVAL(a0, env) + args = ast.drop(1) if f.class == Function ast = f.ast - env = f.gen_env(el.drop(1)) # Continue loop (TCO) + env = f.gen_env(List.new args.map{|a| EVAL(a, env)}) + # Continue loop (TCO) else - return f[*el.drop(1)] + return f[*args.map{|a| EVAL(a, env)}] end end diff --git a/impls/ruby/step8_macros.rb b/impls/ruby/step8_macros.rb index c1d2db3ebc..01150de4c2 100644 --- a/impls/ruby/step8_macros.rb +++ b/impls/ruby/step8_macros.rb @@ -11,14 +11,10 @@ def READ(str) end # eval -def starts_with(ast, sym) - return ast.is_a?(List) && ast.size == 2 && ast[0] == sym -end - def qq_loop(ast) acc = List.new [] ast.reverse_each do |elt| - if starts_with(elt, :"splice-unquote") + if elt.is_a?(List) && elt.size == 2 && elt[0] == :"splice-unquote" acc = List.new [:concat, elt[1], acc] else acc = List.new [:cons, quasiquote(elt), acc] @@ -30,7 +26,7 @@ def qq_loop(ast) def quasiquote(ast) return case ast when List - if starts_with(ast, :unquote) + if ast.size == 2 && ast[0] == :unquote ast[1] else qq_loop(ast) @@ -46,53 +42,28 @@ def quasiquote(ast) 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 EVAL(ast, env) + while true -def macroexpand(ast, env) - while macro_call?(ast, env) - mac = env.get(ast[0]) - ast = mac[*ast.drop(1)] + if env.get_or_nil(:"DEBUG-EVAL") + puts "EVAL: #{_pr_str(ast, true)}" end - return ast -end -def eval_ast(ast, env) - return case ast + case ast when Symbol - env.get(ast) + return env.get(ast) when List - List.new ast.map{|a| EVAL(a, env)} when Vector - Vector.new ast.map{|a| EVAL(a, env)} + return Vector.new ast.map{|a| EVAL(a, env)} when Hash new_hm = {} ast.each{|k,v| new_hm[k] = EVAL(v, env)} - new_hm + return 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) + return ast 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 @@ -110,18 +81,14 @@ def EVAL(ast, env) ast = a2 # Continue loop (TCO) when :quote return a1 - when :quasiquoteexpand - return quasiquote(a1); when :quasiquote ast = quasiquote(a1); # Continue loop (TCO) when :defmacro! func = EVAL(a2, env).clone func.is_macro = true return env.set(a1, func) - when :macroexpand - return macroexpand(a1, env) when :do - eval_ast(ast[1..-2], env) + ast[1..-2].map{|a| EVAL(a, env)} ast = ast.last # Continue loop (TCO) when :if cond = EVAL(a1, env) @@ -136,13 +103,18 @@ def EVAL(ast, env) EVAL(a2, Env.new(env, a1, List.new(args))) } else - el = eval_ast(ast, env) - f = el[0] + 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(el.drop(1)) # Continue loop (TCO) + env = f.gen_env(List.new args.map{|a| EVAL(a, env)}) + # Continue loop (TCO) else - return f[*el.drop(1)] + return f[*args.map{|a| EVAL(a, env)}] end end diff --git a/impls/ruby/step9_try.rb b/impls/ruby/step9_try.rb index 207ec6cdf4..84357f46cf 100644 --- a/impls/ruby/step9_try.rb +++ b/impls/ruby/step9_try.rb @@ -11,14 +11,10 @@ def READ(str) end # eval -def starts_with(ast, sym) - return ast.is_a?(List) && ast.size == 2 && ast[0] == sym -end - def qq_loop(ast) acc = List.new [] ast.reverse_each do |elt| - if starts_with(elt, :"splice-unquote") + if elt.is_a?(List) && elt.size == 2 && elt[0] == :"splice-unquote" acc = List.new [:concat, elt[1], acc] else acc = List.new [:cons, quasiquote(elt), acc] @@ -30,7 +26,7 @@ def qq_loop(ast) def quasiquote(ast) return case ast when List - if starts_with(ast, :unquote) + if ast.size == 2 && ast[0] == :unquote ast[1] else qq_loop(ast) @@ -46,53 +42,28 @@ def quasiquote(ast) 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 EVAL(ast, env) + while true -def macroexpand(ast, env) - while macro_call?(ast, env) - mac = env.get(ast[0]) - ast = mac[*ast.drop(1)] + if env.get_or_nil(:"DEBUG-EVAL") + puts "EVAL: #{_pr_str(ast, true)}" end - return ast -end -def eval_ast(ast, env) - return case ast + case ast when Symbol - env.get(ast) + return env.get(ast) when List - List.new ast.map{|a| EVAL(a, env)} when Vector - Vector.new ast.map{|a| EVAL(a, env)} + return Vector.new ast.map{|a| EVAL(a, env)} when Hash new_hm = {} ast.each{|k,v| new_hm[k] = EVAL(v, env)} - new_hm + return 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) + return ast 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 @@ -110,16 +81,12 @@ def EVAL(ast, env) ast = a2 # Continue loop (TCO) when :quote return a1 - when :quasiquoteexpand - return quasiquote(a1); when :quasiquote ast = quasiquote(a1); # Continue loop (TCO) when :defmacro! func = EVAL(a2, env).clone func.is_macro = true return env.set(a1, func) - when :macroexpand - return macroexpand(a1, env) when :"try*" begin return EVAL(a1, env) @@ -136,7 +103,7 @@ def EVAL(ast, env) end end when :do - eval_ast(ast[1..-2], env) + ast[1..-2].map{|a| EVAL(a, env)} ast = ast.last # Continue loop (TCO) when :if cond = EVAL(a1, env) @@ -151,13 +118,18 @@ def EVAL(ast, env) EVAL(a2, Env.new(env, a1, List.new(args))) } else - el = eval_ast(ast, env) - f = el[0] + 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(el.drop(1)) # Continue loop (TCO) + env = f.gen_env(List.new args.map{|a| EVAL(a, env)}) + # Continue loop (TCO) else - return f[*el.drop(1)] + return f[*args.map{|a| EVAL(a, env)}] end end diff --git a/impls/ruby/stepA_mal.rb b/impls/ruby/stepA_mal.rb index a43588e0e9..787fb578f0 100644 --- a/impls/ruby/stepA_mal.rb +++ b/impls/ruby/stepA_mal.rb @@ -11,14 +11,10 @@ def READ(str) end # eval -def starts_with(ast, sym) - return ast.is_a?(List) && ast.size == 2 && ast[0] == sym -end - def qq_loop(ast) acc = List.new [] ast.reverse_each do |elt| - if starts_with(elt, :"splice-unquote") + if elt.is_a?(List) && elt.size == 2 && elt[0] == :"splice-unquote" acc = List.new [:concat, elt[1], acc] else acc = List.new [:cons, quasiquote(elt), acc] @@ -30,7 +26,7 @@ def qq_loop(ast) def quasiquote(ast) return case ast when List - if starts_with(ast, :unquote) + if ast.size == 2 && ast[0] == :unquote ast[1] else qq_loop(ast) @@ -46,53 +42,28 @@ def quasiquote(ast) 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 EVAL(ast, env) + while true -def macroexpand(ast, env) - while macro_call?(ast, env) - mac = env.get(ast[0]) - ast = mac[*ast.drop(1)] + if env.get_or_nil(:"DEBUG-EVAL") + puts "EVAL: #{_pr_str(ast, true)}" end - return ast -end -def eval_ast(ast, env) - return case ast + case ast when Symbol - env.get(ast) + return env.get(ast) when List - List.new ast.map{|a| EVAL(a, env)} when Vector - Vector.new ast.map{|a| EVAL(a, env)} + return Vector.new ast.map{|a| EVAL(a, env)} when Hash new_hm = {} ast.each{|k,v| new_hm[k] = EVAL(v, env)} - new_hm + return 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) + return ast 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 @@ -110,16 +81,12 @@ def EVAL(ast, env) ast = a2 # Continue loop (TCO) when :quote return a1 - when :quasiquoteexpand - return quasiquote(a1); when :quasiquote ast = quasiquote(a1); # Continue loop (TCO) when :defmacro! func = EVAL(a2, env).clone func.is_macro = true return env.set(a1, func) - when :macroexpand - return macroexpand(a1, env) when :"rb*" res = eval(a1) return case res @@ -142,7 +109,7 @@ def EVAL(ast, env) end end when :do - eval_ast(ast[1..-2], env) + ast[1..-2].map{|a| EVAL(a, env)} ast = ast.last # Continue loop (TCO) when :if cond = EVAL(a1, env) @@ -157,13 +124,18 @@ def EVAL(ast, env) EVAL(a2, Env.new(env, a1, List.new(args))) } else - el = eval_ast(ast, env) - f = el[0] + 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(el.drop(1)) # Continue loop (TCO) + env = f.gen_env(List.new args.map{|a| EVAL(a, env)}) + # Continue loop (TCO) else - return f[*el.drop(1)] + return f[*args.map{|a| EVAL(a, env)}] end end diff --git a/impls/rust/env.rs b/impls/rust/env.rs index 27e77b4249..d1dfc96429 100644 --- a/impls/rust/env.rs +++ b/impls/rust/env.rs @@ -47,26 +47,13 @@ pub fn env_bind(outer: Option, mbinds: MalVal, exprs: Vec) -> Resul } } -pub fn env_find(env: &Env, key: &str) -> Option { - match (env.data.borrow().contains_key(key), env.outer.clone()) { - (true, _) => Some(env.clone()), - (false, Some(o)) => env_find(&o, key), - _ => None, - } -} - -pub fn env_get(env: &Env, key: &MalVal) -> MalRet { - match key { - Sym(ref s) => match env_find(env, s) { - Some(e) => Ok(e - .data - .borrow() - .get(s) - .ok_or(ErrString(format!("'{}' not found", s)))? - .clone()), - _ => error(&format!("'{}' not found", s)), - }, - _ => error("Env.get called with non-Str"), +pub fn env_get(env: &Env, key: &str) -> Option { + match env.data.borrow().get(key) { + Some(value) => Some(value.clone()), + None => match &env.outer { + None => None, + Some(outer) => env_get(&outer, key), + } } } diff --git a/impls/rust/step2_eval.rs b/impls/rust/step2_eval.rs index d19e8382d5..9bd190de09 100644 --- a/impls/rust/step2_eval.rs +++ b/impls/rust/step2_eval.rs @@ -32,25 +32,27 @@ fn read(str: &str) -> MalRet { } // eval -fn eval_ast(ast: &MalVal, env: &Env) -> MalRet { +fn eval_ast(v: &MalArgs, env: &Env) -> Result { + let mut lst: MalArgs = vec![]; + for a in v.iter() { + match eval(a.clone(), env.clone()) { + Ok(elt) => lst.push(elt), + Err(e) => return Err(e), + } + } + return Ok(lst); +} + +fn eval(ast: MalVal, env: Env) -> MalRet { + // println!("EVAL: {}", print(&ast)), match ast { Sym(sym) => Ok(env - .get(sym) + .get(&sym) .ok_or(ErrString(format!("'{}' not found", sym)))? .clone()), - List(v, _) => { - let mut lst: MalArgs = vec![]; - for a in v.iter() { - lst.push(eval(a.clone(), env.clone())?) - } - Ok(list!(lst)) - } - Vector(v, _) => { - let mut lst: MalArgs = vec![]; - for a in v.iter() { - lst.push(eval(a.clone(), env.clone())?) - } - Ok(vector!(lst)) + Vector(ref v, _) => match eval_ast(&v, &env) { + Ok(lst) => Ok(vector!(lst)), + Err(e) => Err(e), } Hash(hm, _) => { let mut new_hm: FnvHashMap = FnvHashMap::default(); @@ -59,25 +61,19 @@ fn eval_ast(ast: &MalVal, env: &Env) -> MalRet { } Ok(Hash(Rc::new(new_hm), Rc::new(Nil))) } - _ => Ok(ast.clone()), - } -} - -fn eval(ast: MalVal, env: Env) -> MalRet { - match ast.clone() { - List(l, _) => { + List(ref l, _) => { if l.len() == 0 { return Ok(ast); } - match eval_ast(&ast, &env)? { - List(ref el, _) => { + match eval_ast(&l, &env) { + Ok(el) => { let ref f = el[0].clone(); f.apply(el[1..].to_vec()) } - _ => error("expected a list"), + Err(e) => return Err(e), } } - _ => eval_ast(&ast, &env), + _ => Ok(ast), } } diff --git a/impls/rust/step3_env.rs b/impls/rust/step3_env.rs index f7fa56652b..354eabd27a 100644 --- a/impls/rust/step3_env.rs +++ b/impls/rust/step3_env.rs @@ -16,7 +16,7 @@ use rustyline::Editor; #[macro_use] #[allow(dead_code)] mod types; -use crate::types::MalVal::{Hash, Int, List, Nil, Sym, Vector}; +use crate::types::MalVal::{Bool, Hash, Int, List, Nil, Sym, Vector}; use crate::types::{error, format_error, func, MalArgs, MalErr, MalRet, MalVal}; mod env; mod printer; @@ -29,22 +29,30 @@ fn read(str: &str) -> MalRet { } // eval -fn eval_ast(ast: &MalVal, env: &Env) -> MalRet { - match ast { - Sym(_) => Ok(env_get(&env, &ast)?), - List(v, _) => { +fn eval_ast(v: &MalArgs, env: &Env) -> Result { let mut lst: MalArgs = vec![]; for a in v.iter() { - lst.push(eval(a.clone(), env.clone())?) + match eval(a.clone(), env.clone()) { + Ok(elt) => lst.push(elt), + Err(e) => return Err(e), + } } - Ok(list!(lst)) + return Ok(lst); +} + +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(ref 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.clone(), env.clone())?) - } - Ok(vector!(lst)) + Vector(ref v, _) => match eval_ast(&v, &env) { + Ok(lst) => Ok(vector!(lst)), + Err(e) => Err(e), } Hash(hm, _) => { let mut new_hm: FnvHashMap = FnvHashMap::default(); @@ -53,13 +61,7 @@ fn eval_ast(ast: &MalVal, env: &Env) -> MalRet { } Ok(Hash(Rc::new(new_hm), Rc::new(Nil))) } - _ => Ok(ast.clone()), - } -} - -fn eval(ast: MalVal, env: Env) -> MalRet { - match ast.clone() { - List(l, _) => { + List(ref l, _) => { if l.len() == 0 { return Ok(ast); } @@ -94,16 +96,16 @@ fn eval(ast: MalVal, env: Env) -> MalRet { }; eval(a2, let_env) } - _ => match eval_ast(&ast, &env)? { - List(ref el, _) => { + _ => match eval_ast(&l, &env) { + Ok(el) => { let ref f = el[0].clone(); f.apply(el[1..].to_vec()) } - _ => error("expected a list"), + Err(e) => return Err(e), }, } } - _ => eval_ast(&ast, &env), + _ => Ok(ast), } } diff --git a/impls/rust/step4_if_fn_do.rs b/impls/rust/step4_if_fn_do.rs index a21223a5f8..b0ddf457ac 100644 --- a/impls/rust/step4_if_fn_do.rs +++ b/impls/rust/step4_if_fn_do.rs @@ -30,22 +30,30 @@ fn read(str: &str) -> MalRet { } // eval -fn eval_ast(ast: &MalVal, env: &Env) -> MalRet { - match ast { - Sym(_) => Ok(env_get(&env, &ast)?), - List(v, _) => { +fn eval_ast(v: &MalArgs, env: &Env) -> Result { let mut lst: MalArgs = vec![]; for a in v.iter() { - lst.push(eval(a.clone(), env.clone())?) + match eval(a.clone(), env.clone()) { + Ok(elt) => lst.push(elt), + Err(e) => return Err(e), + } } - Ok(list!(lst)) + return Ok(lst); +} + +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(ref 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.clone(), env.clone())?) - } - Ok(vector!(lst)) + Vector(ref v, _) => match eval_ast(&v, &env) { + Ok(lst) => Ok(vector!(lst)), + Err(e) => Err(e), } Hash(hm, _) => { let mut new_hm: FnvHashMap = FnvHashMap::default(); @@ -54,13 +62,7 @@ fn eval_ast(ast: &MalVal, env: &Env) -> MalRet { } Ok(Hash(Rc::new(new_hm), Rc::new(Nil))) } - _ => Ok(ast.clone()), - } -} - -fn eval(ast: MalVal, env: Env) -> MalRet { - match ast.clone() { - List(l, _) => { + List(ref l, _) => { if l.len() == 0 { return Ok(ast); } @@ -95,10 +97,12 @@ fn eval(ast: MalVal, env: Env) -> MalRet { }; eval(a2, let_env) } - Sym(ref a0sym) if a0sym == "do" => match eval_ast(&list!(l[1..].to_vec()), &env)? { - List(el, _) => Ok(el.last().unwrap_or(&Nil).clone()), - _ => error("invalid do form"), - }, + Sym(ref a0sym) if a0sym == "do" => { + match eval_ast(&l[1..l.len() - 1].to_vec(), &env) { + Ok(_) => return eval(l.last().unwrap_or(&Nil).clone(), env), + Err(e) => return Err(e), + } + } Sym(ref a0sym) if a0sym == "if" => { let cond = eval(l[1].clone(), env.clone())?; match cond { @@ -119,16 +123,16 @@ fn eval(ast: MalVal, env: Env) -> MalRet { meta: Rc::new(Nil), }) } - _ => match eval_ast(&ast, &env)? { - List(ref el, _) => { + _ => match eval_ast(&l, &env) { + Ok(el) => { let ref f = el[0].clone(); f.apply(el[1..].to_vec()) } - _ => error("expected a list"), + Err(e) => return Err(e), }, } } - _ => eval_ast(&ast, &env), + _ => Ok(ast), } } diff --git a/impls/rust/step5_tco.rs b/impls/rust/step5_tco.rs index 185b8df5ef..b9cb5ede6b 100644 --- a/impls/rust/step5_tco.rs +++ b/impls/rust/step5_tco.rs @@ -30,22 +30,33 @@ fn read(str: &str) -> MalRet { } // eval -fn eval_ast(ast: &MalVal, env: &Env) -> MalRet { - match ast { - Sym(_) => Ok(env_get(&env, &ast)?), - List(v, _) => { +fn eval_ast(v: &MalArgs, env: &Env) -> Result { let mut lst: MalArgs = vec![]; for a in v.iter() { - lst.push(eval(a.clone(), env.clone())?) + match eval(a.clone(), env.clone()) { + Ok(elt) => lst.push(elt), + Err(e) => return Err(e), + } } - Ok(list!(lst)) + return Ok(lst); +} + +fn eval(mut ast: MalVal, mut env: Env) -> MalRet { + let ret: MalRet; + + 'tco: loop { + match env_get(&env, "DEBUG-EVAL") { + None | Some(Bool(false)) | Some(Nil) => (), + _ => println!("EVAL: {}", print(&ast)), } - Vector(v, _) => { - let mut lst: MalArgs = vec![]; - for a in v.iter() { - lst.push(eval(a.clone(), env.clone())?) - } - Ok(vector!(lst)) + ret = match ast { + Sym(ref s) => match env_get(&env, s) { + Some(r) => Ok(r), + None => error (&format!("'{}' not found", s)), + } + Vector(ref v, _) => match eval_ast(&v, &env) { + Ok(lst) => Ok(vector!(lst)), + Err(e) => Err(e), } Hash(hm, _) => { let mut new_hm: FnvHashMap = FnvHashMap::default(); @@ -54,16 +65,7 @@ fn eval_ast(ast: &MalVal, env: &Env) -> MalRet { } Ok(Hash(Rc::new(new_hm), Rc::new(Nil))) } - _ => Ok(ast.clone()), - } -} - -fn eval(mut ast: MalVal, mut env: Env) -> MalRet { - let ret: MalRet; - - 'tco: loop { - ret = match ast.clone() { - List(l, _) => { + List(ref l, _) => { if l.len() == 0 { return Ok(ast); } @@ -100,12 +102,12 @@ fn eval(mut ast: MalVal, mut env: Env) -> MalRet { continue 'tco; } Sym(ref a0sym) if a0sym == "do" => { - match eval_ast(&list!(l[1..l.len() - 1].to_vec()), &env)? { - List(_, _) => { + match eval_ast(&l[1..l.len() - 1].to_vec(), &env) { + Ok(_) => { ast = l.last().unwrap_or(&Nil).clone(); continue 'tco; } - _ => error("invalid do form"), + Err(e) => return Err(e), } } Sym(ref a0sym) if a0sym == "if" => { @@ -134,8 +136,8 @@ fn eval(mut ast: MalVal, mut env: Env) -> MalRet { meta: Rc::new(Nil), }) } - _ => match eval_ast(&ast, &env)? { - List(ref el, _) => { + _ => match eval_ast(&l, &env) { + Ok(el) => { let ref f = el[0].clone(); let args = el[1..].to_vec(); match f { @@ -155,11 +157,11 @@ fn eval(mut ast: MalVal, mut env: Env) -> MalRet { _ => error("attempt to call non-function"), } } - _ => error("expected a list"), + Err(e) => return Err(e), }, } - } - _ => eval_ast(&ast, &env), + } + _ => Ok(ast.clone()), }; break; diff --git a/impls/rust/step6_file.rs b/impls/rust/step6_file.rs index 84e3c2bc1b..a3e2b53c97 100644 --- a/impls/rust/step6_file.rs +++ b/impls/rust/step6_file.rs @@ -30,22 +30,33 @@ fn read(str: &str) -> MalRet { } // eval -fn eval_ast(ast: &MalVal, env: &Env) -> MalRet { - match ast { - Sym(_) => Ok(env_get(&env, &ast)?), - List(v, _) => { +fn eval_ast(v: &MalArgs, env: &Env) -> Result { let mut lst: MalArgs = vec![]; for a in v.iter() { - lst.push(eval(a.clone(), env.clone())?) + match eval(a.clone(), env.clone()) { + Ok(elt) => lst.push(elt), + Err(e) => return Err(e), + } } - Ok(list!(lst)) + return Ok(lst); +} + +fn eval(mut ast: MalVal, mut env: Env) -> MalRet { + let ret: MalRet; + + 'tco: loop { + match env_get(&env, "DEBUG-EVAL") { + None | Some(Bool(false)) | Some(Nil) => (), + _ => println!("EVAL: {}", print(&ast)), } - Vector(v, _) => { - let mut lst: MalArgs = vec![]; - for a in v.iter() { - lst.push(eval(a.clone(), env.clone())?) - } - Ok(vector!(lst)) + ret = match ast { + Sym(ref s) => match env_get(&env, s) { + Some(r) => Ok(r), + None => error (&format!("'{}' not found", s)), + } + Vector(ref v, _) => match eval_ast(&v, &env) { + Ok(lst) => Ok(vector!(lst)), + Err(e) => Err(e), } Hash(hm, _) => { let mut new_hm: FnvHashMap = FnvHashMap::default(); @@ -54,16 +65,7 @@ fn eval_ast(ast: &MalVal, env: &Env) -> MalRet { } Ok(Hash(Rc::new(new_hm), Rc::new(Nil))) } - _ => Ok(ast.clone()), - } -} - -fn eval(mut ast: MalVal, mut env: Env) -> MalRet { - let ret: MalRet; - - 'tco: loop { - ret = match ast.clone() { - List(l, _) => { + List(ref l, _) => { if l.len() == 0 { return Ok(ast); } @@ -100,12 +102,12 @@ fn eval(mut ast: MalVal, mut env: Env) -> MalRet { continue 'tco; } Sym(ref a0sym) if a0sym == "do" => { - match eval_ast(&list!(l[1..l.len() - 1].to_vec()), &env)? { - List(_, _) => { + match eval_ast(&l[1..l.len() - 1].to_vec(), &env) { + Ok(_) => { ast = l.last().unwrap_or(&Nil).clone(); continue 'tco; } - _ => error("invalid do form"), + Err(e) => return Err(e), } } Sym(ref a0sym) if a0sym == "if" => { @@ -141,8 +143,8 @@ fn eval(mut ast: MalVal, mut env: Env) -> MalRet { } continue 'tco; } - _ => match eval_ast(&ast, &env)? { - List(ref el, _) => { + _ => match eval_ast(&l, &env) { + Ok(el) => { let ref f = el[0].clone(); let args = el[1..].to_vec(); match f { @@ -162,11 +164,11 @@ fn eval(mut ast: MalVal, mut env: Env) -> MalRet { _ => error("attempt to call non-function"), } } - _ => error("expected a list"), + Err(e) => return Err(e), }, } - } - _ => eval_ast(&ast, &env), + } + _ => Ok(ast.clone()), }; break; diff --git a/impls/rust/step7_quote.rs b/impls/rust/step7_quote.rs index 374128a8d1..f7ac8d3081 100644 --- a/impls/rust/step7_quote.rs +++ b/impls/rust/step7_quote.rs @@ -67,22 +67,33 @@ fn quasiquote(ast: &MalVal) -> MalVal { } } -fn eval_ast(ast: &MalVal, env: &Env) -> MalRet { - match ast { - Sym(_) => Ok(env_get(&env, &ast)?), - List(v, _) => { +fn eval_ast(v: &MalArgs, env: &Env) -> Result { let mut lst: MalArgs = vec![]; for a in v.iter() { - lst.push(eval(a.clone(), env.clone())?) + match eval(a.clone(), env.clone()) { + Ok(elt) => lst.push(elt), + Err(e) => return Err(e), + } } - Ok(list!(lst)) + return Ok(lst); +} + +fn eval(mut ast: MalVal, mut env: Env) -> MalRet { + let ret: MalRet; + + 'tco: loop { + match env_get(&env, "DEBUG-EVAL") { + None | Some(Bool(false)) | Some(Nil) => (), + _ => println!("EVAL: {}", print(&ast)), } - Vector(v, _) => { - let mut lst: MalArgs = vec![]; - for a in v.iter() { - lst.push(eval(a.clone(), env.clone())?) - } - Ok(vector!(lst)) + ret = match ast { + Sym(ref s) => match env_get(&env, s) { + Some(r) => Ok(r), + None => error (&format!("'{}' not found", s)), + } + Vector(ref v, _) => match eval_ast(&v, &env) { + Ok(lst) => Ok(vector!(lst)), + Err(e) => Err(e), } Hash(hm, _) => { let mut new_hm: FnvHashMap = FnvHashMap::default(); @@ -91,16 +102,7 @@ fn eval_ast(ast: &MalVal, env: &Env) -> MalRet { } Ok(Hash(Rc::new(new_hm), Rc::new(Nil))) } - _ => Ok(ast.clone()), - } -} - -fn eval(mut ast: MalVal, mut env: Env) -> MalRet { - let ret: MalRet; - - 'tco: loop { - ret = match ast.clone() { - List(l, _) => { + List(ref l, _) => { if l.len() == 0 { return Ok(ast); } @@ -137,18 +139,17 @@ fn eval(mut ast: MalVal, mut env: Env) -> MalRet { continue 'tco; } Sym(ref a0sym) if a0sym == "quote" => Ok(l[1].clone()), - Sym(ref a0sym) if a0sym == "quasiquoteexpand" => Ok(quasiquote(&l[1])), Sym(ref a0sym) if a0sym == "quasiquote" => { ast = quasiquote(&l[1]); continue 'tco; } Sym(ref a0sym) if a0sym == "do" => { - match eval_ast(&list!(l[1..l.len() - 1].to_vec()), &env)? { - List(_, _) => { + match eval_ast(&l[1..l.len() - 1].to_vec(), &env) { + Ok(_) => { ast = l.last().unwrap_or(&Nil).clone(); continue 'tco; } - _ => error("invalid do form"), + Err(e) => return Err(e), } } Sym(ref a0sym) if a0sym == "if" => { @@ -184,8 +185,8 @@ fn eval(mut ast: MalVal, mut env: Env) -> MalRet { } continue 'tco; } - _ => match eval_ast(&ast, &env)? { - List(ref el, _) => { + _ => match eval_ast(&l, &env) { + Ok(el) => { let ref f = el[0].clone(); let args = el[1..].to_vec(); match f { @@ -205,11 +206,11 @@ fn eval(mut ast: MalVal, mut env: Env) -> MalRet { _ => error("attempt to call non-function"), } } - _ => error("expected a list"), + Err(e) => return Err(e), }, } - } - _ => eval_ast(&ast, &env), + } + _ => Ok(ast.clone()), }; break; diff --git a/impls/rust/step8_macros.rs b/impls/rust/step8_macros.rs index 8808f0e155..6309107617 100644 --- a/impls/rust/step8_macros.rs +++ b/impls/rust/step8_macros.rs @@ -20,7 +20,7 @@ use crate::types::{error, format_error, MalArgs, MalErr, MalRet, MalVal}; mod env; mod printer; mod reader; -use crate::env::{env_bind, env_find, env_get, env_new, env_set, env_sets, Env}; +use crate::env::{env_bind, env_get, env_new, env_set, env_sets, Env}; #[macro_use] mod core; @@ -67,52 +67,33 @@ fn quasiquote(ast: &MalVal) -> MalVal { } } -fn is_macro_call(ast: &MalVal, env: &Env) -> Option<(MalVal, MalArgs)> { - match ast { - List(v, _) => match v[0] { - Sym(ref s) => match env_find(env, s) { - Some(e) => match env_get(&e, &v[0]) { - Ok(f @ MalFunc { is_macro: true, .. }) => Some((f, v[1..].to_vec())), - _ => None, - }, - _ => None, - }, - _ => None, - }, - _ => None, - } -} - -fn macroexpand(mut ast: MalVal, env: &Env) -> (bool, MalRet) { - let mut was_expanded = false; - while let Some((mf, args)) = is_macro_call(&ast, env) { - //println!("macroexpand 1: {:?}", ast); - ast = match mf.apply(args) { - Err(e) => return (false, Err(e)), - Ok(a) => a, - }; - //println!("macroexpand 2: {:?}", ast); - was_expanded = true; - } - ((was_expanded, Ok(ast))) -} - -fn eval_ast(ast: &MalVal, env: &Env) -> MalRet { - match ast { - Sym(_) => Ok(env_get(&env, &ast)?), - List(v, _) => { +fn eval_ast(v: &MalArgs, env: &Env) -> Result { let mut lst: MalArgs = vec![]; for a in v.iter() { - lst.push(eval(a.clone(), env.clone())?) + match eval(a.clone(), env.clone()) { + Ok(elt) => lst.push(elt), + Err(e) => return Err(e), + } } - Ok(list!(lst)) + return Ok(lst); +} + +fn eval(mut ast: MalVal, mut env: Env) -> MalRet { + let ret: MalRet; + + 'tco: loop { + match env_get(&env, "DEBUG-EVAL") { + None | Some(Bool(false)) | Some(Nil) => (), + _ => println!("EVAL: {}", print(&ast)), } - Vector(v, _) => { - let mut lst: MalArgs = vec![]; - for a in v.iter() { - lst.push(eval(a.clone(), env.clone())?) - } - Ok(vector!(lst)) + ret = match ast { + Sym(ref s) => match env_get(&env, s) { + Some(r) => Ok(r), + None => error (&format!("'{}' not found", s)), + } + Vector(ref v, _) => match eval_ast(&v, &env) { + Ok(lst) => Ok(vector!(lst)), + Err(e) => Err(e), } Hash(hm, _) => { let mut new_hm: FnvHashMap = FnvHashMap::default(); @@ -121,28 +102,7 @@ fn eval_ast(ast: &MalVal, env: &Env) -> MalRet { } Ok(Hash(Rc::new(new_hm), Rc::new(Nil))) } - _ => Ok(ast.clone()), - } -} - -fn eval(mut ast: MalVal, mut env: Env) -> MalRet { - let ret: MalRet; - - 'tco: loop { - ret = match ast.clone() { - List(l, _) => { - if l.len() == 0 { - return Ok(ast); - } - match macroexpand(ast.clone(), &env) { - (true, Ok(new_ast)) => { - ast = new_ast; - continue 'tco; - } - (_, Err(e)) => return Err(e), - _ => (), - } - + List(ref l, _) => { if l.len() == 0 { return Ok(ast); } @@ -179,7 +139,6 @@ fn eval(mut ast: MalVal, mut env: Env) -> MalRet { continue 'tco; } Sym(ref a0sym) if a0sym == "quote" => Ok(l[1].clone()), - Sym(ref a0sym) if a0sym == "quasiquoteexpand" => Ok(quasiquote(&l[1])), Sym(ref a0sym) if a0sym == "quasiquote" => { ast = quasiquote(&l[1]); continue 'tco; @@ -209,19 +168,13 @@ fn eval(mut ast: MalVal, mut env: Env) -> MalRet { _ => error("set_macro on non-function"), } } - Sym(ref a0sym) if a0sym == "macroexpand" => { - match macroexpand(l[1].clone(), &env) { - (_, Ok(new_ast)) => Ok(new_ast), - (_, e) => return e, - } - } Sym(ref a0sym) if a0sym == "do" => { - match eval_ast(&list!(l[1..l.len() - 1].to_vec()), &env)? { - List(_, _) => { + match eval_ast(&l[1..l.len() - 1].to_vec(), &env) { + Ok(_) => { ast = l.last().unwrap_or(&Nil).clone(); continue 'tco; } - _ => error("invalid do form"), + Err(e) => return Err(e), } } Sym(ref a0sym) if a0sym == "if" => { @@ -257,32 +210,39 @@ fn eval(mut ast: MalVal, mut env: Env) -> MalRet { } continue 'tco; } - _ => match eval_ast(&ast, &env)? { - List(ref el, _) => { - let ref f = el[0].clone(); - let args = el[1..].to_vec(); - match f { - Func(_, _) => f.apply(args), - MalFunc { - ast: mast, - env: menv, - params, + _ => match eval(a0.clone(), env.clone()) { + Ok(f @ MalFunc { is_macro: true, .. }) => match f.apply(l[1..].to_vec()) { + Ok(new_ast) => { + ast = new_ast; + continue 'tco; + } + Err(e) => return Err(e), + } + Ok(f @ Func(_, _)) => match eval_ast(&l[1..].to_vec(), &env) { + Ok(args) => f.apply(args), + Err(e) => return Err(e), + } + Ok(MalFunc { + ast: ref mast, + env: ref menv, + params : ref mparams, .. - } => { + }) => match eval_ast(&l[1..].to_vec(), &env) { + Ok(args) => { let a = &**mast; - let p = &**params; - env = env_bind(Some(menv.clone()), p.clone(), args)?; + let p = &**mparams; + env = env_bind(Some(menv.clone()), p.clone(), args.to_vec())?; ast = a.clone(); continue 'tco; + } + Err(e) => return Err(e), } - _ => error("attempt to call non-function"), - } - } - _ => error("expected a list"), + Ok(_) => error("attempt to call non-function"), + Err(e) => return Err(e), }, } - } - _ => eval_ast(&ast, &env), + } + _ => Ok(ast.clone()), }; break; diff --git a/impls/rust/step9_try.rs b/impls/rust/step9_try.rs index 63b908224c..f71893ab53 100644 --- a/impls/rust/step9_try.rs +++ b/impls/rust/step9_try.rs @@ -21,7 +21,7 @@ use crate::types::{error, format_error, MalArgs, MalErr, MalRet, MalVal}; mod env; mod printer; mod reader; -use crate::env::{env_bind, env_find, env_get, env_new, env_set, env_sets, Env}; +use crate::env::{env_bind, env_get, env_new, env_set, env_sets, Env}; #[macro_use] mod core; @@ -68,52 +68,33 @@ fn quasiquote(ast: &MalVal) -> MalVal { } } -fn is_macro_call(ast: &MalVal, env: &Env) -> Option<(MalVal, MalArgs)> { - match ast { - List(v, _) => match v[0] { - Sym(ref s) => match env_find(env, s) { - Some(e) => match env_get(&e, &v[0]) { - Ok(f @ MalFunc { is_macro: true, .. }) => Some((f, v[1..].to_vec())), - _ => None, - }, - _ => None, - }, - _ => None, - }, - _ => None, - } -} - -fn macroexpand(mut ast: MalVal, env: &Env) -> (bool, MalRet) { - let mut was_expanded = false; - while let Some((mf, args)) = is_macro_call(&ast, env) { - //println!("macroexpand 1: {:?}", ast); - ast = match mf.apply(args) { - Err(e) => return (false, Err(e)), - Ok(a) => a, - }; - //println!("macroexpand 2: {:?}", ast); - was_expanded = true; - } - ((was_expanded, Ok(ast))) -} - -fn eval_ast(ast: &MalVal, env: &Env) -> MalRet { - match ast { - Sym(_) => Ok(env_get(&env, &ast)?), - List(v, _) => { +fn eval_ast(v: &MalArgs, env: &Env) -> Result { let mut lst: MalArgs = vec![]; for a in v.iter() { - lst.push(eval(a.clone(), env.clone())?) + match eval(a.clone(), env.clone()) { + Ok(elt) => lst.push(elt), + Err(e) => return Err(e), + } } - Ok(list!(lst)) + return Ok(lst); +} + +fn eval(mut ast: MalVal, mut env: Env) -> MalRet { + let ret: MalRet; + + 'tco: loop { + match env_get(&env, "DEBUG-EVAL") { + None | Some(Bool(false)) | Some(Nil) => (), + _ => println!("EVAL: {}", print(&ast)), } - Vector(v, _) => { - let mut lst: MalArgs = vec![]; - for a in v.iter() { - lst.push(eval(a.clone(), env.clone())?) - } - Ok(vector!(lst)) + ret = match ast { + Sym(ref s) => match env_get(&env, s) { + Some(r) => Ok(r), + None => error (&format!("'{}' not found", s)), + } + Vector(ref v, _) => match eval_ast(&v, &env) { + Ok(lst) => Ok(vector!(lst)), + Err(e) => Err(e), } Hash(hm, _) => { let mut new_hm: FnvHashMap = FnvHashMap::default(); @@ -122,28 +103,7 @@ fn eval_ast(ast: &MalVal, env: &Env) -> MalRet { } Ok(Hash(Rc::new(new_hm), Rc::new(Nil))) } - _ => Ok(ast.clone()), - } -} - -fn eval(mut ast: MalVal, mut env: Env) -> MalRet { - let ret: MalRet; - - 'tco: loop { - ret = match ast.clone() { - List(l, _) => { - if l.len() == 0 { - return Ok(ast); - } - match macroexpand(ast.clone(), &env) { - (true, Ok(new_ast)) => { - ast = new_ast; - continue 'tco; - } - (_, Err(e)) => return Err(e), - _ => (), - } - + List(ref l, _) => { if l.len() == 0 { return Ok(ast); } @@ -180,7 +140,6 @@ fn eval(mut ast: MalVal, mut env: Env) -> MalRet { continue 'tco; } Sym(ref a0sym) if a0sym == "quote" => Ok(l[1].clone()), - Sym(ref a0sym) if a0sym == "quasiquoteexpand" => Ok(quasiquote(&l[1])), Sym(ref a0sym) if a0sym == "quasiquote" => { ast = quasiquote(&l[1]); continue 'tco; @@ -210,12 +169,6 @@ fn eval(mut ast: MalVal, mut env: Env) -> MalRet { _ => error("set_macro on non-function"), } } - Sym(ref a0sym) if a0sym == "macroexpand" => { - match macroexpand(l[1].clone(), &env) { - (_, Ok(new_ast)) => Ok(new_ast), - (_, e) => return e, - } - } Sym(ref a0sym) if a0sym == "try*" => match eval(l[1].clone(), env.clone()) { Err(ref e) if l.len() >= 3 => { let exc = match e { @@ -237,12 +190,12 @@ fn eval(mut ast: MalVal, mut env: Env) -> MalRet { res => res, }, Sym(ref a0sym) if a0sym == "do" => { - match eval_ast(&list!(l[1..l.len() - 1].to_vec()), &env)? { - List(_, _) => { + match eval_ast(&l[1..l.len() - 1].to_vec(), &env) { + Ok(_) => { ast = l.last().unwrap_or(&Nil).clone(); continue 'tco; } - _ => error("invalid do form"), + Err(e) => return Err(e), } } Sym(ref a0sym) if a0sym == "if" => { @@ -278,32 +231,39 @@ fn eval(mut ast: MalVal, mut env: Env) -> MalRet { } continue 'tco; } - _ => match eval_ast(&ast, &env)? { - List(ref el, _) => { - let ref f = el[0].clone(); - let args = el[1..].to_vec(); - match f { - Func(_, _) => f.apply(args), - MalFunc { - ast: mast, - env: menv, - params, + _ => match eval(a0.clone(), env.clone()) { + Ok(f @ MalFunc { is_macro: true, .. }) => match f.apply(l[1..].to_vec()) { + Ok(new_ast) => { + ast = new_ast; + continue 'tco; + } + Err(e) => return Err(e), + } + Ok(f @ Func(_, _)) => match eval_ast(&l[1..].to_vec(), &env) { + Ok(args) => f.apply(args), + Err(e) => return Err(e), + } + Ok(MalFunc { + ast: ref mast, + env: ref menv, + params : ref mparams, .. - } => { + }) => match eval_ast(&l[1..].to_vec(), &env) { + Ok(args) => { let a = &**mast; - let p = &**params; - env = env_bind(Some(menv.clone()), p.clone(), args)?; + let p = &**mparams; + env = env_bind(Some(menv.clone()), p.clone(), args.to_vec())?; ast = a.clone(); continue 'tco; + } + Err(e) => return Err(e), } - _ => error("attempt to call non-function"), - } - } - _ => error("expected a list"), + Ok(_) => error("attempt to call non-function"), + Err(e) => return Err(e), }, } - } - _ => eval_ast(&ast, &env), + } + _ => Ok(ast.clone()), }; break; diff --git a/impls/rust/stepA_mal.rs b/impls/rust/stepA_mal.rs index 6b86d6b5b2..3d1bb97d7e 100644 --- a/impls/rust/stepA_mal.rs +++ b/impls/rust/stepA_mal.rs @@ -23,7 +23,7 @@ use crate::types::{error, format_error, MalArgs, MalErr, MalRet, MalVal}; mod env; mod printer; mod reader; -use crate::env::{env_bind, env_find, env_get, env_new, env_set, env_sets, Env}; +use crate::env::{env_bind, env_get, env_new, env_set, env_sets, Env}; #[macro_use] mod core; @@ -70,52 +70,33 @@ fn quasiquote(ast: &MalVal) -> MalVal { } } -fn is_macro_call(ast: &MalVal, env: &Env) -> Option<(MalVal, MalArgs)> { - match ast { - List(v, _) => match v[0] { - Sym(ref s) => match env_find(env, s) { - Some(e) => match env_get(&e, &v[0]) { - Ok(f @ MalFunc { is_macro: true, .. }) => Some((f, v[1..].to_vec())), - _ => None, - }, - _ => None, - }, - _ => None, - }, - _ => None, - } -} - -fn macroexpand(mut ast: MalVal, env: &Env) -> (bool, MalRet) { - let mut was_expanded = false; - while let Some((mf, args)) = is_macro_call(&ast, env) { - //println!("macroexpand 1: {:?}", ast); - ast = match mf.apply(args) { - Err(e) => return (false, Err(e)), - Ok(a) => a, - }; - //println!("macroexpand 2: {:?}", ast); - was_expanded = true; - } - ((was_expanded, Ok(ast))) -} - -fn eval_ast(ast: &MalVal, env: &Env) -> MalRet { - match ast { - Sym(_) => Ok(env_get(&env, &ast)?), - List(v, _) => { +fn eval_ast(v: &MalArgs, env: &Env) -> Result { let mut lst: MalArgs = vec![]; for a in v.iter() { - lst.push(eval(a.clone(), env.clone())?) + match eval(a.clone(), env.clone()) { + Ok(elt) => lst.push(elt), + Err(e) => return Err(e), + } } - Ok(list!(lst)) + return Ok(lst); +} + +fn eval(mut ast: MalVal, mut env: Env) -> MalRet { + let ret: MalRet; + + 'tco: loop { + match env_get(&env, "DEBUG-EVAL") { + None | Some(Bool(false)) | Some(Nil) => (), + _ => println!("EVAL: {}", print(&ast)), } - Vector(v, _) => { - let mut lst: MalArgs = vec![]; - for a in v.iter() { - lst.push(eval(a.clone(), env.clone())?) - } - Ok(vector!(lst)) + ret = match ast { + Sym(ref s) => match env_get(&env, s) { + Some(r) => Ok(r), + None => error (&format!("'{}' not found", s)), + } + Vector(ref v, _) => match eval_ast(&v, &env) { + Ok(lst) => Ok(vector!(lst)), + Err(e) => Err(e), } Hash(hm, _) => { let mut new_hm: FnvHashMap = FnvHashMap::default(); @@ -124,28 +105,7 @@ fn eval_ast(ast: &MalVal, env: &Env) -> MalRet { } Ok(Hash(Rc::new(new_hm), Rc::new(Nil))) } - _ => Ok(ast.clone()), - } -} - -fn eval(mut ast: MalVal, mut env: Env) -> MalRet { - let ret: MalRet; - - 'tco: loop { - ret = match ast.clone() { - List(l, _) => { - if l.len() == 0 { - return Ok(ast); - } - match macroexpand(ast.clone(), &env) { - (true, Ok(new_ast)) => { - ast = new_ast; - continue 'tco; - } - (_, Err(e)) => return Err(e), - _ => (), - } - + List(ref l, _) => { if l.len() == 0 { return Ok(ast); } @@ -182,7 +142,6 @@ fn eval(mut ast: MalVal, mut env: Env) -> MalRet { continue 'tco; } Sym(ref a0sym) if a0sym == "quote" => Ok(l[1].clone()), - Sym(ref a0sym) if a0sym == "quasiquoteexpand" => Ok(quasiquote(&l[1])), Sym(ref a0sym) if a0sym == "quasiquote" => { ast = quasiquote(&l[1]); continue 'tco; @@ -212,12 +171,6 @@ fn eval(mut ast: MalVal, mut env: Env) -> MalRet { _ => error("set_macro on non-function"), } } - Sym(ref a0sym) if a0sym == "macroexpand" => { - match macroexpand(l[1].clone(), &env) { - (_, Ok(new_ast)) => Ok(new_ast), - (_, e) => return e, - } - } Sym(ref a0sym) if a0sym == "try*" => match eval(l[1].clone(), env.clone()) { Err(ref e) if l.len() >= 3 => { let exc = match e { @@ -239,12 +192,12 @@ fn eval(mut ast: MalVal, mut env: Env) -> MalRet { res => res, }, Sym(ref a0sym) if a0sym == "do" => { - match eval_ast(&list!(l[1..l.len() - 1].to_vec()), &env)? { - List(_, _) => { + match eval_ast(&l[1..l.len() - 1].to_vec(), &env) { + Ok(_) => { ast = l.last().unwrap_or(&Nil).clone(); continue 'tco; } - _ => error("invalid do form"), + Err(e) => return Err(e), } } Sym(ref a0sym) if a0sym == "if" => { @@ -280,32 +233,39 @@ fn eval(mut ast: MalVal, mut env: Env) -> MalRet { } continue 'tco; } - _ => match eval_ast(&ast, &env)? { - List(ref el, _) => { - let ref f = el[0].clone(); - let args = el[1..].to_vec(); - match f { - Func(_, _) => f.apply(args), - MalFunc { - ast: mast, - env: menv, - params, + _ => match eval(a0.clone(), env.clone()) { + Ok(f @ MalFunc { is_macro: true, .. }) => match f.apply(l[1..].to_vec()) { + Ok(new_ast) => { + ast = new_ast; + continue 'tco; + } + Err(e) => return Err(e), + } + Ok(f @ Func(_, _)) => match eval_ast(&l[1..].to_vec(), &env) { + Ok(args) => f.apply(args), + Err(e) => return Err(e), + } + Ok(MalFunc { + ast: ref mast, + env: ref menv, + params : ref mparams, .. - } => { + }) => match eval_ast(&l[1..].to_vec(), &env) { + Ok(args) => { let a = &**mast; - let p = &**params; - env = env_bind(Some(menv.clone()), p.clone(), args)?; + let p = &**mparams; + env = env_bind(Some(menv.clone()), p.clone(), args.to_vec())?; ast = a.clone(); continue 'tco; + } + Err(e) => return Err(e), } - _ => error("attempt to call non-function"), - } - } - _ => error("expected a list"), + Ok(_) => error("attempt to call non-function"), + Err(e) => return Err(e), }, } - } - _ => eval_ast(&ast, &env), + } + _ => Ok(ast.clone()), }; break; diff --git a/impls/scheme/lib/env.sld b/impls/scheme/lib/env.sld index 00e4f2a2c1..0be5439e25 100644 --- a/impls/scheme/lib/env.sld +++ b/impls/scheme/lib/env.sld @@ -1,6 +1,6 @@ (define-library (lib env) -(export make-env env-set env-find env-get) +(export make-env env-set env-get) (import (scheme base)) @@ -32,18 +32,12 @@ (define (env-set env key value) (env-data-set! env (cons (cons key value) (env-data env)))) -(define (env-find env key) +(define (env-get env key) (cond ((alist-ref key (env-data env)) => identity) - ((env-outer env) => (lambda (outer) (env-find outer key))) + ((env-outer env) => (lambda (outer) (env-get outer key))) (else #f))) -(define (env-get env key) - (let ((value (env-find env key))) - (if value - value - (error (str "'" key "' not found"))))) - ) ) diff --git a/impls/scheme/step2_eval.scm b/impls/scheme/step2_eval.scm index 87db7ee741..2fe7f2b99f 100644 --- a/impls/scheme/step2_eval.scm +++ b/impls/scheme/step2_eval.scm @@ -9,28 +9,26 @@ (define (READ input) (read-str input)) -(define (eval-ast ast env) - (let ((type (and (mal-object? ast) (mal-type ast))) - (value (and (mal-object? ast) (mal-value ast)))) - (case type - ((symbol) (or (alist-ref value env) - (error (str "'" value "' not found")))) - ((list) (mal-list (map (lambda (item) (EVAL item env)) value))) - ((vector) (mal-vector (vector-map (lambda (item) (EVAL item env)) value))) - ((map) (mal-map (alist-map (lambda (key value) (cons key (EVAL value env))) value))) - (else ast)))) - (define (EVAL ast env) - (let ((type (and (mal-object? ast) (mal-type ast)))) - (if (not (eq? type 'list)) - (eval-ast 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* ((items (mal-value (eval-ast ast env))) - (op (car items)) - (ops (cdr items))) - (apply op ops))))))) + (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)) diff --git a/impls/scheme/step3_env.scm b/impls/scheme/step3_env.scm index ab21a126e9..112b89ce3f 100644 --- a/impls/scheme/step3_env.scm +++ b/impls/scheme/step3_env.scm @@ -10,20 +10,22 @@ (define (READ input) (read-str input)) -(define (eval-ast ast env) - (let ((type (and (mal-object? ast) (mal-type ast))) - (value (and (mal-object? ast) (mal-value ast)))) - (case type - ((symbol) (env-get env value)) - ((list) (mal-list (map (lambda (item) (EVAL item env)) value))) - ((vector) (mal-vector (vector-map (lambda (item) (EVAL item env)) value))) - ((map) (mal-map (alist-map (lambda (key value) (cons key (EVAL value env))) value))) - (else ast)))) - (define (EVAL ast env) - (let ((type (and (mal-object? ast) (mal-type ast)))) - (if (not (eq? type 'list)) - (eval-ast 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 @@ -48,10 +50,10 @@ (loop (cddr binds)))))) (EVAL form env*))) (else - (let* ((items (mal-value (eval-ast ast env))) - (op (car items)) - (ops (cdr items))) - (apply op ops))))))))) + (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)) diff --git a/impls/scheme/step4_if_fn_do.scm b/impls/scheme/step4_if_fn_do.scm index b077be9a11..6413870921 100644 --- a/impls/scheme/step4_if_fn_do.scm +++ b/impls/scheme/step4_if_fn_do.scm @@ -11,20 +11,22 @@ (define (READ input) (read-str input)) -(define (eval-ast ast env) - (let ((type (and (mal-object? ast) (mal-type ast))) - (value (and (mal-object? ast) (mal-value ast)))) - (case type - ((symbol) (env-get env value)) - ((list) (mal-list (map (lambda (item) (EVAL item env)) value))) - ((vector) (mal-vector (vector-map (lambda (item) (EVAL item env)) value))) - ((map) (mal-map (alist-map (lambda (key value) (cons key (EVAL value env))) value))) - (else ast)))) - (define (EVAL ast env) - (let ((type (and (mal-object? ast) (mal-type ast)))) - (if (not (eq? type 'list)) - (eval-ast 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 @@ -77,10 +79,10 @@ (let ((env* (make-env env binds args))) (EVAL body env*))))) (else - (let* ((items (mal-value (eval-ast ast env))) - (op (car items)) - (ops (cdr items))) - (apply op ops))))))))) + (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)) diff --git a/impls/scheme/step5_tco.scm b/impls/scheme/step5_tco.scm index 87a029158c..30964e2929 100644 --- a/impls/scheme/step5_tco.scm +++ b/impls/scheme/step5_tco.scm @@ -11,20 +11,22 @@ (define (READ input) (read-str input)) -(define (eval-ast ast env) - (let ((type (and (mal-object? ast) (mal-type ast))) - (value (and (mal-object? ast) (mal-value ast)))) - (case type - ((symbol) (env-get env value)) - ((list) (mal-list (map (lambda (item) (EVAL item env)) value))) - ((vector) (mal-vector (vector-map (lambda (item) (EVAL item env)) value))) - ((map) (mal-map (alist-map (lambda (key value) (cons key (EVAL value env))) value))) - (else ast)))) - (define (EVAL ast env) - (let ((type (and (mal-object? ast) (mal-type ast)))) - (if (not (eq? type 'list)) - (eval-ast 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 @@ -78,15 +80,15 @@ (EVAL body env*))))) (make-func body binds env fn))) (else - (let* ((items (mal-value (eval-ast ast env))) - (op (car items)) - (ops (cdr items))) + (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)))))))))) + (apply op ops)))))))) + (else ast))) (define (PRINT ast) (pr-str ast #t)) diff --git a/impls/scheme/step6_file.scm b/impls/scheme/step6_file.scm index bb4fed0724..f346de4ee4 100644 --- a/impls/scheme/step6_file.scm +++ b/impls/scheme/step6_file.scm @@ -12,20 +12,22 @@ (define (READ input) (read-str input)) -(define (eval-ast ast env) - (let ((type (and (mal-object? ast) (mal-type ast))) - (value (and (mal-object? ast) (mal-value ast)))) - (case type - ((symbol) (env-get env value)) - ((list) (mal-list (map (lambda (item) (EVAL item env)) value))) - ((vector) (mal-vector (vector-map (lambda (item) (EVAL item env)) value))) - ((map) (mal-map (alist-map (lambda (key value) (cons key (EVAL value env))) value))) - (else ast)))) - (define (EVAL ast env) - (let ((type (and (mal-object? ast) (mal-type ast)))) - (if (not (eq? type 'list)) - (eval-ast 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 @@ -80,15 +82,15 @@ (EVAL body env*))))) (make-func body binds env fn))) (else - (let* ((items (mal-value (eval-ast ast env))) - (op (car items)) - (ops (cdr items))) + (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))))))))))) + (apply op ops))))))))) + (else ast))) (define (PRINT ast) (pr-str ast #t)) diff --git a/impls/scheme/step7_quote.scm b/impls/scheme/step7_quote.scm index b5527b8a97..a9c559bf2f 100644 --- a/impls/scheme/step7_quote.scm +++ b/impls/scheme/step7_quote.scm @@ -12,16 +12,6 @@ (define (READ input) (read-str input)) -(define (eval-ast ast env) - (let ((type (and (mal-object? ast) (mal-type ast))) - (value (and (mal-object? ast) (mal-value ast)))) - (case type - ((symbol) (env-get env value)) - ((list) (mal-list (map (lambda (item) (EVAL item env)) value))) - ((vector) (mal-vector (vector-map (lambda (item) (EVAL item env)) value))) - ((map) (mal-map (alist-map (lambda (key value) (cons key (EVAL value env))) value))) - (else ast)))) - (define (starts-with? ast sym) (let ((items (mal-value ast))) (and (not (null? items)) @@ -48,9 +38,21 @@ (else ast))) (define (EVAL ast env) - (let ((type (and (mal-object? ast) (mal-type ast)))) - (if (not (eq? type 'list)) - (eval-ast 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 @@ -97,7 +99,6 @@ (EVAL (list-ref items 3) env)) ; TCO (EVAL (list-ref items 2) env)))) ; TCO ((quote) (cadr items)) - ((quasiquoteexpand) (QUASIQUOTE (cadr items))) ((quasiquote) (EVAL (QUASIQUOTE (cadr items)) env)) ; TCO ((fn*) (let* ((binds (->list (mal-value (cadr items)))) @@ -108,15 +109,15 @@ (EVAL body env*))))) (make-func body binds env fn))) (else - (let* ((items (mal-value (eval-ast ast env))) - (op (car items)) - (ops (cdr items))) + (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))))))))))) + (apply op ops))))))))) + (else ast))) (define (PRINT ast) (pr-str ast #t)) diff --git a/impls/scheme/step8_macros.scm b/impls/scheme/step8_macros.scm index bd978b2b83..9b36d4543d 100644 --- a/impls/scheme/step8_macros.scm +++ b/impls/scheme/step8_macros.scm @@ -12,16 +12,6 @@ (define (READ input) (read-str input)) -(define (eval-ast ast env) - (let ((type (and (mal-object? ast) (mal-type ast))) - (value (and (mal-object? ast) (mal-value ast)))) - (case type - ((symbol) (env-get env value)) - ((list) (mal-list (map (lambda (item) (EVAL item env)) value))) - ((vector) (mal-vector (vector-map (lambda (item) (EVAL item env)) value))) - ((map) (mal-map (alist-map (lambda (key value) (cons key (EVAL value env))) value))) - (else ast)))) - (define (starts-with? ast sym) (let ((items (mal-value ast))) (and (not (null? items)) @@ -47,39 +37,25 @@ ((map symbol) (mal-list (list (mal-symbol 'quote) ast))) (else ast))) -(define (is-macro-call? ast env) - (if (mal-instance-of? ast 'list) - (let ((op (car-safe (mal-value ast)))) - (if (mal-instance-of? op 'symbol) - (let ((x (env-find env (mal-value op)))) - (if x - (if (and (func? x) (func-macro? x)) - #t - #f) - #f)) - #f)) - #f)) - -(define (macroexpand ast env) - (let loop ((ast ast)) - (if (is-macro-call? ast env) - (let* ((items (mal-value ast)) - (op (car items)) - (ops (cdr items)) - (fn (func-fn (env-get env (mal-value op))))) - (loop (apply fn ops))) - ast))) - (define (EVAL ast env) - (let ((type (and (mal-object? ast) (mal-type ast)))) - (if (not (eq? type 'list)) - (eval-ast ast env) - (if (null? (mal-value ast)) - ast - (let* ((ast (macroexpand ast env)) - (items (mal-value ast))) - (if (not (mal-instance-of? ast 'list)) - (eval-ast 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!) @@ -94,8 +70,6 @@ (func-macro?-set! value #t)) (env-set env symbol value) value)) - ((macroexpand) - (macroexpand (cadr items) env)) ((let*) (let ((env* (make-env env)) (binds (->list (mal-value (cadr items)))) @@ -133,8 +107,6 @@ (EVAL (list-ref items 2) env)))) ; TCO ((quote) (cadr items)) - ((quasiquoteexpand) - (QUASIQUOTE (cadr items))) ((quasiquote) (EVAL (QUASIQUOTE (cadr items)) env)) ; TCO ((fn*) @@ -146,15 +118,17 @@ (EVAL body env*))))) (make-func body binds env fn))) (else - (let* ((items (mal-value (eval-ast ast env))) - (op (car items)) - (ops (cdr items))) + (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)))))))))))) + (apply op ops))))))))))) + (else ast))) (define (PRINT ast) (pr-str ast #t)) diff --git a/impls/scheme/step9_try.scm b/impls/scheme/step9_try.scm index a670289e01..5a6139afb4 100644 --- a/impls/scheme/step9_try.scm +++ b/impls/scheme/step9_try.scm @@ -12,16 +12,6 @@ (define (READ input) (read-str input)) -(define (eval-ast ast env) - (let ((type (and (mal-object? ast) (mal-type ast))) - (value (and (mal-object? ast) (mal-value ast)))) - (case type - ((symbol) (env-get env value)) - ((list) (mal-list (map (lambda (item) (EVAL item env)) value))) - ((vector) (mal-vector (vector-map (lambda (item) (EVAL item env)) value))) - ((map) (mal-map (alist-map (lambda (key value) (cons key (EVAL value env))) value))) - (else ast)))) - (define (starts-with? ast sym) (let ((items (mal-value ast))) (and (not (null? items)) @@ -47,44 +37,25 @@ ((map symbol) (mal-list (list (mal-symbol 'quote) ast))) (else ast))) -(define (is-macro-call? ast env) - (if (mal-instance-of? ast 'list) - (let ((op (car-safe (mal-value ast)))) - (if (mal-instance-of? op 'symbol) - (let ((x (env-find env (mal-value op)))) - (if x - (if (and (func? x) (func-macro? x)) - #t - #f) - #f)) - #f)) - #f)) - -(define (macroexpand ast env) - (let loop ((ast ast)) - (if (is-macro-call? ast env) - (let* ((items (mal-value ast)) - (op (car items)) - (ops (cdr items)) - (fn (func-fn (env-get env (mal-value op))))) - (loop (apply fn ops))) - ast))) - (define (EVAL ast env) - (define (handle-catch value handler) - (let* ((symbol (mal-value (cadr handler))) - (form (list-ref handler 2)) - (env* (make-env env (list symbol) (list value)))) - (EVAL form env*))) - (let ((type (and (mal-object? ast) (mal-type ast)))) - (if (not (eq? type 'list)) - (eval-ast ast env) - (if (null? (mal-value ast)) - ast - (let* ((ast (macroexpand ast env)) - (items (mal-value ast))) - (if (not (mal-instance-of? ast 'list)) - (eval-ast 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!) @@ -99,21 +70,21 @@ (func-macro?-set! value #t)) (env-set env symbol value) value)) - ((macroexpand) - (macroexpand (cadr items) env)) ((try*) (if (< (length items) 3) (EVAL (cadr items) env) - (let* ((form (cadr items)) - (handler (mal-value (list-ref items 2)))) + (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)) - handler)) + (mal-string (error-object-message ex)))) ((and (pair? ex) (eq? (car ex) 'user-error)) - (handle-catch (cdr ex) handler))) - (EVAL form env))))) + (handle-catch (cdr ex)))) + (EVAL (cadr items) env))))) ((let*) (let ((env* (make-env env)) (binds (->list (mal-value (cadr items)))) @@ -151,8 +122,6 @@ (EVAL (list-ref items 2) env)))) ; TCO ((quote) (cadr items)) - ((quasiquoteexpand) - (QUASIQUOTE (cadr items))) ((quasiquote) (EVAL (QUASIQUOTE (cadr items)) env)) ; TCO ((fn*) @@ -164,15 +133,17 @@ (EVAL body env*))))) (make-func body binds env fn))) (else - (let* ((items (mal-value (eval-ast ast env))) - (op (car items)) - (ops (cdr items))) + (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)))))))))))) + (apply op ops))))))))))) + (else ast))) (define (PRINT ast) (pr-str ast #t)) diff --git a/impls/scheme/stepA_mal.scm b/impls/scheme/stepA_mal.scm index f054354bf2..722c1de57d 100644 --- a/impls/scheme/stepA_mal.scm +++ b/impls/scheme/stepA_mal.scm @@ -12,16 +12,6 @@ (define (READ input) (read-str input)) -(define (eval-ast ast env) - (let ((type (and (mal-object? ast) (mal-type ast))) - (value (and (mal-object? ast) (mal-value ast)))) - (case type - ((symbol) (env-get env value)) - ((list) (mal-list (map (lambda (item) (EVAL item env)) value))) - ((vector) (mal-vector (vector-map (lambda (item) (EVAL item env)) value))) - ((map) (mal-map (alist-map (lambda (key value) (cons key (EVAL value env))) value))) - (else ast)))) - (define (starts-with? ast sym) (let ((items (mal-value ast))) (and (not (null? items)) @@ -47,44 +37,25 @@ ((map symbol) (mal-list (list (mal-symbol 'quote) ast))) (else ast))) -(define (is-macro-call? ast env) - (if (mal-instance-of? ast 'list) - (let ((op (car-safe (mal-value ast)))) - (if (mal-instance-of? op 'symbol) - (let ((x (env-find env (mal-value op)))) - (if x - (if (and (func? x) (func-macro? x)) - #t - #f) - #f)) - #f)) - #f)) - -(define (macroexpand ast env) - (let loop ((ast ast)) - (if (is-macro-call? ast env) - (let* ((items (mal-value ast)) - (op (car items)) - (ops (cdr items)) - (fn (func-fn (env-get env (mal-value op))))) - (loop (apply fn ops))) - ast))) - (define (EVAL ast env) - (define (handle-catch value handler) - (let* ((symbol (mal-value (cadr handler))) - (form (list-ref handler 2)) - (env* (make-env env (list symbol) (list value)))) - (EVAL form env*))) - (let ((type (and (mal-object? ast) (mal-type ast)))) - (if (not (eq? type 'list)) - (eval-ast ast env) - (if (null? (mal-value ast)) - ast - (let* ((ast (macroexpand ast env)) - (items (mal-value ast))) - (if (not (mal-instance-of? ast 'list)) - (eval-ast 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!) @@ -99,21 +70,21 @@ (func-macro?-set! value #t)) (env-set env symbol value) value)) - ((macroexpand) - (macroexpand (cadr items) env)) ((try*) (if (< (length items) 3) (EVAL (cadr items) env) - (let* ((form (cadr items)) - (handler (mal-value (list-ref items 2)))) + (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)) - handler)) + (mal-string (error-object-message ex)))) ((and (pair? ex) (eq? (car ex) 'user-error)) - (handle-catch (cdr ex) handler))) - (EVAL form env))))) + (handle-catch (cdr ex)))) + (EVAL (cadr items) env))))) ((let*) (let ((env* (make-env env)) (binds (->list (mal-value (cadr items)))) @@ -151,8 +122,6 @@ (EVAL (list-ref items 2) env)))) ; TCO ((quote) (cadr items)) - ((quasiquoteexpand) - (QUASIQUOTE (cadr items))) ((quasiquote) (EVAL (QUASIQUOTE (cadr items)) env)) ; TCO ((fn*) @@ -164,15 +133,17 @@ (EVAL body env*))))) (make-func body binds env fn))) (else - (let* ((items (mal-value (eval-ast ast env))) - (op (car items)) - (ops (cdr items))) + (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)))))))))))) + (apply op ops))))))))))) + (else ast))) (define (PRINT ast) (pr-str ast #t)) diff --git a/impls/skew/env.sk b/impls/skew/env.sk index 2f4afb9c8e..8610fba99a 100644 --- a/impls/skew/env.sk +++ b/impls/skew/env.sk @@ -20,15 +20,9 @@ class Env { } } - def find(key MalSymbol) Env { - if key.val in _data { return self } - return _outer?.find(key) - } - - def get(key MalSymbol) MalVal { - const env = find(key) - if env == null { throw MalError.new("'" + key.val + "' not found") } - return env._data[key.val] + def get(key string) MalVal { + if key in _data { return _data[key] } + return _outer?.get(key) } def set(key MalSymbol, value MalVal) MalVal { diff --git a/impls/skew/step2_eval.sk b/impls/skew/step2_eval.sk index fb65d40f7b..e23916bab4 100644 --- a/impls/skew/step2_eval.sk +++ b/impls/skew/step2_eval.sk @@ -2,7 +2,9 @@ def READ(str string) MalVal { return read_str(str) } -def eval_ast(ast MalVal, env StringMap) MalVal { +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) { @@ -10,7 +12,7 @@ def eval_ast(ast MalVal, env StringMap) MalVal { } return env[name] } else if ast is MalList { - return MalList.new((ast as MalList).val.map(e => EVAL(e, env))) + # 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 { @@ -23,15 +25,12 @@ def eval_ast(ast MalVal, env StringMap) MalVal { } else { return ast } -} -def EVAL(ast MalVal, env StringMap) MalVal { - if !(ast is MalList) { return eval_ast(ast, env) } var astList = ast as MalList if astList.isEmpty { return ast } - var evaledList = eval_ast(ast, env) as MalList + const evaledList = astList.val.map(e => EVAL(e, env)) var fn = evaledList[0] as MalNativeFunc - return fn.call(evaledList.val.slice(1)) + return fn.call(evaledList.slice(1)) } def PRINT(exp MalVal) string { diff --git a/impls/skew/step3_env.sk b/impls/skew/step3_env.sk index aebc57c32b..135ab5199d 100644 --- a/impls/skew/step3_env.sk +++ b/impls/skew/step3_env.sk @@ -2,11 +2,19 @@ def READ(str string) MalVal { return read_str(str) } -def eval_ast(ast MalVal, env Env) MalVal { +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 { - return env.get(ast as 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 { - return MalList.new((ast as MalList).val.map(e => EVAL(e, env))) + # 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 { @@ -19,10 +27,7 @@ def eval_ast(ast MalVal, env Env) MalVal { } else { return ast } -} -def EVAL(ast MalVal, env Env) MalVal { - if !(ast is MalList) { return eval_ast(ast, env) } const astList = ast as MalList if astList.isEmpty { return ast } const a0sym = astList[0] as MalSymbol @@ -36,9 +41,9 @@ def EVAL(ast MalVal, env Env) MalVal { } return EVAL(astList[2], letenv) } else { - const evaledList = eval_ast(ast, env) as MalList + const evaledList = astList.val.map(e => EVAL(e, env)) const fn = evaledList[0] as MalNativeFunc - return fn.call(evaledList.val.slice(1)) + return fn.call(evaledList.slice(1)) } } diff --git a/impls/skew/step4_if_fn_do.sk b/impls/skew/step4_if_fn_do.sk index 87acb890d0..045d8a0ee8 100644 --- a/impls/skew/step4_if_fn_do.sk +++ b/impls/skew/step4_if_fn_do.sk @@ -2,11 +2,19 @@ def READ(str string) MalVal { return read_str(str) } -def eval_ast(ast MalVal, env Env) MalVal { +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 { - return env.get(ast as 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 { - return MalList.new((ast as MalList).val.map(e => EVAL(e, env))) + # 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 { @@ -19,10 +27,7 @@ def eval_ast(ast MalVal, env Env) MalVal { } else { return ast } -} -def EVAL(ast MalVal, env Env) MalVal { - if !(ast is MalList) { return eval_ast(ast, env) } const astList = ast as MalList if astList.isEmpty { return ast } const a0sym = astList[0] as MalSymbol @@ -36,8 +41,10 @@ def EVAL(ast MalVal, env Env) MalVal { } return EVAL(astList[2], letenv) } else if a0sym.val == "do" { - const r = eval_ast(MalList.new(astList.val.slice(1)), env) as MalList - return r[r.count - 1] + 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 { @@ -49,9 +56,9 @@ def EVAL(ast MalVal, env Env) MalVal { const argsNames = (astList[1] as MalSequential).val return MalNativeFunc.new((args List) => EVAL(astList[2], Env.new(env, argsNames, args))) } else { - const evaledList = eval_ast(ast, env) as MalList + const evaledList = astList.val.map(e => EVAL(e, env)) const fn = evaledList[0] as MalNativeFunc - return fn.call(evaledList.val.slice(1)) + return fn.call(evaledList.slice(1)) } } diff --git a/impls/skew/step5_tco.sk b/impls/skew/step5_tco.sk index 6799003f8e..5166208227 100644 --- a/impls/skew/step5_tco.sk +++ b/impls/skew/step5_tco.sk @@ -2,11 +2,21 @@ def READ(str string) MalVal { return read_str(str) } -def eval_ast(ast MalVal, env Env) MalVal { +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 { - return env.get(ast as 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 { - return MalList.new((ast as MalList).val.map(e => EVAL(e, env))) + # 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 { @@ -19,11 +29,7 @@ def eval_ast(ast MalVal, env Env) MalVal { } else { return ast } -} -def EVAL(ast MalVal, env Env) MalVal { - while true { - if !(ast is MalList) { return eval_ast(ast, env) } const astList = ast as MalList if astList.isEmpty { return ast } const a0sym = astList[0] as MalSymbol @@ -39,9 +45,10 @@ def EVAL(ast MalVal, env Env) MalVal { env = letenv continue # TCO } else if a0sym.val == "do" { - const parts = astList.val.slice(1) - eval_ast(MalList.new(parts.slice(0, parts.count - 1)), env) - ast = parts[parts.count - 1] + 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) @@ -55,9 +62,9 @@ def EVAL(ast MalVal, env Env) MalVal { 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 = eval_ast(ast, env) as MalList + const evaledList = astList.val.map(e => EVAL(e, env)) const fn = evaledList[0] - const callArgs = evaledList.val.slice(1) + const callArgs = evaledList.slice(1) if fn is MalNativeFunc { return (fn as MalNativeFunc).call(callArgs) } else if fn is MalFunc { diff --git a/impls/skew/step6_file.sk b/impls/skew/step6_file.sk index bc1a901bd2..ac91af5e5b 100644 --- a/impls/skew/step6_file.sk +++ b/impls/skew/step6_file.sk @@ -2,11 +2,21 @@ def READ(str string) MalVal { return read_str(str) } -def eval_ast(ast MalVal, env Env) MalVal { +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 { - return env.get(ast as 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 { - return MalList.new((ast as MalList).val.map(e => EVAL(e, env))) + # 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 { @@ -19,11 +29,7 @@ def eval_ast(ast MalVal, env Env) MalVal { } else { return ast } -} -def EVAL(ast MalVal, env Env) MalVal { - while true { - if !(ast is MalList) { return eval_ast(ast, env) } const astList = ast as MalList if astList.isEmpty { return ast } const a0sym = astList[0] as MalSymbol @@ -39,9 +45,10 @@ def EVAL(ast MalVal, env Env) MalVal { env = letenv continue # TCO } else if a0sym.val == "do" { - const parts = astList.val.slice(1) - eval_ast(MalList.new(parts.slice(0, parts.count - 1)), env) - ast = parts[parts.count - 1] + 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) @@ -55,9 +62,9 @@ def EVAL(ast MalVal, env Env) MalVal { 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 = eval_ast(ast, env) as MalList + const evaledList = astList.val.map(e => EVAL(e, env)) const fn = evaledList[0] - const callArgs = evaledList.val.slice(1) + const callArgs = evaledList.slice(1) if fn is MalNativeFunc { return (fn as MalNativeFunc).call(callArgs) } else if fn is MalFunc { diff --git a/impls/skew/step7_quote.sk b/impls/skew/step7_quote.sk index 68a57a7d2e..e4be3a43a5 100644 --- a/impls/skew/step7_quote.sk +++ b/impls/skew/step7_quote.sk @@ -33,11 +33,21 @@ def quasiquote(ast MalVal) MalVal { } } -def eval_ast(ast MalVal, env Env) MalVal { +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 { - return env.get(ast as 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 { - return MalList.new((ast as MalList).val.map(e => EVAL(e, env))) + # 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 { @@ -50,11 +60,7 @@ def eval_ast(ast MalVal, env Env) MalVal { } else { return ast } -} -def EVAL(ast MalVal, env Env) MalVal { - while true { - if !(ast is MalList) { return eval_ast(ast, env) } const astList = ast as MalList if astList.isEmpty { return ast } const a0sym = astList[0] as MalSymbol @@ -71,15 +77,14 @@ def EVAL(ast MalVal, env Env) MalVal { continue # TCO } else if a0sym.val == "quote" { return astList[1] - } else if a0sym.val == "quasiquoteexpand" { - return quasiquote(astList[1]) } else if a0sym.val == "quasiquote" { ast = quasiquote(astList[1]) continue # TCO } else if a0sym.val == "do" { - const parts = astList.val.slice(1) - eval_ast(MalList.new(parts.slice(0, parts.count - 1)), env) - ast = parts[parts.count - 1] + 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) @@ -93,9 +98,9 @@ def EVAL(ast MalVal, env Env) MalVal { 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 = eval_ast(ast, env) as MalList + const evaledList = astList.val.map(e => EVAL(e, env)) const fn = evaledList[0] - const callArgs = evaledList.val.slice(1) + const callArgs = evaledList.slice(1) if fn is MalNativeFunc { return (fn as MalNativeFunc).call(callArgs) } else if fn is MalFunc { diff --git a/impls/skew/step8_macros.sk b/impls/skew/step8_macros.sk index 7450e6e76c..894b114e3d 100644 --- a/impls/skew/step8_macros.sk +++ b/impls/skew/step8_macros.sk @@ -33,33 +33,21 @@ def quasiquote(ast MalVal) MalVal { } } -def isMacro(ast MalVal, env Env) bool { - if !(ast is MalList) { return false } - const astList = ast as MalList - if astList.isEmpty { return false } - const a0 = astList[0] - if !(a0 is MalSymbol) { return false } - const a0Sym = a0 as MalSymbol - if env.find(a0Sym) == null { return false } - const f = env.get(a0Sym) - if !(f is MalFunc) { return false } - return (f as MalFunc).isMacro -} +def EVAL(ast MalVal, env Env) MalVal { + while true { -def macroexpand(ast MalVal, env Env) MalVal { - while isMacro(ast, env) { - const astList = ast as MalList - const mac = env.get(astList[0] as MalSymbol) as MalFunc - ast = mac.call((astList.rest as MalSequential).val) + const dbgeval = env.get("DEBUG-EVAL") + if dbgeval != null && !(dbgeval is MalNil) && !(dbgeval is MalFalse) { + printLn("EVAL: " + PRINT(ast)) } - return ast -} -def eval_ast(ast MalVal, env Env) MalVal { if ast is MalSymbol { - return env.get(ast as 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 { - return MalList.new((ast as MalList).val.map(e => EVAL(e, env))) + # 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 { @@ -72,13 +60,7 @@ def eval_ast(ast MalVal, env Env) MalVal { } else { return ast } -} -def EVAL(ast MalVal, env Env) MalVal { - while true { - if !(ast is MalList) { return eval_ast(ast, env) } - ast = macroexpand(ast, env) - if !(ast is MalList) { return eval_ast(ast, env) } const astList = ast as MalList if astList.isEmpty { return ast } const a0sym = astList[0] as MalSymbol @@ -95,8 +77,6 @@ def EVAL(ast MalVal, env Env) MalVal { continue # TCO } else if a0sym.val == "quote" { return astList[1] - } else if a0sym.val == "quasiquoteexpand" { - return quasiquote(astList[1]) } else if a0sym.val == "quasiquote" { ast = quasiquote(astList[1]) continue # TCO @@ -105,12 +85,11 @@ def EVAL(ast MalVal, env Env) MalVal { 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 == "macroexpand" { - return macroexpand(astList[1], env) } else if a0sym.val == "do" { - const parts = astList.val.slice(1) - eval_ast(MalList.new(parts.slice(0, parts.count - 1)), env) - ast = parts[parts.count - 1] + 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) @@ -124,9 +103,13 @@ def EVAL(ast MalVal, env Env) MalVal { 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 = eval_ast(ast, env) as MalList - const fn = evaledList[0] - const callArgs = evaledList.val.slice(1) + 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 { diff --git a/impls/skew/step9_try.sk b/impls/skew/step9_try.sk index a526d30a4f..c00276992a 100644 --- a/impls/skew/step9_try.sk +++ b/impls/skew/step9_try.sk @@ -33,33 +33,21 @@ def quasiquote(ast MalVal) MalVal { } } -def isMacro(ast MalVal, env Env) bool { - if !(ast is MalList) { return false } - const astList = ast as MalList - if astList.isEmpty { return false } - const a0 = astList[0] - if !(a0 is MalSymbol) { return false } - const a0Sym = a0 as MalSymbol - if env.find(a0Sym) == null { return false } - const f = env.get(a0Sym) - if !(f is MalFunc) { return false } - return (f as MalFunc).isMacro -} +def EVAL(ast MalVal, env Env) MalVal { + while true { -def macroexpand(ast MalVal, env Env) MalVal { - while isMacro(ast, env) { - const astList = ast as MalList - const mac = env.get(astList[0] as MalSymbol) as MalFunc - ast = mac.call((astList.rest as MalSequential).val) + const dbgeval = env.get("DEBUG-EVAL") + if dbgeval != null && !(dbgeval is MalNil) && !(dbgeval is MalFalse) { + printLn("EVAL: " + PRINT(ast)) } - return ast -} -def eval_ast(ast MalVal, env Env) MalVal { if ast is MalSymbol { - return env.get(ast as 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 { - return MalList.new((ast as MalList).val.map(e => EVAL(e, env))) + # 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 { @@ -72,13 +60,7 @@ def eval_ast(ast MalVal, env Env) MalVal { } else { return ast } -} -def EVAL(ast MalVal, env Env) MalVal { - while true { - if !(ast is MalList) { return eval_ast(ast, env) } - ast = macroexpand(ast, env) - if !(ast is MalList) { return eval_ast(ast, env) } const astList = ast as MalList if astList.isEmpty { return ast } const a0sym = astList[0] as MalSymbol @@ -95,8 +77,6 @@ def EVAL(ast MalVal, env Env) MalVal { continue # TCO } else if a0sym.val == "quote" { return astList[1] - } else if a0sym.val == "quasiquoteexpand" { - return quasiquote(astList[1]) } else if a0sym.val == "quasiquote" { ast = quasiquote(astList[1]) continue # TCO @@ -105,8 +85,6 @@ def EVAL(ast MalVal, env Env) MalVal { 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 == "macroexpand" { - return macroexpand(astList[1], env) } else if a0sym.val == "try*" { if astList.count < 3 { return EVAL(astList[1], env) @@ -122,9 +100,10 @@ def EVAL(ast MalVal, env Env) MalVal { var catchEnv = Env.new(env, [catchClause[1] as MalSymbol], [exc]) return EVAL(catchClause[2], catchEnv) } else if a0sym.val == "do" { - const parts = astList.val.slice(1) - eval_ast(MalList.new(parts.slice(0, parts.count - 1)), env) - ast = parts[parts.count - 1] + 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) @@ -138,9 +117,13 @@ def EVAL(ast MalVal, env Env) MalVal { 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 = eval_ast(ast, env) as MalList - const fn = evaledList[0] - const callArgs = evaledList.val.slice(1) + 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 { diff --git a/impls/skew/stepA_mal.sk b/impls/skew/stepA_mal.sk index 622936426f..d1e3126b82 100644 --- a/impls/skew/stepA_mal.sk +++ b/impls/skew/stepA_mal.sk @@ -33,33 +33,21 @@ def quasiquote(ast MalVal) MalVal { } } -def isMacro(ast MalVal, env Env) bool { - if !(ast is MalList) { return false } - const astList = ast as MalList - if astList.isEmpty { return false } - const a0 = astList[0] - if !(a0 is MalSymbol) { return false } - const a0Sym = a0 as MalSymbol - if env.find(a0Sym) == null { return false } - const f = env.get(a0Sym) - if !(f is MalFunc) { return false } - return (f as MalFunc).isMacro -} +def EVAL(ast MalVal, env Env) MalVal { + while true { -def macroexpand(ast MalVal, env Env) MalVal { - while isMacro(ast, env) { - const astList = ast as MalList - const mac = env.get(astList[0] as MalSymbol) as MalFunc - ast = mac.call((astList.rest as MalSequential).val) + const dbgeval = env.get("DEBUG-EVAL") + if dbgeval != null && !(dbgeval is MalNil) && !(dbgeval is MalFalse) { + printLn("EVAL: " + PRINT(ast)) } - return ast -} -def eval_ast(ast MalVal, env Env) MalVal { if ast is MalSymbol { - return env.get(ast as 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 { - return MalList.new((ast as MalList).val.map(e => EVAL(e, env))) + # 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 { @@ -72,13 +60,7 @@ def eval_ast(ast MalVal, env Env) MalVal { } else { return ast } -} -def EVAL(ast MalVal, env Env) MalVal { - while true { - if !(ast is MalList) { return eval_ast(ast, env) } - ast = macroexpand(ast, env) - if !(ast is MalList) { return eval_ast(ast, env) } const astList = ast as MalList if astList.isEmpty { return ast } const a0sym = astList[0] as MalSymbol @@ -95,8 +77,6 @@ def EVAL(ast MalVal, env Env) MalVal { continue # TCO } else if a0sym.val == "quote" { return astList[1] - } else if a0sym.val == "quasiquoteexpand" { - return quasiquote(astList[1]) } else if a0sym.val == "quasiquote" { ast = quasiquote(astList[1]) continue # TCO @@ -105,8 +85,6 @@ def EVAL(ast MalVal, env Env) MalVal { 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 == "macroexpand" { - return macroexpand(astList[1], env) } else if a0sym.val == "try*" { if astList.count < 3 { return EVAL(astList[1], env) @@ -122,9 +100,10 @@ def EVAL(ast MalVal, env Env) MalVal { var catchEnv = Env.new(env, [catchClause[1] as MalSymbol], [exc]) return EVAL(catchClause[2], catchEnv) } else if a0sym.val == "do" { - const parts = astList.val.slice(1) - eval_ast(MalList.new(parts.slice(0, parts.count - 1)), env) - ast = parts[parts.count - 1] + 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) @@ -138,9 +117,13 @@ def EVAL(ast MalVal, env Env) MalVal { 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 = eval_ast(ast, env) as MalList - const fn = evaledList[0] - const callArgs = evaledList.val.slice(1) + 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 { diff --git a/impls/sml/step2_eval.sml b/impls/sml/step2_eval.sml index fa62f51892..730d913552 100644 --- a/impls/sml/step2_eval.sml +++ b/impls/sml/step2_eval.sml @@ -4,6 +4,7 @@ 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 diff --git a/impls/sml/step3_env.sml b/impls/sml/step3_env.sml index ae8a172a40..e7936d3019 100644 --- a/impls/sml/step3_env.sml +++ b/impls/sml/step3_env.sml @@ -4,11 +4,19 @@ exception NotApplicable of string fun read s = readStr s -fun 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 +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 diff --git a/impls/sml/step4_if_fn_do.sml b/impls/sml/step4_if_fn_do.sml index 7510cda118..16b590a47f 100644 --- a/impls/sml/step4_if_fn_do.sml +++ b/impls/sml/step4_if_fn_do.sml @@ -1,11 +1,19 @@ fun read s = readStr s -fun 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 +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 diff --git a/impls/sml/step6_file.sml b/impls/sml/step6_file.sml index a4db2a40be..7268b35823 100644 --- a/impls/sml/step6_file.sml +++ b/impls/sml/step6_file.sml @@ -1,11 +1,19 @@ fun read s = readStr s -fun 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 +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 diff --git a/impls/sml/step7_quote.sml b/impls/sml/step7_quote.sml index af7659b1f9..6356a45450 100644 --- a/impls/sml/step7_quote.sml +++ b/impls/sml/step7_quote.sml @@ -1,11 +1,19 @@ fun read s = readStr s -fun 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 +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 @@ -14,7 +22,6 @@ and specialEval (SYMBOL "def!") = SOME evalDef | specialEval (SYMBOL "fn*") = SOME evalFn | specialEval (SYMBOL "quote") = SOME evalQuote | specialEval (SYMBOL "quasiquote") = SOME evalQuasiquote - | specialEval (SYMBOL "quasiquoteexpand") = SOME (fn _ => expandQuasiquote) | specialEval _ = NONE and evalDef e [SYMBOL s, ast] = let val v = eval e ast in (def s v e; v) end diff --git a/impls/sml/step8_macros.sml b/impls/sml/step8_macros.sml index fe6673b76d..69aac0443e 100644 --- a/impls/sml/step8_macros.sml +++ b/impls/sml/step8_macros.sml @@ -1,7 +1,13 @@ fun read s = readStr s -fun eval e ast = eval' e (expandMacro e [ast]) +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 @@ -16,9 +22,7 @@ and specialEval (SYMBOL "def!") = SOME evalDef | specialEval (SYMBOL "fn*") = SOME evalFn | specialEval (SYMBOL "quote") = SOME evalQuote | specialEval (SYMBOL "quasiquote") = SOME evalQuasiquote - | specialEval (SYMBOL "quasiquoteexpand") = SOME (fn _ => expandQuasiquote) | specialEval (SYMBOL "defmacro!") = SOME evalDefmacro - | specialEval (SYMBOL "macroexpand") = SOME expandMacro | specialEval _ = NONE and evalDef e [SYMBOL s, ast] = let val v = eval e ast in (def s v e; v) end @@ -60,11 +64,8 @@ and evalDefmacro e [SYMBOL s, ast] = defMacro e s (eval e ast) 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 expandMacro e [(ast as LIST (SYMBOL s::args, _))] = (case lookup e s of SOME (MACRO m) => m args | _ => ast) - | expandMacro _ [ast] = ast - | expandMacro _ _ = raise NotApplicable "macroexpand needs one argument" - 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) diff --git a/impls/sml/step9_try.sml b/impls/sml/step9_try.sml index de468d1cca..ee3a8783d1 100644 --- a/impls/sml/step9_try.sml +++ b/impls/sml/step9_try.sml @@ -1,7 +1,13 @@ fun read s = readStr s -fun eval e ast = eval' e (expandMacro e [ast]) +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 @@ -16,9 +22,7 @@ and specialEval (SYMBOL "def!") = SOME evalDef | specialEval (SYMBOL "fn*") = SOME evalFn | specialEval (SYMBOL "quote") = SOME evalQuote | specialEval (SYMBOL "quasiquote") = SOME evalQuasiquote - | specialEval (SYMBOL "quasiquoteexpand") = SOME (fn _ => expandQuasiquote) | specialEval (SYMBOL "defmacro!") = SOME evalDefmacro - | specialEval (SYMBOL "macroexpand") = SOME expandMacro | specialEval (SYMBOL "try*") = SOME evalTry | specialEval _ = NONE @@ -61,10 +65,6 @@ and evalDefmacro e [SYMBOL s, ast] = defMacro e s (eval e ast) 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 expandMacro e [(ast as LIST (SYMBOL s::args, _))] = (case lookup e s of SOME (MACRO m) => m args | _ => ast) - | expandMacro _ [ast] = ast - | expandMacro _ _ = raise NotApplicable "macroexpand needs one argument" - 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" @@ -77,6 +77,7 @@ and exnVal (MalException x) = x | 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) diff --git a/impls/sml/stepA_mal.sml b/impls/sml/stepA_mal.sml index e279debec9..4c1119dd3f 100644 --- a/impls/sml/stepA_mal.sml +++ b/impls/sml/stepA_mal.sml @@ -1,7 +1,13 @@ fun read s = readStr s -fun eval e ast = eval' e (expandMacro e [ast]) +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 @@ -16,9 +22,7 @@ and specialEval (SYMBOL "def!") = SOME evalDef | specialEval (SYMBOL "fn*") = SOME evalFn | specialEval (SYMBOL "quote") = SOME evalQuote | specialEval (SYMBOL "quasiquote") = SOME evalQuasiquote - | specialEval (SYMBOL "quasiquoteexpand") = SOME (fn _ => expandQuasiquote) | specialEval (SYMBOL "defmacro!") = SOME evalDefmacro - | specialEval (SYMBOL "macroexpand") = SOME expandMacro | specialEval (SYMBOL "try*") = SOME evalTry | specialEval _ = NONE @@ -61,10 +65,6 @@ and evalDefmacro e [SYMBOL s, ast] = defMacro e s (eval e ast) 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 expandMacro e [(ast as LIST (SYMBOL s::args, _))] = (case lookup e s of SOME (MACRO m) => m args | _ => ast) - | expandMacro _ [ast] = ast - | expandMacro _ _ = raise NotApplicable "macroexpand needs one argument" - 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" @@ -77,6 +77,7 @@ and exnVal (MalException x) = x | 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) diff --git a/impls/tcl/step2_eval.tcl b/impls/tcl/step2_eval.tcl index 70001493a9..2cb8e0822f 100644 --- a/impls/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/impls/tcl/step3_env.tcl b/impls/tcl/step3_env.tcl index 69f5a9a3c3..f6fbebbb31 100644 --- a/impls/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/impls/tcl/step4_if_fn_do.tcl b/impls/tcl/step4_if_fn_do.tcl index 4e2ae2f630..c29f8ece6f 100644 --- a/impls/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/impls/tcl/step5_tco.tcl b/impls/tcl/step5_tco.tcl index 3e1f62bb27..61b17109a6 100644 --- a/impls/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/impls/tcl/step6_file.tcl b/impls/tcl/step6_file.tcl index 193df2c122..dd4bb8c908 100644 --- a/impls/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] { diff --git a/impls/tcl/step7_quote.tcl b/impls/tcl/step7_quote.tcl index 41d76ea900..3cd5f6b808 100644 --- a/impls/tcl/step7_quote.tcl +++ b/impls/tcl/step7_quote.tcl @@ -55,18 +55,24 @@ proc quasiquote {ast} { } } -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 {} @@ -83,14 +89,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 @@ -114,15 +114,13 @@ proc EVAL {ast env} { "quote" { return $a1 } - "quasiquoteexpand" { - return [quasiquote $a1] - } "quasiquote" { set ast [quasiquote $a1] } "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 } @@ -146,8 +144,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/impls/tcl/step8_macros.tcl b/impls/tcl/step8_macros.tcl index 6bdf1994f3..c408e5c01d 100644 --- a/impls/tcl/step8_macros.tcl +++ b/impls/tcl/step8_macros.tcl @@ -55,51 +55,24 @@ proc quasiquote {ast} { } } -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]]] +proc EVAL {ast env} { + while {true} { - 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] + 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}" + } } - 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 {} @@ -116,18 +89,6 @@ 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] - } - - set ast [macroexpand $ast $env] - if {![list_q $ast]} { - return [eval_ast $ast $env] } lassign [obj_val $ast] a0 a1 a2 a3 @@ -153,9 +114,6 @@ proc EVAL {ast env} { "quote" { return $a1 } - "quasiquoteexpand" { - return [quasiquote $a1] - } "quasiquote" { set ast [quasiquote $a1] } @@ -164,12 +122,10 @@ proc EVAL {ast env} { set value [EVAL $a2 $env] return [$env set $varname [macro_new $value]] } - "macroexpand" { - return [macroexpand $a1 $env] - } "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 } @@ -193,10 +149,21 @@ 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 f [lindex $lst 0] - set call_args [lrange $lst 1 end] + 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] diff --git a/impls/tcl/step9_try.tcl b/impls/tcl/step9_try.tcl index 6518536a31..ee63ed3ec3 100644 --- a/impls/tcl/step9_try.tcl +++ b/impls/tcl/step9_try.tcl @@ -55,51 +55,24 @@ proc quasiquote {ast} { } } -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]]] +proc EVAL {ast env} { + while {true} { - 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] + 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}" + } } - 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 {} @@ -116,18 +89,6 @@ 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] - } - - set ast [macroexpand $ast $env] - if {![list_q $ast]} { - return [eval_ast $ast $env] } lassign [obj_val $ast] a0 a1 a2 a3 @@ -153,9 +114,6 @@ proc EVAL {ast env} { "quote" { return $a1 } - "quasiquoteexpand" { - return [quasiquote $a1] - } "quasiquote" { set ast [quasiquote $a1] } @@ -164,9 +122,6 @@ proc EVAL {ast env} { set value [EVAL $a2 $env] return [$env set $varname [macro_new $value]] } - "macroexpand" { - return [macroexpand $a1 $env] - } "try*" { if {$a2 == ""} { return [EVAL $a1 $env] @@ -186,8 +141,9 @@ proc EVAL {ast env} { } } "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 } @@ -211,10 +167,21 @@ 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 f [lindex $lst 0] - set call_args [lrange $lst 1 end] + 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] diff --git a/impls/tcl/stepA_mal.tcl b/impls/tcl/stepA_mal.tcl index 1857a9a5ef..88d4445fa5 100644 --- a/impls/tcl/stepA_mal.tcl +++ b/impls/tcl/stepA_mal.tcl @@ -55,51 +55,24 @@ proc quasiquote {ast} { } } -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]]] +proc EVAL {ast env} { + while {true} { - 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] + 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}" + } } - 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 {} @@ -116,18 +89,6 @@ 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] - } - - set ast [macroexpand $ast $env] - if {![list_q $ast]} { - return [eval_ast $ast $env] } lassign [obj_val $ast] a0 a1 a2 a3 @@ -153,9 +114,6 @@ proc EVAL {ast env} { "quote" { return $a1 } - "quasiquoteexpand" { - return [quasiquote $a1] - } "quasiquote" { set ast [quasiquote $a1] } @@ -164,9 +122,6 @@ proc EVAL {ast env} { set value [EVAL $a2 $env] return [$env set $varname [macro_new $value]] } - "macroexpand" { - return [macroexpand $a1 $env] - } "tcl*" { return [string_new [eval [obj_val $a1]]] } @@ -189,8 +144,9 @@ proc EVAL {ast env} { } } "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 } @@ -214,10 +170,21 @@ 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 f [lindex $lst 0] - set call_args [lrange $lst 1 end] + 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] diff --git a/impls/tests/step3_env.mal b/impls/tests/step3_env.mal index a3554544cb..8fca4f6aba 100644 --- a/impls/tests/step3_env.mal +++ b/impls/tests/step3_env.mal @@ -85,3 +85,23 @@ y ;; 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/step7_quote.mal b/impls/tests/step7_quote.mal index ef80c8259a..b757726019 100644 --- a/impls/tests/step7_quote.mal +++ b/impls/tests/step7_quote.mal @@ -76,8 +76,6 @@ b ;=>(1 () 2) (quasiquote (())) ;=>(()) -;; (quasiquote (f () g (h) i (j k) l)) -;; =>(f () g (h) i (j k) l) ;; Testing unquote (quasiquote (unquote 7)) @@ -278,72 +276,21 @@ a `[splice-unquote 0] ;=>[splice-unquote 0] -;; Debugging quasiquote -(quasiquoteexpand nil) -;=>nil -(quasiquoteexpand 7) -;=>7 -(quasiquoteexpand a) -;=>(quote a) -(quasiquoteexpand {"a" b}) -;=>(quote {"a" b}) -(quasiquoteexpand ()) -;=>() -(quasiquoteexpand (1 2 3)) -;=>(cons 1 (cons 2 (cons 3 ()))) -(quasiquoteexpand (a)) -;=>(cons (quote a) ()) -(quasiquoteexpand (1 2 (3 4))) -;=>(cons 1 (cons 2 (cons (cons 3 (cons 4 ())) ()))) -(quasiquoteexpand (nil)) -;=>(cons nil ()) -(quasiquoteexpand (1 ())) -;=>(cons 1 (cons () ())) -(quasiquoteexpand (() 1)) -;=>(cons () (cons 1 ())) -(quasiquoteexpand (1 () 2)) -;=>(cons 1 (cons () (cons 2 ()))) -(quasiquoteexpand (())) -;=>(cons () ()) -(quasiquoteexpand (f () g (h) i (j k) l)) -;=>(cons (quote f) (cons () (cons (quote g) (cons (cons (quote h) ()) (cons (quote i) (cons (cons (quote j) (cons (quote k) ())) (cons (quote l) ()))))))) -(quasiquoteexpand (unquote 7)) -;=>7 -(quasiquoteexpand a) -;=>(quote a) -(quasiquoteexpand (unquote a)) -;=>a -(quasiquoteexpand (1 a 3)) -;=>(cons 1 (cons (quote a) (cons 3 ()))) -(quasiquoteexpand (1 (unquote a) 3)) -;=>(cons 1 (cons a (cons 3 ()))) -(quasiquoteexpand (1 b 3)) -;=>(cons 1 (cons (quote b) (cons 3 ()))) -(quasiquoteexpand (1 (unquote b) 3)) -;=>(cons 1 (cons b (cons 3 ()))) -(quasiquoteexpand ((unquote 1) (unquote 2))) -;=>(cons 1 (cons 2 ())) -(quasiquoteexpand (a (splice-unquote (b c)) d)) -;=>(cons (quote a) (concat (b c) (cons (quote d) ()))) -(quasiquoteexpand (1 c 3)) -;=>(cons 1 (cons (quote c) (cons 3 ()))) -(quasiquoteexpand (1 (splice-unquote c) 3)) -;=>(cons 1 (concat c (cons 3 ()))) -(quasiquoteexpand (1 (splice-unquote c))) -;=>(cons 1 (concat c ())) -(quasiquoteexpand ((splice-unquote c) 2)) -;=>(concat c (cons 2 ())) -(quasiquoteexpand ((splice-unquote c) (splice-unquote c))) -;=>(concat c (concat c ())) -(quasiquoteexpand []) -;=>(vec ()) -(quasiquoteexpand [[]]) -;=>(vec (cons (vec ()) ())) -(quasiquoteexpand [()]) -;=>(vec (cons () ())) -(quasiquoteexpand ([])) -;=>(cons (vec ()) ()) -(quasiquoteexpand [1 a 3]) -;=>(vec (cons 1 (cons (quote a) (cons 3 ())))) -(quasiquoteexpand [a [] b [c] d [e f] g]) -;=>(vec (cons (quote a) (cons (vec ()) (cons (quote b) (cons (vec (cons (quote c) ())) (cons (quote d) (cons (vec (cons (quote e) (cons (quote f) ()))) (cons (quote g) ())))))))) +(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 index 6fd1ef9d94..a252ec4cdd 100644 --- a/impls/tests/step8_macros.mal +++ b/impls/tests/step8_macros.mal @@ -18,20 +18,8 @@ (unless2 true 7 8) ;=>8 -;; Testing macroexpand -(macroexpand (one)) -;=>1 -(macroexpand (unless PRED A B)) -;=>(if PRED B A) -(macroexpand (unless2 PRED A B)) -;=>(if (not PRED) A B) -(macroexpand (unless2 2 3 4)) -;=>(if (not 2) 3 4) - ;; Testing evaluation of macro result (defmacro! identity (fn* (x) x)) -(let* (a 123) (macroexpand (identity a))) -;=>a (let* (a 123) (identity a)) ;=>123 @@ -84,18 +72,12 @@ x ;; Testing cond macro -(macroexpand (cond)) -;=>nil (cond) ;=>nil -(macroexpand (cond X Y)) -;=>(if X Y (cond)) (cond true 7) ;=>7 (cond false 7) ;=>nil -(macroexpand (cond X Y Z T)) -;=>(if X Y (cond Z T)) (cond true 7 true 8) ;=>7 (cond false 7 true 8) @@ -163,3 +145,10 @@ x ;=>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/ts/core.ts b/impls/ts/core.ts index e8d7dd513e..a5ca7007f5 100644 --- a/impls/ts/core.ts +++ b/impls/ts/core.ts @@ -6,7 +6,7 @@ import { Node, MalType, MalSymbol, MalFunction, MalNil, MalList, MalVector, MalB import { readStr } from "./reader"; import { prStr } from "./printer"; -export const ns: Map = (() => { +export const ns: Map = (() => { const ns: { [symbol: string]: typeof MalFunction.prototype.func; } = { "="(a: MalType, b: MalType): MalBoolean { return new MalBoolean(equals(a, b)); @@ -435,7 +435,7 @@ export const ns: Map = (() => { }, }; - const map = new Map(); - Object.keys(ns).forEach(key => map.set(MalSymbol.get(key), MalFunction.fromBootstrap(ns[key]))); + 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 index 91f87838aa..61cccceb68 100644 --- a/impls/ts/env.ts +++ b/impls/ts/env.ts @@ -1,48 +1,34 @@ import { MalType, MalSymbol, MalList } from "./types"; export class Env { - data: Map; + data: Map; constructor(public outer?: Env, binds: MalSymbol[] = [], exprts: MalType[] = []) { this.data = new Map(); for (let i = 0; i < binds.length; i++) { - const bind = binds[i]; - if (bind.v === "&") { - this.set(binds[i + 1], new MalList(exprts.slice(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: MalSymbol, value: MalType): MalType { + set(key: string, value: MalType): MalType { this.data.set(key, value); return value; } - find(key: MalSymbol): Env | undefined { - if (this.data.has(key)) { - return this; + 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; } - if (this.outer) { - return this.outer.find(key); - } - - return void 0; - } - - get(key: MalSymbol): MalType { - const env = this.find(key); - if (!env) { - throw new Error(`'${key.v}' not found`); - } - - const v = env.data.get(key); - if (!v) { - throw new Error(`'${key.v}' not found`); - } - - return v; } } diff --git a/impls/ts/step2_eval.ts b/impls/ts/step2_eval.ts index a3b95ccd04..a3a4eaedb8 100644 --- a/impls/ts/step2_eval.ts +++ b/impls/ts/step2_eval.ts @@ -1,6 +1,6 @@ import { readline } from "./node_readline"; -import { Node, MalType, MalNumber, MalList, MalVector, MalHashMap, MalFunction, isSeq } from "./types"; +import { Node, MalType, MalNumber, MalVector, MalHashMap, MalFunction } from "./types"; import { readStr } from "./reader"; import { prStr } from "./printer"; @@ -13,16 +13,19 @@ interface MalEnvironment { [key: string]: MalFunction; } -function evalAST(ast: MalType, env: MalEnvironment): MalType { +// 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(`unknown symbol: ${ast.v}`); + throw new Error(`'${ast.v}' not found`); } return f; case Node.List: - return new MalList(ast.list.map(ast => evalMal(ast, env))); + break; case Node.Vector: return new MalVector(ast.list.map(ast => evalMal(ast, env))); case Node.HashMap: @@ -35,24 +38,14 @@ function evalAST(ast: MalType, env: MalEnvironment): MalType { default: return ast; } -} - -// EVAL -function evalMal(ast: MalType, env: MalEnvironment): MalType { - if (ast.type !== Node.List) { - return evalAST(ast, env); - } if (ast.list.length === 0) { return ast; } - const result = evalAST(ast, env); - if (!isSeq(result)) { - throw new Error(`unexpected return type: ${result.type}, expected: list or vector`); - } - const [f, ...args] = result.list; + 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); } diff --git a/impls/ts/step3_env.ts b/impls/ts/step3_env.ts index 4be842383c..5aec907e2c 100644 --- a/impls/ts/step3_env.ts +++ b/impls/ts/step3_env.ts @@ -1,6 +1,6 @@ import { readline } from "./node_readline"; -import { Node, MalType, MalNumber, MalList, MalVector, MalHashMap, MalSymbol, MalFunction, isSeq } from "./types"; +import { Node, MalType, MalNumber, MalVector, MalHashMap, MalFunction, isSeq } from "./types"; import { Env } from "./env"; import { readStr } from "./reader"; import { prStr } from "./printer"; @@ -10,16 +10,24 @@ function read(str: string): MalType { return readStr(str); } -function evalAST(ast: MalType, env: Env): MalType { +// 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 = env.get(ast); + const f : MalType | null = env.get(ast.v); if (!f) { - throw new Error(`unknown symbol: ${ast.v}`); + throw new Error(`'${ast.v}' not found`); } return f; case Node.List: - return new MalList(ast.list.map(ast => evalMal(ast, env))); + break; case Node.Vector: return new MalVector(ast.list.map(ast => evalMal(ast, env))); case Node.HashMap: @@ -32,13 +40,6 @@ function evalAST(ast: MalType, env: Env): MalType { default: return ast; } -} - -// EVAL -function evalMal(ast: MalType, env: Env): MalType { - if (ast.type !== Node.List) { - return evalAST(ast, env); - } if (ast.list.length === 0) { return ast; } @@ -49,18 +50,18 @@ function evalMal(ast: MalType, env: Env): MalType { case "def!": { const [, key, value] = ast.list; if (key.type !== Node.Symbol) { - throw new Error(`unexpected toke type: ${key.type}, expected: symbol`); + throw new Error(`unexpected token type: ${key.type}, expected: symbol`); } if (!value) { throw new Error(`unexpected syntax`); } - return env.set(key, evalMal(value, env)); + 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 toke type: ${pairs.type}, expected: list or vector`); + 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) { @@ -73,20 +74,17 @@ function evalMal(ast: MalType, env: Env): MalType { throw new Error(`unexpected syntax`); } - letEnv.set(key, evalMal(value, letEnv)); + letEnv.set(key.v, evalMal(value, letEnv)); } return evalMal(ast.list[2], letEnv); } } } - const result = evalAST(ast, env); - if (!isSeq(result)) { - throw new Error(`unexpected return type: ${result.type}, expected: list or vector`); - } - const [f, ...args] = result.list; + 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); } @@ -100,10 +98,10 @@ function rep(str: string): string { return print(evalMal(read(str), replEnv)); } -replEnv.set(MalSymbol.get("+"), MalFunction.fromBootstrap((a?: MalNumber, b?: MalNumber) => new MalNumber(a!.v + b!.v))); -replEnv.set(MalSymbol.get("-"), MalFunction.fromBootstrap((a?: MalNumber, b?: MalNumber) => new MalNumber(a!.v - b!.v))); -replEnv.set(MalSymbol.get("*"), MalFunction.fromBootstrap((a?: MalNumber, b?: MalNumber) => new MalNumber(a!.v * b!.v))); -replEnv.set(MalSymbol.get("/"), 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))); +replEnv.set("/", MalFunction.fromBootstrap((a?: MalNumber, b?: MalNumber) => new MalNumber(a!.v / b!.v))); while (true) { const line = readline("user> "); diff --git a/impls/ts/step4_if_fn_do.ts b/impls/ts/step4_if_fn_do.ts index fd42ed738b..542026bb66 100644 --- a/impls/ts/step4_if_fn_do.ts +++ b/impls/ts/step4_if_fn_do.ts @@ -1,6 +1,6 @@ import { readline } from "./node_readline"; -import { Node, MalType, MalNil, MalList, MalVector, MalHashMap, MalFunction, isAST, isSeq } from "./types"; +import { Node, MalType, MalNil, MalVector, MalHashMap, MalFunction, isAST, isSeq } from "./types"; import { Env } from "./env"; import * as core from "./core"; import { readStr } from "./reader"; @@ -11,16 +11,24 @@ function read(str: string): MalType { return readStr(str); } -function evalAST(ast: MalType, env: Env): MalType { +// 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 = env.get(ast); + const f : MalType | null = env.get(ast.v); if (!f) { - throw new Error(`unknown symbol: ${ast.v}`); + throw new Error(`'${ast.v}' not found`); } return f; case Node.List: - return new MalList(ast.list.map(ast => evalMal(ast, env))); + break; case Node.Vector: return new MalVector(ast.list.map(ast => evalMal(ast, env))); case Node.HashMap: @@ -33,13 +41,6 @@ function evalAST(ast: MalType, env: Env): MalType { default: return ast; } -} - -// EVAL -function evalMal(ast: MalType, env: Env): MalType { - if (ast.type !== Node.List) { - return evalAST(ast, env); - } if (ast.list.length === 0) { return ast; } @@ -55,7 +56,7 @@ function evalMal(ast: MalType, env: Env): MalType { if (!value) { throw new Error(`unexpected syntax`); } - return env.set(key, evalMal(value, env)); + return env.set(key.v, evalMal(value, env)); } case "let*": { let letEnv = new Env(env); @@ -73,17 +74,14 @@ function evalMal(ast: MalType, env: Env): MalType { throw new Error(`unexpected syntax`); } - letEnv.set(key, evalMal(value, letEnv)); + letEnv.set(key.v, evalMal(value, letEnv)); } return evalMal(ast.list[2], letEnv); } case "do": { - const [, ...list] = ast.list; - const ret = evalAST(new MalList(list), env); - if (!isSeq(ret)) { - throw new Error(`unexpected return type: ${ret.type}, expected: list or vector`); - } - return ret.list[ret.list.length - 1]; + 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; @@ -119,14 +117,11 @@ function evalMal(ast: MalType, env: Env): MalType { } } } - const result = evalAST(ast, env); - if (!isSeq(result)) { - throw new Error(`unexpected return type: ${result.type}, expected: list or vector`); - } - const [f, ...args] = result.list; + 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); } diff --git a/impls/ts/step5_tco.ts b/impls/ts/step5_tco.ts index 04f76d4816..7176cb8e3b 100644 --- a/impls/ts/step5_tco.ts +++ b/impls/ts/step5_tco.ts @@ -1,6 +1,6 @@ import { readline } from "./node_readline"; -import { Node, MalType, MalNil, MalList, MalVector, MalHashMap, MalFunction, isAST, isSeq } from "./types"; +import { Node, MalType, MalNil, MalVector, MalHashMap, MalFunction, isAST, isSeq } from "./types"; import { Env } from "./env"; import * as core from "./core"; import { readStr } from "./reader"; @@ -11,16 +11,25 @@ function read(str: string): MalType { return readStr(str); } -function evalAST(ast: MalType, env: Env): MalType { +// 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 = env.get(ast); + const f : MalType | null = env.get(ast.v); if (!f) { - throw new Error(`unknown symbol: ${ast.v}`); + throw new Error(`'${ast.v}' not found`); } return f; case Node.List: - return new MalList(ast.list.map(ast => evalMal(ast, env))); + break; case Node.Vector: return new MalVector(ast.list.map(ast => evalMal(ast, env))); case Node.HashMap: @@ -32,14 +41,6 @@ function evalAST(ast: MalType, env: Env): MalType { return new MalHashMap(list); default: return ast; - } -} - -// EVAL -function evalMal(ast: MalType, env: Env): MalType { - loop: while (true) { - if (ast.type !== Node.List) { - return evalAST(ast, env); } if (ast.list.length === 0) { return ast; @@ -56,7 +57,7 @@ function evalMal(ast: MalType, env: Env): MalType { if (!value) { throw new Error(`unexpected syntax`); } - return env.set(key, evalMal(value, env)); + return env.set(key.v, evalMal(value, env)); } case "let*": { env = new Env(env); @@ -74,14 +75,14 @@ function evalMal(ast: MalType, env: Env): MalType { throw new Error(`unexpected syntax`); } - env.set(key, evalMal(value, env)); + env.set(key.v, evalMal(value, env)); } ast = ast.list[2]; continue loop; } case "do": { - const list = ast.list.slice(1, -1); - evalAST(new MalList(list), env); + for (let i = 1; i < ast.list.length - 1; i++) + evalMal(ast.list[i], env); ast = ast.list[ast.list.length - 1]; continue loop; } @@ -118,14 +119,11 @@ function evalMal(ast: MalType, env: Env): MalType { } } } - const result = evalAST(ast, env); - if (!isSeq(result)) { - throw new Error(`unexpected return type: ${result.type}, expected: list or vector`); - } - const [f, ...args] = result.list; + 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); diff --git a/impls/ts/step6_file.ts b/impls/ts/step6_file.ts index 10747e6eac..290fd30caf 100644 --- a/impls/ts/step6_file.ts +++ b/impls/ts/step6_file.ts @@ -1,6 +1,6 @@ import { readline } from "./node_readline"; -import { Node, MalType, MalString, MalNil, MalList, MalVector, MalHashMap, MalSymbol, MalFunction, isAST, isSeq } from "./types"; +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"; @@ -11,16 +11,25 @@ function read(str: string): MalType { return readStr(str); } -function evalAST(ast: MalType, env: Env): MalType { +// 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 = env.get(ast); + const f : MalType | null = env.get(ast.v); if (!f) { - throw new Error(`unknown symbol: ${ast.v}`); + throw new Error(`'${ast.v}' not found`); } return f; case Node.List: - return new MalList(ast.list.map(ast => evalMal(ast, env))); + break; case Node.Vector: return new MalVector(ast.list.map(ast => evalMal(ast, env))); case Node.HashMap: @@ -32,14 +41,6 @@ function evalAST(ast: MalType, env: Env): MalType { return new MalHashMap(list); default: return ast; - } -} - -// EVAL -function evalMal(ast: MalType, env: Env): MalType { - loop: while (true) { - if (ast.type !== Node.List) { - return evalAST(ast, env); } if (ast.list.length === 0) { return ast; @@ -56,7 +57,7 @@ function evalMal(ast: MalType, env: Env): MalType { if (!value) { throw new Error(`unexpected syntax`); } - return env.set(key, evalMal(value, env)); + return env.set(key.v, evalMal(value, env)); } case "let*": { env = new Env(env); @@ -74,14 +75,14 @@ function evalMal(ast: MalType, env: Env): MalType { throw new Error(`unexpected syntax`); } - env.set(key, evalMal(value, env)); + env.set(key.v, evalMal(value, env)); } ast = ast.list[2]; continue loop; } case "do": { - const list = ast.list.slice(1, -1); - evalAST(new MalList(list), env); + for (let i = 1; i < ast.list.length - 1; i++) + evalMal(ast.list[i], env); ast = ast.list[ast.list.length - 1]; continue loop; } @@ -118,14 +119,11 @@ function evalMal(ast: MalType, env: Env): MalType { } } } - const result = evalAST(ast, env); - if (!isSeq(result)) { - throw new Error(`unexpected return type: ${result.type}, expected: list or vector`); - } - const [f, ...args] = result.list; + 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); @@ -150,21 +148,20 @@ function rep(str: string): string { core.ns.forEach((value, key) => { replEnv.set(key, value); }); -replEnv.set(MalSymbol.get("eval"), MalFunction.fromBootstrap(ast => { +replEnv.set("eval", MalFunction.fromBootstrap(ast => { if (!ast) { throw new Error(`undefined argument`); } return evalMal(ast, replEnv); })); - -replEnv.set(MalSymbol.get("*ARGV*"), new MalList([])); +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(MalSymbol.get("*ARGV*"), new MalList(process.argv.slice(3).map(s => new MalString(s)))); + replEnv.set("*ARGV*", new MalList(process.argv.slice(3).map(s => new MalString(s)))); rep(`(load-file "${process.argv[2]}")`); process.exit(0); } diff --git a/impls/ts/step7_quote.ts b/impls/ts/step7_quote.ts index 2b1d47f82f..72279a6692 100644 --- a/impls/ts/step7_quote.ts +++ b/impls/ts/step7_quote.ts @@ -57,16 +57,25 @@ function quasiquote(ast: MalType): MalType { } } -function evalAST(ast: MalType, env: Env): MalType { +// 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 = env.get(ast); + const f : MalType | null = env.get(ast.v); if (!f) { - throw new Error(`unknown symbol: ${ast.v}`); + throw new Error(`'${ast.v}' not found`); } return f; case Node.List: - return new MalList(ast.list.map(ast => evalMal(ast, env))); + break; case Node.Vector: return new MalVector(ast.list.map(ast => evalMal(ast, env))); case Node.HashMap: @@ -78,14 +87,6 @@ function evalAST(ast: MalType, env: Env): MalType { return new MalHashMap(list); default: return ast; - } -} - -// EVAL -function evalMal(ast: MalType, env: Env): MalType { - loop: while (true) { - if (ast.type !== Node.List) { - return evalAST(ast, env); } if (ast.list.length === 0) { return ast; @@ -102,7 +103,7 @@ function evalMal(ast: MalType, env: Env): MalType { if (!value) { throw new Error(`unexpected syntax`); } - return env.set(key, evalMal(value, env)); + return env.set(key.v, evalMal(value, env)); } case "let*": { env = new Env(env); @@ -120,7 +121,7 @@ function evalMal(ast: MalType, env: Env): MalType { throw new Error(`unexpected syntax`); } - env.set(key, evalMal(value, env)); + env.set(key.v, evalMal(value, env)); } ast = ast.list[2]; continue loop; @@ -128,16 +129,13 @@ function evalMal(ast: MalType, env: Env): MalType { case "quote": { return ast.list[1]; } - case "quasiquoteexpand": { - return quasiquote(ast.list[1]); - } case "quasiquote": { ast = quasiquote(ast.list[1]); continue loop; } case "do": { - const list = ast.list.slice(1, -1); - evalAST(new MalList(list), env); + for (let i = 1; i < ast.list.length - 1; i++) + evalMal(ast.list[i], env); ast = ast.list[ast.list.length - 1]; continue loop; } @@ -174,14 +172,11 @@ function evalMal(ast: MalType, env: Env): MalType { } } } - const result = evalAST(ast, env); - if (!isSeq(result)) { - throw new Error(`unexpected return type: ${result.type}, expected: list or vector`); - } - const [f, ...args] = result.list; + 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); @@ -206,20 +201,20 @@ function rep(str: string): string { core.ns.forEach((value, key) => { replEnv.set(key, value); }); -replEnv.set(MalSymbol.get("eval"), MalFunction.fromBootstrap(ast => { +replEnv.set("eval", MalFunction.fromBootstrap(ast => { if (!ast) { throw new Error(`undefined argument`); } return evalMal(ast, replEnv); })); -replEnv.set(MalSymbol.get("*ARGV*"), new MalList([])); +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(MalSymbol.get("*ARGV*"), new MalList(process.argv.slice(3).map(s => new MalString(s)))); + replEnv.set("*ARGV*", new MalList(process.argv.slice(3).map(s => new MalString(s)))); rep(`(load-file "${process.argv[2]}")`); process.exit(0); } diff --git a/impls/ts/step8_macros.ts b/impls/ts/step8_macros.ts index b9610a687d..bb53fc7ffa 100644 --- a/impls/ts/step8_macros.ts +++ b/impls/ts/step8_macros.ts @@ -57,56 +57,25 @@ function quasiquote(ast: MalType): MalType { } } -function isMacro(ast: MalType, env: Env): boolean { - if (!isSeq(ast)) { - return false; - } - const s = ast.list[0]; - if (s.type !== Node.Symbol) { - return false; - } - const foundEnv = env.find(s); - if (!foundEnv) { - return false; - } - - const f = foundEnv.get(s); - if (f.type !== Node.Function) { - return false; - } - - return f.isMacro; -} - -function macroexpand(ast: MalType, env: Env): MalType { - while (isMacro(ast, env)) { - if (!isSeq(ast)) { - throw new Error(`unexpected token type: ${ast.type}, expected: list or vector`); - } - const s = ast.list[0]; - if (s.type !== Node.Symbol) { - throw new Error(`unexpected token type: ${s.type}, expected: symbol`); - } - const f = env.get(s); - if (f.type !== Node.Function) { - throw new Error(`unexpected token type: ${f.type}, expected: function`); - } - ast = f.func(...ast.list.slice(1)); - } - - return ast; -} - -function evalAST(ast: MalType, env: Env): MalType { +// 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 = env.get(ast); + const f : MalType | null = env.get(ast.v); if (!f) { - throw new Error(`unknown symbol: ${ast.v}`); + throw new Error(`'${ast.v}' not found`); } return f; case Node.List: - return new MalList(ast.list.map(ast => evalMal(ast, env))); + break; case Node.Vector: return new MalVector(ast.list.map(ast => evalMal(ast, env))); case Node.HashMap: @@ -118,24 +87,7 @@ function evalAST(ast: MalType, env: Env): MalType { return new MalHashMap(list); default: return ast; - } -} - -// EVAL -function evalMal(ast: MalType, env: Env): MalType { - loop: while (true) { - if (ast.type !== Node.List) { - return evalAST(ast, env); - } - if (ast.list.length === 0) { - return ast; - } - - ast = macroexpand(ast, env); - if (!isSeq(ast)) { - return evalAST(ast, env); } - if (ast.list.length === 0) { return ast; } @@ -151,7 +103,7 @@ function evalMal(ast: MalType, env: Env): MalType { if (!value) { throw new Error(`unexpected syntax`); } - return env.set(key, evalMal(value, env)); + return env.set(key.v, evalMal(value, env)); } case "let*": { env = new Env(env); @@ -169,7 +121,7 @@ function evalMal(ast: MalType, env: Env): MalType { throw new Error(`unexpected syntax`); } - env.set(key, evalMal(value, env)); + env.set(key.v, evalMal(value, env)); } ast = ast.list[2]; continue loop; @@ -177,9 +129,6 @@ function evalMal(ast: MalType, env: Env): MalType { case "quote": { return ast.list[1]; } - case "quasiquoteexpand": { - return quasiquote(ast.list[1]); - } case "quasiquote": { ast = quasiquote(ast.list[1]); continue loop; @@ -196,14 +145,11 @@ function evalMal(ast: MalType, env: Env): MalType { if (f.type !== Node.Function) { throw new Error(`unexpected token type: ${f.type}, expected: function`); } - return env.set(key, f.toMacro()); - } - case "macroexpand": { - return macroexpand(ast.list[1], env); + return env.set(key.v, f.toMacro()); } case "do": { - const list = ast.list.slice(1, -1); - evalAST(new MalList(list), env); + for (let i = 1; i < ast.list.length - 1; i++) + evalMal(ast.list[i], env); ast = ast.list[ast.list.length - 1]; continue loop; } @@ -240,14 +186,15 @@ function evalMal(ast: MalType, env: Env): MalType { } } } - const result = evalAST(ast, env); - if (!isSeq(result)) { - throw new Error(`unexpected return type: ${result.type}, expected: list or vector`); - } - const [f, ...args] = result.list; + 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); @@ -272,13 +219,13 @@ function rep(str: string): string { core.ns.forEach((value, key) => { replEnv.set(key, value); }); -replEnv.set(MalSymbol.get("eval"), MalFunction.fromBootstrap(ast => { +replEnv.set("eval", MalFunction.fromBootstrap(ast => { if (!ast) { throw new Error(`undefined argument`); } return evalMal(ast, replEnv); })); -replEnv.set(MalSymbol.get("*ARGV*"), new MalList([])); +replEnv.set("*ARGV*", new MalList([])); // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))"); @@ -286,7 +233,7 @@ 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(MalSymbol.get("*ARGV*"), new MalList(process.argv.slice(3).map(s => new MalString(s)))); + replEnv.set("*ARGV*", new MalList(process.argv.slice(3).map(s => new MalString(s)))); rep(`(load-file "${process.argv[2]}")`); process.exit(0); } diff --git a/impls/ts/step9_try.ts b/impls/ts/step9_try.ts index 2e4767b517..188642c607 100644 --- a/impls/ts/step9_try.ts +++ b/impls/ts/step9_try.ts @@ -57,56 +57,25 @@ function quasiquote(ast: MalType): MalType { } } -function isMacro(ast: MalType, env: Env): boolean { - if (!isSeq(ast)) { - return false; - } - const s = ast.list[0]; - if (s.type !== Node.Symbol) { - return false; - } - const foundEnv = env.find(s); - if (!foundEnv) { - return false; - } - - const f = foundEnv.get(s); - if (f.type !== Node.Function) { - return false; - } - - return f.isMacro; -} - -function macroexpand(ast: MalType, env: Env): MalType { - while (isMacro(ast, env)) { - if (!isSeq(ast)) { - throw new Error(`unexpected token type: ${ast.type}, expected: list or vector`); - } - const s = ast.list[0]; - if (s.type !== Node.Symbol) { - throw new Error(`unexpected token type: ${s.type}, expected: symbol`); - } - const f = env.get(s); - if (f.type !== Node.Function) { - throw new Error(`unexpected token type: ${f.type}, expected: function`); - } - ast = f.func(...ast.list.slice(1)); - } - - return ast; -} - -function evalAST(ast: MalType, env: Env): MalType { +// 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 = env.get(ast); + const f : MalType | null = env.get(ast.v); if (!f) { - throw new Error(`unknown symbol: ${ast.v}`); + throw new Error(`'${ast.v}' not found`); } return f; case Node.List: - return new MalList(ast.list.map(ast => evalMal(ast, env))); + break; case Node.Vector: return new MalVector(ast.list.map(ast => evalMal(ast, env))); case Node.HashMap: @@ -118,24 +87,7 @@ function evalAST(ast: MalType, env: Env): MalType { return new MalHashMap(list); default: return ast; - } -} - -// EVAL -function evalMal(ast: MalType, env: Env): MalType { - loop: while (true) { - if (ast.type !== Node.List) { - return evalAST(ast, env); - } - if (ast.list.length === 0) { - return ast; - } - - ast = macroexpand(ast, env); - if (!isSeq(ast)) { - return evalAST(ast, env); } - if (ast.list.length === 0) { return ast; } @@ -151,7 +103,7 @@ function evalMal(ast: MalType, env: Env): MalType { if (!value) { throw new Error(`unexpected syntax`); } - return env.set(key, evalMal(value, env)); + return env.set(key.v, evalMal(value, env)); } case "let*": { env = new Env(env); @@ -169,7 +121,7 @@ function evalMal(ast: MalType, env: Env): MalType { throw new Error(`unexpected syntax`); } - env.set(key, evalMal(value, env)); + env.set(key.v, evalMal(value, env)); } ast = ast.list[2]; continue loop; @@ -177,9 +129,6 @@ function evalMal(ast: MalType, env: Env): MalType { case "quote": { return ast.list[1]; } - case "quasiquoteexpand": { - return quasiquote(ast.list[1]); - } case "quasiquote": { ast = quasiquote(ast.list[1]); continue loop; @@ -196,10 +145,7 @@ function evalMal(ast: MalType, env: Env): MalType { if (f.type !== Node.Function) { throw new Error(`unexpected token type: ${f.type}, expected: function`); } - return env.set(key, f.toMacro()); - } - case "macroexpand": { - return macroexpand(ast.list[1], env); + return env.set(key.v, f.toMacro()); } case "try*": { try { @@ -227,8 +173,8 @@ function evalMal(ast: MalType, env: Env): MalType { } } case "do": { - const list = ast.list.slice(1, -1); - evalAST(new MalList(list), env); + for (let i = 1; i < ast.list.length - 1; i++) + evalMal(ast.list[i], env); ast = ast.list[ast.list.length - 1]; continue loop; } @@ -265,14 +211,15 @@ function evalMal(ast: MalType, env: Env): MalType { } } } - const result = evalAST(ast, env); - if (!isSeq(result)) { - throw new Error(`unexpected return type: ${result.type}, expected: list or vector`); - } - const [f, ...args] = result.list; + 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); @@ -297,13 +244,13 @@ function rep(str: string): string { core.ns.forEach((value, key) => { replEnv.set(key, value); }); -replEnv.set(MalSymbol.get("eval"), MalFunction.fromBootstrap(ast => { +replEnv.set("eval", MalFunction.fromBootstrap(ast => { if (!ast) { throw new Error(`undefined argument`); } return evalMal(ast, replEnv); })); -replEnv.set(MalSymbol.get("*ARGV*"), new MalList([])); +replEnv.set("*ARGV*", new MalList([])); // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))"); @@ -311,7 +258,7 @@ 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(MalSymbol.get("*ARGV*"), new MalList(process.argv.slice(3).map(s => new MalString(s)))); + replEnv.set("*ARGV*", new MalList(process.argv.slice(3).map(s => new MalString(s)))); rep(`(load-file "${process.argv[2]}")`); process.exit(0); } diff --git a/impls/ts/stepA_mal.ts b/impls/ts/stepA_mal.ts index e61f8ce30f..e0280665a3 100644 --- a/impls/ts/stepA_mal.ts +++ b/impls/ts/stepA_mal.ts @@ -57,56 +57,25 @@ function quasiquote(ast: MalType): MalType { } } -function isMacro(ast: MalType, env: Env): boolean { - if (!isSeq(ast)) { - return false; - } - const s = ast.list[0]; - if (s.type !== Node.Symbol) { - return false; - } - const foundEnv = env.find(s); - if (!foundEnv) { - return false; - } - - const f = foundEnv.get(s); - if (f.type !== Node.Function) { - return false; - } - - return f.isMacro; -} - -function macroexpand(ast: MalType, env: Env): MalType { - while (isMacro(ast, env)) { - if (!isSeq(ast)) { - throw new Error(`unexpected token type: ${ast.type}, expected: list or vector`); - } - const s = ast.list[0]; - if (s.type !== Node.Symbol) { - throw new Error(`unexpected token type: ${s.type}, expected: symbol`); - } - const f = env.get(s); - if (f.type !== Node.Function) { - throw new Error(`unexpected token type: ${f.type}, expected: function`); - } - ast = f.func(...ast.list.slice(1)); - } - - return ast; -} - -function evalAST(ast: MalType, env: Env): MalType { +// 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 = env.get(ast); + const f : MalType | null = env.get(ast.v); if (!f) { - throw new Error(`unknown symbol: ${ast.v}`); + throw new Error(`'${ast.v}' not found`); } return f; case Node.List: - return new MalList(ast.list.map(ast => evalMal(ast, env))); + break; case Node.Vector: return new MalVector(ast.list.map(ast => evalMal(ast, env))); case Node.HashMap: @@ -118,24 +87,7 @@ function evalAST(ast: MalType, env: Env): MalType { return new MalHashMap(list); default: return ast; - } -} - -// EVAL -function evalMal(ast: MalType, env: Env): MalType { - loop: while (true) { - if (ast.type !== Node.List) { - return evalAST(ast, env); - } - if (ast.list.length === 0) { - return ast; - } - - ast = macroexpand(ast, env); - if (!isSeq(ast)) { - return evalAST(ast, env); } - if (ast.list.length === 0) { return ast; } @@ -151,7 +103,7 @@ function evalMal(ast: MalType, env: Env): MalType { if (!value) { throw new Error(`unexpected syntax`); } - return env.set(key, evalMal(value, env)); + return env.set(key.v, evalMal(value, env)); } case "let*": { env = new Env(env); @@ -169,7 +121,7 @@ function evalMal(ast: MalType, env: Env): MalType { throw new Error(`unexpected syntax`); } - env.set(key, evalMal(value, env)); + env.set(key.v, evalMal(value, env)); } ast = ast.list[2]; continue loop; @@ -177,9 +129,6 @@ function evalMal(ast: MalType, env: Env): MalType { case "quote": { return ast.list[1]; } - case "quasiquoteexpand": { - return quasiquote(ast.list[1]); - } case "quasiquote": { ast = quasiquote(ast.list[1]); continue loop; @@ -196,10 +145,7 @@ function evalMal(ast: MalType, env: Env): MalType { if (f.type !== Node.Function) { throw new Error(`unexpected token type: ${f.type}, expected: function`); } - return env.set(key, f.toMacro()); - } - case "macroexpand": { - return macroexpand(ast.list[1], env); + return env.set(key.v, f.toMacro()); } case "try*": { try { @@ -227,8 +173,8 @@ function evalMal(ast: MalType, env: Env): MalType { } } case "do": { - const list = ast.list.slice(1, -1); - evalAST(new MalList(list), env); + for (let i = 1; i < ast.list.length - 1; i++) + evalMal(ast.list[i], env); ast = ast.list[ast.list.length - 1]; continue loop; } @@ -265,14 +211,15 @@ function evalMal(ast: MalType, env: Env): MalType { } } } - const result = evalAST(ast, env); - if (!isSeq(result)) { - throw new Error(`unexpected return type: ${result.type}, expected: list or vector`); - } - const [f, ...args] = result.list; + 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); @@ -297,13 +244,13 @@ function rep(str: string): string { core.ns.forEach((value, key) => { replEnv.set(key, value); }); -replEnv.set(MalSymbol.get("eval"), MalFunction.fromBootstrap(ast => { +replEnv.set("eval", MalFunction.fromBootstrap(ast => { if (!ast) { throw new Error(`undefined argument`); } return evalMal(ast, replEnv); })); -replEnv.set(MalSymbol.get("*ARGV*"), new MalList([])); +replEnv.set("*ARGV*", new MalList([])); // core.mal: defined using the language itself rep(`(def! *host-language* "TypeScript")`); @@ -312,7 +259,7 @@ 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(MalSymbol.get("*ARGV*"), new MalList(process.argv.slice(3).map(s => new MalString(s)))); + replEnv.set("*ARGV*", new MalList(process.argv.slice(3).map(s => new MalString(s)))); rep(`(load-file "${process.argv[2]}")`); process.exit(0); } diff --git a/impls/vb/env.vb b/impls/vb/env.vb index a2c46289a3..b0f53616ce 100644 --- a/impls/vb/env.vb +++ b/impls/vb/env.vb @@ -26,26 +26,16 @@ Namespace Mal Next End Sub - Public Function find(key As MalSymbol) As Env - If data.ContainsKey(key.getName()) Then - return Me + 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.find(key) + return outer.do_get(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 diff --git a/impls/vb/step2_eval.vb b/impls/vb/step2_eval.vb index 6e45efe85f..9aa42b60c2 100644 --- a/impls/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/impls/vb/step3_env.vb b/impls/vb/step3_env.vb index dfee614b74..9a64659391 100644 --- a/impls/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/impls/vb/step4_if_fn_do.vb b/impls/vb/step4_if_fn_do.vb index 470ae86661..886cabe1be 100644 --- a/impls/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/impls/vb/step5_tco.vb b/impls/vb/step5_tco.vb index bb36b22bbf..11b26bfa55 100644 --- a/impls/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/impls/vb/step6_file.vb b/impls/vb/step6_file.vb index 8c9c43504b..6602445446 100644 --- a/impls/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 diff --git a/impls/vb/step7_quote.vb b/impls/vb/step7_quote.vb index 3303f31861..27c059ab27 100644 --- a/impls/vb/step7_quote.vb +++ b/impls/vb/step7_quote.vb @@ -61,36 +61,6 @@ Namespace Mal return result 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 @@ -104,9 +74,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 @@ -144,12 +141,12 @@ Namespace Mal env = let_env Case "quote" return ast(1) - Case "quasiquoteexpand" - return quasiquote(ast(1)) Case "quasiquote" orig_ast = quasiquote(ast(1)) 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) @@ -176,7 +173,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/impls/vb/step8_macros.vb b/impls/vb/step8_macros.vb index 43befb9eba..f29e20bc59 100644 --- a/impls/vb/step8_macros.vb +++ b/impls/vb/step8_macros.vb @@ -61,83 +61,53 @@ Namespace Mal return result 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 + ' 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 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(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 - 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) + 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 - - ' 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) + Else If not orig_ast.list_Q() Then + return orig_ast 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) + Dim ast As MalList = DirectCast(orig_ast, MalList) If ast.size() = 0 Then return ast @@ -172,22 +142,18 @@ Namespace Mal env = let_env Case "quote" return ast(1) - Case "quasiquoteexpand" - return quasiquote(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() + Dim res As MalVal = DirectCast(EVAL(a2, env), MalFunc).asMacro() 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) + 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) @@ -214,14 +180,21 @@ Namespace Mal 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 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(el.rest()) + env = f.genEnv(args) Else - Return f.apply(el.rest()) + Return f.apply(args) End If End Select diff --git a/impls/vb/step9_try.vb b/impls/vb/step9_try.vb index e8f35a0b4c..7f318fc70a 100644 --- a/impls/vb/step9_try.vb +++ b/impls/vb/step9_try.vb @@ -61,83 +61,53 @@ Namespace Mal return result 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 + ' 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 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(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 - 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) + 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 - - ' 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) + Else If not orig_ast.list_Q() Then + return orig_ast 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) + Dim ast As MalList = DirectCast(orig_ast, MalList) If ast.size() = 0 Then return ast @@ -172,20 +142,14 @@ Namespace Mal env = let_env Case "quote" return ast(1) - Case "quasiquoteexpand" - return quasiquote(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() + Dim res As MalVal = DirectCast(EVAL(a2, env), MalFunc).asMacro() 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) @@ -210,7 +174,9 @@ Namespace Mal Throw e End Try 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) @@ -237,14 +203,21 @@ Namespace Mal 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 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(el.rest()) + env = f.genEnv(args) Else - Return f.apply(el.rest()) + Return f.apply(args) End If End Select diff --git a/impls/vb/stepA_mal.vb b/impls/vb/stepA_mal.vb index ba289f5c3c..8825921d73 100644 --- a/impls/vb/stepA_mal.vb +++ b/impls/vb/stepA_mal.vb @@ -61,83 +61,53 @@ Namespace Mal return result 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 + ' 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 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(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 - 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) + 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 - - ' 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) + Else If not orig_ast.list_Q() Then + return orig_ast 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) + Dim ast As MalList = DirectCast(orig_ast, MalList) If ast.size() = 0 Then return ast @@ -172,20 +142,14 @@ Namespace Mal env = let_env Case "quote" return ast(1) - Case "quasiquoteexpand" - return quasiquote(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() + Dim res As MalVal = DirectCast(EVAL(a2, env), MalFunc).asMacro() 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) @@ -210,7 +174,9 @@ Namespace Mal Throw e End Try 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) @@ -237,14 +203,21 @@ Namespace Mal 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 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(el.rest()) + env = f.genEnv(args) Else - Return f.apply(el.rest()) + Return f.apply(args) End If End Select diff --git a/impls/vb/types.vb b/impls/vb/types.vb index 711011ece6..c1b534e525 100644 --- a/impls/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/vhdl/env.vhdl b/impls/vhdl/env.vhdl index 1625a9aba6..ae2040b3c3 100644 --- a/impls/vhdl/env.vhdl +++ b/impls/vhdl/env.vhdl @@ -7,7 +7,9 @@ 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); + procedure env_get(e : inout env_ptr; + key : inout mal_val_ptr; + result : out mal_val_ptr); end package env; package body env is @@ -42,31 +44,21 @@ package body env is 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; + 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 - 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); + loop + hashmap_get(environment.data, key, val); + exit when val /= null; + environment := environment.outer; + exit when environment = null; + end loop; + result := val; + return; end procedure env_get; end package body env; diff --git a/impls/vhdl/pkg_readline.vhdl b/impls/vhdl/pkg_readline.vhdl index c06ff0bdf1..74e0bbf8d1 100644 --- a/impls/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/impls/vhdl/step2_eval.vhdl b/impls/vhdl/step2_eval.vhdl index 0a643f4da6..a9efe834e5 100644 --- a/impls/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/impls/vhdl/step3_env.vhdl b/impls/vhdl/step3_env.vhdl index 3542ff1c82..73b8503c3a 100644 --- a/impls/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/impls/vhdl/step4_if_fn_do.vhdl b/impls/vhdl/step4_if_fn_do.vhdl index d28101a6be..6e63f77f72 100644 --- a/impls/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/impls/vhdl/step5_tco.vhdl b/impls/vhdl/step5_tco.vhdl index 6f8f030b6b..617d4ee6ed 100644 --- a/impls/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/impls/vhdl/step6_file.vhdl b/impls/vhdl/step6_file.vhdl index 2bcb3fbcec..3b21c0e37e 100644 --- a/impls/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; diff --git a/impls/vhdl/step7_quote.vhdl b/impls/vhdl/step7_quote.vhdl index d24b29350d..b9f68d7621 100644 --- a/impls/vhdl/step7_quote.vhdl +++ b/impls/vhdl/step7_quote.vhdl @@ -147,12 +147,16 @@ architecture test of step7_quote 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; @@ -160,22 +164,42 @@ architecture test of step7_quote 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; @@ -186,20 +210,6 @@ architecture test of step7_quote 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; @@ -239,10 +249,6 @@ architecture test of step7_quote is result := ast.seq_val(1); return; - elsif a0.string_val.all = "quasiquoteexpand" then - quasiquote(ast.seq_val(1), result); - return; - elsif a0.string_val.all = "quasiquote" then quasiquote(ast.seq_val(1), ast); next; -- TCO @@ -283,26 +289,27 @@ architecture test of step7_quote 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; diff --git a/impls/vhdl/step8_macros.vhdl b/impls/vhdl/step8_macros.vhdl index 8b799ad4d2..b78c865a7a 100644 --- a/impls/vhdl/step8_macros.vhdl +++ b/impls/vhdl/step8_macros.vhdl @@ -97,40 +97,6 @@ architecture test of step8_macros is 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); @@ -181,12 +147,16 @@ architecture test of step8_macros 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; @@ -194,22 +164,42 @@ architecture test of step8_macros 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; @@ -220,30 +210,7 @@ architecture test of step8_macros 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; - 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; @@ -282,10 +249,6 @@ architecture test of step8_macros is result := ast.seq_val(1); return; - elsif a0.string_val.all = "quasiquoteexpand" then - quasiquote(ast.seq_val(1), result); - return; - elsif a0.string_val.all = "quasiquote" then quasiquote(ast.seq_val(1), ast); next; -- TCO @@ -302,10 +265,6 @@ architecture test of step8_macros is 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); @@ -342,26 +301,37 @@ architecture test of step8_macros 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); + -- 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; - when mal_fn => + 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 - 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; diff --git a/impls/vhdl/step9_try.vhdl b/impls/vhdl/step9_try.vhdl index 583acb729e..34ad23e9b4 100644 --- a/impls/vhdl/step9_try.vhdl +++ b/impls/vhdl/step9_try.vhdl @@ -97,40 +97,6 @@ architecture test of step9_try is 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); @@ -221,12 +187,16 @@ architecture test of step9_try 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; @@ -234,22 +204,42 @@ architecture test of step9_try 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, 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, 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; @@ -260,30 +250,7 @@ architecture test of step9_try 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, 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; @@ -322,10 +289,6 @@ architecture test of step9_try is result := ast.seq_val(1); return; - elsif a0.string_val.all = "quasiquoteexpand" then - quasiquote(ast.seq_val(1), result); - return; - elsif a0.string_val.all = "quasiquote" then quasiquote(ast.seq_val(1), ast); next; -- TCO @@ -342,10 +305,6 @@ architecture test of step9_try is 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 @@ -400,26 +359,37 @@ architecture test of step9_try 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); + -- 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; - when mal_fn => + 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 - 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; diff --git a/impls/vhdl/stepA_mal.vhdl b/impls/vhdl/stepA_mal.vhdl index bcbaadcd29..570e55dd10 100644 --- a/impls/vhdl/stepA_mal.vhdl +++ b/impls/vhdl/stepA_mal.vhdl @@ -97,40 +97,6 @@ architecture test of stepA_mal is 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); @@ -221,12 +187,16 @@ architecture test of stepA_mal 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; @@ -234,22 +204,42 @@ architecture test of stepA_mal 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, 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, 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; @@ -260,30 +250,7 @@ architecture test of stepA_mal 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, 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; @@ -322,10 +289,6 @@ architecture test of stepA_mal is result := ast.seq_val(1); return; - elsif a0.string_val.all = "quasiquoteexpand" then - quasiquote(ast.seq_val(1), result); - return; - elsif a0.string_val.all = "quasiquote" then quasiquote(ast.seq_val(1), ast); next; -- TCO @@ -342,10 +305,6 @@ architecture test of stepA_mal is 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 @@ -400,26 +359,37 @@ architecture test of stepA_mal 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); + -- 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; - when mal_fn => + 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 - 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; diff --git a/impls/vimscript/env.vim b/impls/vimscript/env.vim index 3316e19356..7487882288 100644 --- a/impls/vimscript/env.vim +++ b/impls/vimscript/env.vim @@ -29,27 +29,20 @@ function NewEnvWithBinds(outer, binds, exprs) 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] + 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 diff --git a/impls/vimscript/step2_eval.vim b/impls/vimscript/step2_eval.vim index 5b476d3492..97038b968f 100644 --- a/impls/vimscript/step2_eval.vim +++ b/impls/vimscript/step2_eval.vim @@ -7,15 +7,15 @@ function READ(str) return ReadStr(a:str) endfunction -function EvalAst(ast, env) +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 ListQ(a:ast) - return ListNew(map(copy(a:ast.val), {_, e -> EVAL(e, a:env)})) elseif VectorQ(a:ast) return VectorNew(map(copy(a:ast.val), {_, e -> EVAL(e, a:env)})) elseif HashQ(a:ast) @@ -25,21 +25,16 @@ function EvalAst(ast, env) let ret[k] = newval endfor return HashNew(ret) - else - return a:ast - end -endfunction - -function EVAL(ast, env) + endif if !ListQ(a:ast) - return EvalAst(a:ast, a:env) + return a:ast end if EmptyQ(a:ast) return a:ast endif " apply list - let el = EvalAst(a:ast, a:env) + let el = ListNew(map(copy(a:ast.val), {_, e -> EVAL(e, a:env)})) let Fn = el.val[0] return Fn(el.val[1:-1]) diff --git a/impls/vimscript/step3_env.vim b/impls/vimscript/step3_env.vim index 813944dbc9..a1405226ed 100644 --- a/impls/vimscript/step3_env.vim +++ b/impls/vimscript/step3_env.vim @@ -8,12 +8,19 @@ function READ(str) return ReadStr(a:str) endfunction -function EvalAst(ast, env) +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 - return a:env.get(varname) - elseif ListQ(a:ast) - return ListNew(map(copy(a:ast.val), {_, e -> EVAL(e, a:env)})) + 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) @@ -23,14 +30,9 @@ function EvalAst(ast, env) let ret[k] = newval endfor return HashNew(ret) - else - return a:ast - end -endfunction - -function EVAL(ast, env) + endif if !ListQ(a:ast) - return EvalAst(a:ast, a:env) + return a:ast end if EmptyQ(a:ast) return a:ast @@ -54,7 +56,7 @@ function EVAL(ast, env) return EVAL(a2, let_env) else " apply list - let el = EvalAst(a:ast, a:env) + 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 diff --git a/impls/vimscript/step4_if_fn_do.vim b/impls/vimscript/step4_if_fn_do.vim index 60664469ad..48a9ca91e3 100644 --- a/impls/vimscript/step4_if_fn_do.vim +++ b/impls/vimscript/step4_if_fn_do.vim @@ -9,12 +9,19 @@ function READ(str) return ReadStr(a:str) endfunction -function EvalAst(ast, env) +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 - return a:env.get(varname) - elseif ListQ(a:ast) - return ListNew(map(copy(a:ast.val), {_, e -> EVAL(e, a:env)})) + 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) @@ -24,14 +31,9 @@ function EvalAst(ast, env) let ret[k] = newval endfor return HashNew(ret) - else - return a:ast - end -endfunction - -function EVAL(ast, env) + endif if !ListQ(a:ast) - return EvalAst(a:ast, a:env) + return a:ast end if EmptyQ(a:ast) return a:ast @@ -67,14 +69,17 @@ function EVAL(ast, env) return EVAL(a:ast.val[2], a:env) endif elseif first_symbol == "do" - let el = EvalAst(ListRest(a:ast), a:env) - return el.val[-1] + 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 = EvalAst(a:ast, a:env) + let el = ListNew(map(copy(a:ast.val), {_, e -> EVAL(e, a:env)})) let funcobj = ListFirst(el) let args = ListRest(el) if NativeFunctionQ(funcobj) diff --git a/impls/vimscript/step5_tco.vim b/impls/vimscript/step5_tco.vim index 87fd6271ed..dcf9c089b9 100644 --- a/impls/vimscript/step5_tco.vim +++ b/impls/vimscript/step5_tco.vim @@ -9,33 +9,36 @@ function READ(str) return ReadStr(a:str) endfunction -function EvalAst(ast, env) - if SymbolQ(a:ast) - let varname = a:ast.val - return a:env.get(varname) - elseif ListQ(a:ast) - return ListNew(map(copy(a:ast.val), {_, e -> EVAL(e, a:env)})) - 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) - else - return a:ast - 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 EvalAst(ast, env) + return ast end if EmptyQ(ast) return ast @@ -74,7 +77,9 @@ function EVAL(ast, env) " TCO elseif first_symbol == "do" let astlist = ast.val - call EvalAst(ListNew(astlist[1:-2]), env) + for elt in astlist[1:-2] + let ignored = EVAL(elt, env) + endfor let ast = astlist[-1] " TCO elseif first_symbol == "fn*" @@ -82,7 +87,7 @@ function EVAL(ast, env) return fn else " apply list - let el = EvalAst(ast, env) + let el = ListNew(map(copy(ast.val), {_, e -> EVAL(e, env)})) let funcobj = ListFirst(el) let args = ListRest(el) if NativeFunctionQ(funcobj) diff --git a/impls/vimscript/step6_file.vim b/impls/vimscript/step6_file.vim index 8a5cfb589f..5e7a02abc3 100644 --- a/impls/vimscript/step6_file.vim +++ b/impls/vimscript/step6_file.vim @@ -9,33 +9,36 @@ function READ(str) return ReadStr(a:str) endfunction -function EvalAst(ast, env) - if SymbolQ(a:ast) - let varname = a:ast.val - return a:env.get(varname) - elseif ListQ(a:ast) - return ListNew(map(copy(a:ast.val), {_, e -> EVAL(e, a:env)})) - 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) - else - return a:ast - 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 EvalAst(ast, env) + return ast end if EmptyQ(ast) return ast @@ -74,7 +77,9 @@ function EVAL(ast, env) " TCO elseif first_symbol == "do" let astlist = ast.val - call EvalAst(ListNew(astlist[1:-2]), env) + for elt in astlist[1:-2] + let ignored = EVAL(elt, env) + endfor let ast = astlist[-1] " TCO elseif first_symbol == "fn*" @@ -86,7 +91,7 @@ function EVAL(ast, env) " TCO else " apply list - let el = EvalAst(ast, env) + let el = ListNew(map(copy(ast.val), {_, e -> EVAL(e, env)})) let funcobj = ListFirst(el) let args = ListRest(el) if NativeFunctionQ(funcobj) diff --git a/impls/vimscript/step7_quote.vim b/impls/vimscript/step7_quote.vim index 7cee83261f..a15113814c 100644 --- a/impls/vimscript/step7_quote.vim +++ b/impls/vimscript/step7_quote.vim @@ -44,33 +44,36 @@ function Quasiquote(ast) endif endfunction -function EvalAst(ast, env) - if SymbolQ(a:ast) - let varname = a:ast.val - return a:env.get(varname) - elseif ListQ(a:ast) - return ListNew(map(copy(a:ast.val), {_, e -> EVAL(e, a:env)})) - 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) - else - return a:ast - 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 EvalAst(ast, env) + return ast end if EmptyQ(ast) return ast @@ -97,8 +100,6 @@ function EVAL(ast, env) " TCO elseif first_symbol == "quote" return ListNth(ast, 1) - elseif first_symbol == "quasiquoteexpand" - return Quasiquote(ListNth(ast, 1)) elseif first_symbol == "quasiquote" let ast = Quasiquote(ListNth(ast, 1)) " TCO @@ -116,7 +117,9 @@ function EVAL(ast, env) " TCO elseif first_symbol == "do" let astlist = ast.val - call EvalAst(ListNew(astlist[1:-2]), env) + for elt in astlist[1:-2] + let ignored = EVAL(elt, env) + endfor let ast = astlist[-1] " TCO elseif first_symbol == "fn*" @@ -128,7 +131,7 @@ function EVAL(ast, env) " TCO else " apply list - let el = EvalAst(ast, env) + let el = ListNew(map(copy(ast.val), {_, e -> EVAL(e, env)})) let funcobj = ListFirst(el) let args = ListRest(el) if NativeFunctionQ(funcobj) diff --git a/impls/vimscript/step8_macros.vim b/impls/vimscript/step8_macros.vim index c2f23d43aa..fcbb60ba86 100644 --- a/impls/vimscript/step8_macros.vim +++ b/impls/vimscript/step8_macros.vim @@ -44,63 +44,36 @@ function Quasiquote(ast) endif 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 = a0.val - 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(ListFirst(ast).val) - let macroargs = ListRest(ast) - let ast = FuncInvoke(macroobj, macroargs) - endwhile - return ast -endfunction - -function EvalAst(ast, env) - if SymbolQ(a:ast) - let varname = a:ast.val - return a:env.get(varname) - elseif ListQ(a:ast) - return ListNew(map(copy(a:ast.val), {_, e -> EVAL(e, a:env)})) - 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) - 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) + 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 EvalAst(ast, env) + return ast end if EmptyQ(ast) return ast @@ -126,8 +99,6 @@ function EVAL(ast, env) " TCO elseif first_symbol == "quote" return ListNth(ast, 1) - elseif first_symbol == "quasiquoteexpand" - return Quasiquote(ListNth(ast, 1)) elseif first_symbol == "quasiquote" let ast = Quasiquote(ListNth(ast, 1)) " TCO @@ -136,8 +107,6 @@ function EVAL(ast, env) let a2 = ListNth(ast, 2) let macro = MarkAsMacro(EVAL(a2, env)) return env.set(a1.val, macro) - elseif first_symbol == "macroexpand" - return MacroExpand(ListNth(ast, 1), env) elseif first_symbol == "if" let condvalue = EVAL(ast.val[1], env) if FalseQ(condvalue) || NilQ(condvalue) @@ -152,7 +121,9 @@ function EVAL(ast, env) " TCO elseif first_symbol == "do" let astlist = ast.val - call EvalAst(ListNew(astlist[1:-2]), env) + for elt in astlist[1:-2] + let ignored = EVAL(elt, env) + endfor let ast = astlist[-1] " TCO elseif first_symbol == "fn*" @@ -164,9 +135,14 @@ function EVAL(ast, env) " TCO else " apply list - let el = EvalAst(ast, env) - let funcobj = ListFirst(el) - let args = ListRest(el) + 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) diff --git a/impls/vimscript/step9_try.vim b/impls/vimscript/step9_try.vim index 46b30e99ae..8bdaf691b2 100644 --- a/impls/vimscript/step9_try.vim +++ b/impls/vimscript/step9_try.vim @@ -46,51 +46,6 @@ function Quasiquote(ast) endif 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 = a0.val - 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(ListFirst(ast).val) - let macroargs = ListRest(ast) - let ast = FuncInvoke(macroobj, macroargs) - endwhile - return ast -endfunction - -function EvalAst(ast, env) - if SymbolQ(a:ast) - let varname = a:ast.val - return a:env.get(varname) - elseif ListQ(a:ast) - return ListNew(map(copy(a:ast.val), {_, e -> EVAL(e, a:env)})) - 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) - else - return a:ast - end -endfunction - function GetCatchClause(ast) if ListCount(a:ast) < 3 return "" @@ -108,13 +63,31 @@ function EVAL(ast, env) let env = a:env while 1 - if !ListQ(ast) - return EvalAst(ast, env) - end - let ast = MacroExpand(ast, env) + 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 EvalAst(ast, env) + return ast end if EmptyQ(ast) return ast @@ -140,8 +113,6 @@ function EVAL(ast, env) " TCO elseif first_symbol == "quote" return ListNth(ast, 1) - elseif first_symbol == "quasiquoteexpand" - return Quasiquote(ListNth(ast, 1)) elseif first_symbol == "quasiquote" let ast = Quasiquote(ListNth(ast, 1)) " TCO @@ -150,8 +121,6 @@ function EVAL(ast, env) let a2 = ListNth(ast, 2) let macro = MarkAsMacro(EVAL(a2, env)) return env.set(a1.val, macro) - elseif first_symbol == "macroexpand" - return MacroExpand(ListNth(ast, 1), env) elseif first_symbol == "if" let condvalue = EVAL(ast.val[1], env) if FalseQ(condvalue) || NilQ(condvalue) @@ -184,7 +153,9 @@ function EVAL(ast, env) endtry elseif first_symbol == "do" let astlist = ast.val - call EvalAst(ListNew(astlist[1:-2]), env) + for elt in astlist[1:-2] + let ignored = EVAL(elt, env) + endfor let ast = astlist[-1] " TCO elseif first_symbol == "fn*" @@ -196,9 +167,14 @@ function EVAL(ast, env) " TCO else " apply list - let el = EvalAst(ast, env) - let funcobj = ListFirst(el) - let args = ListRest(el) + 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) diff --git a/impls/vimscript/stepA_mal.vim b/impls/vimscript/stepA_mal.vim index 2ca2a7ca22..99a6e393ae 100644 --- a/impls/vimscript/stepA_mal.vim +++ b/impls/vimscript/stepA_mal.vim @@ -46,51 +46,6 @@ function Quasiquote(ast) endif 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 = a0.val - 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(ListFirst(ast).val) - let macroargs = ListRest(ast) - let ast = FuncInvoke(macroobj, macroargs) - endwhile - return ast -endfunction - -function EvalAst(ast, env) - if SymbolQ(a:ast) - let varname = a:ast.val - return a:env.get(varname) - elseif ListQ(a:ast) - return ListNew(map(copy(a:ast.val), {_, e -> EVAL(e, a:env)})) - 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) - else - return a:ast - end -endfunction - function GetCatchClause(ast) if ListCount(a:ast) < 3 return "" @@ -108,13 +63,31 @@ function EVAL(ast, env) let env = a:env while 1 - if !ListQ(ast) - return EvalAst(ast, env) - end - let ast = MacroExpand(ast, env) + 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 EvalAst(ast, env) + return ast end if EmptyQ(ast) return ast @@ -140,8 +113,6 @@ function EVAL(ast, env) " TCO elseif first_symbol == "quote" return ListNth(ast, 1) - elseif first_symbol == "quasiquoteexpand" - return Quasiquote(ListNth(ast, 1)) elseif first_symbol == "quasiquote" let ast = Quasiquote(ListNth(ast, 1)) " TCO @@ -150,8 +121,6 @@ function EVAL(ast, env) let a2 = ListNth(ast, 2) let macro = MarkAsMacro(EVAL(a2, env)) return env.set(a1.val, macro) - elseif first_symbol == "macroexpand" - return MacroExpand(ListNth(ast, 1), env) elseif first_symbol == "if" let condvalue = EVAL(ast.val[1], env) if FalseQ(condvalue) || NilQ(condvalue) @@ -184,7 +153,9 @@ function EVAL(ast, env) endtry elseif first_symbol == "do" let astlist = ast.val - call EvalAst(ListNew(astlist[1:-2]), env) + for elt in astlist[1:-2] + let ignored = EVAL(elt, env) + endfor let ast = astlist[-1] " TCO elseif first_symbol == "fn*" @@ -196,9 +167,14 @@ function EVAL(ast, env) " TCO else " apply list - let el = EvalAst(ast, env) - let funcobj = ListFirst(el) - let args = ListRest(el) + 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) diff --git a/impls/wren/step2_eval.wren b/impls/wren/step2_eval.wren index 47d5ec8240..5dc298261a 100644 --- a/impls/wren/step2_eval.wren +++ b/impls/wren/step2_eval.wren @@ -8,12 +8,15 @@ class Mal { return MalReader.read_str(str) } - static eval_ast(ast, env) { + 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) { - return MalList.new(ast.elements.map { |e| eval(e, env) }.toList) + // 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) { @@ -25,12 +28,9 @@ class Mal { } else { return ast } - } - - static eval(ast, env) { - if (!(ast is MalList)) return eval_ast(ast, env) + // ast is a list, search for special forms if (ast.isEmpty) return ast - var evaled_ast = eval_ast(ast, env) + var evaled_ast = ast.elements.map { |e| eval(e, env) }.toList var f = evaled_ast[0] return f.call(evaled_ast[1..-1]) } diff --git a/impls/wren/step3_env.wren b/impls/wren/step3_env.wren index 5cd44d9207..ee5da6bc0a 100644 --- a/impls/wren/step3_env.wren +++ b/impls/wren/step3_env.wren @@ -9,11 +9,17 @@ class Mal { return MalReader.read_str(str) } - static eval_ast(ast, env) { + 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) { - return MalList.new(ast.elements.map { |e| eval(e, env) }.toList) + // 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) { @@ -25,10 +31,7 @@ class Mal { } else { return ast } - } - - static eval(ast, env) { - if (!(ast is MalList)) return eval_ast(ast, env) + // ast is a list, search for special forms if (ast.isEmpty) return ast if (ast[0] is MalSymbol) { if (ast[0].value == "def!") { @@ -43,7 +46,7 @@ class Mal { return eval(ast[2], letEnv) } } - var evaled_ast = eval_ast(ast, env) + var evaled_ast = ast.elements.map { |e| eval(e, env) }.toList var f = evaled_ast[0] return f.call(evaled_ast[1..-1]) } diff --git a/impls/wren/step4_if_fn_do.wren b/impls/wren/step4_if_fn_do.wren index 0399464200..42d972336e 100644 --- a/impls/wren/step4_if_fn_do.wren +++ b/impls/wren/step4_if_fn_do.wren @@ -10,11 +10,16 @@ class Mal { return MalReader.read_str(str) } - static eval_ast(ast, env) { + 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) { - return MalList.new(ast.elements.map { |e| eval(e, env) }.toList) + // 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) { @@ -26,10 +31,7 @@ class Mal { } else { return ast } - } - - static eval(ast, env) { - if (!(ast is MalList)) return eval_ast(ast, env) + // ast is a list, search for special forms if (ast.isEmpty) return ast if (ast[0] is MalSymbol) { if (ast[0].value == "def!") { @@ -43,7 +45,10 @@ class Mal { } return eval(ast[2], letEnv) } else if (ast[0].value == "do") { - return eval_ast(ast.rest, env)[-1] + 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) { @@ -55,7 +60,7 @@ class Mal { return Fn.new { |a| eval(ast[2], Env.new(env, ast[1].elements, a)) } } } - var evaled_ast = eval_ast(ast, env) + var evaled_ast = ast.elements.map { |e| eval(e, env) }.toList var f = evaled_ast[0] return f.call(evaled_ast[1..-1]) } diff --git a/impls/wren/step5_tco.wren b/impls/wren/step5_tco.wren index f52f0e2f20..6756d31fee 100644 --- a/impls/wren/step5_tco.wren +++ b/impls/wren/step5_tco.wren @@ -10,11 +10,21 @@ class Mal { return MalReader.read_str(str) } - static eval_ast(ast, env) { + 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) { - return MalList.new(ast.elements.map { |e| eval(e, env) }.toList) + // 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) { @@ -26,12 +36,8 @@ class Mal { } else { return ast } - } + // ast is a list, search for special forms - static eval(ast, env) { - while (true) { - var tco = false - if (!(ast is MalList)) return eval_ast(ast, env) if (ast.isEmpty) return ast if (ast[0] is MalSymbol) { if (ast[0].value == "def!") { @@ -67,7 +73,7 @@ class Mal { } } if (!tco) { - var evaled_ast = eval_ast(ast, env) + 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]) diff --git a/impls/wren/step6_file.wren b/impls/wren/step6_file.wren index 81a87eb792..3359de3731 100644 --- a/impls/wren/step6_file.wren +++ b/impls/wren/step6_file.wren @@ -11,11 +11,21 @@ class Mal { return MalReader.read_str(str) } - static eval_ast(ast, env) { + 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) { - return MalList.new(ast.elements.map { |e| eval(e, env) }.toList) + // 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) { @@ -27,12 +37,8 @@ class Mal { } else { return ast } - } + // ast is a list, search for special forms - static eval(ast, env) { - while (true) { - var tco = false - if (!(ast is MalList)) return eval_ast(ast, env) if (ast.isEmpty) return ast if (ast[0] is MalSymbol) { if (ast[0].value == "def!") { @@ -68,7 +74,7 @@ class Mal { } } if (!tco) { - var evaled_ast = eval_ast(ast, env) + 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]) diff --git a/impls/wren/step7_quote.wren b/impls/wren/step7_quote.wren index 985c18cc9d..95a3c62394 100644 --- a/impls/wren/step7_quote.wren +++ b/impls/wren/step7_quote.wren @@ -45,11 +45,21 @@ class Mal { } } - static eval_ast(ast, env) { + 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) { - return MalList.new(ast.elements.map { |e| eval(e, env) }.toList) + // 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) { @@ -61,12 +71,8 @@ class Mal { } else { return ast } - } + // ast is a list, search for special forms - static eval(ast, env) { - while (true) { - var tco = false - if (!(ast is MalList)) return eval_ast(ast, env) if (ast.isEmpty) return ast if (ast[0] is MalSymbol) { if (ast[0].value == "def!") { @@ -83,8 +89,6 @@ class Mal { tco = true } else if (ast[0].value == "quote") { return ast[1] - } else if (ast[0].value == "quasiquoteexpand") { - return quasiquote(ast[1]) } else if (ast[0].value == "quasiquote") { ast = quasiquote(ast[1]) tco = true @@ -109,7 +113,7 @@ class Mal { } } if (!tco) { - var evaled_ast = eval_ast(ast, env) + 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]) diff --git a/impls/wren/step8_macros.wren b/impls/wren/step8_macros.wren index f45ed967f9..5a44a25db4 100644 --- a/impls/wren/step8_macros.wren +++ b/impls/wren/step8_macros.wren @@ -45,28 +45,21 @@ class Mal { } } - static isMacro(ast, env) { - return (ast is MalList && - !ast.isEmpty && - ast[0] is MalSymbol && - env.find(ast[0].value) && - env.get(ast[0].value) is MalFn && - env.get(ast[0].value).isMacro) - } + static eval(ast, env) { - static macroexpand(ast, env) { - while (isMacro(ast, env)) { - var macro = env.get(ast[0].value) - ast = macro.call(ast.elements[1..-1]) - } - return ast - } + while (true) { + var tco = false - static eval_ast(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) { - return MalList.new(ast.elements.map { |e| eval(e, env) }.toList) + // 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) { @@ -78,14 +71,8 @@ class Mal { } else { return ast } - } + // ast is a list, search for special forms - static eval(ast, env) { - while (true) { - var tco = false - if (!(ast is MalList)) return eval_ast(ast, env) - ast = macroexpand(ast, env) - if (!(ast is MalList)) return eval_ast(ast, env) if (ast.isEmpty) return ast if (ast[0] is MalSymbol) { if (ast[0].value == "def!") { @@ -102,15 +89,11 @@ class Mal { tco = true } else if (ast[0].value == "quote") { return ast[1] - } else if (ast[0].value == "quasiquoteexpand") { - return quasiquote(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 == "macroexpand") { - return macroexpand(ast[1], env) } else if (ast[0].value == "do") { for (i in 1...(ast.count - 1)) { eval(ast[i], env) @@ -132,14 +115,18 @@ class Mal { } } if (!tco) { - var evaled_ast = eval_ast(ast, env) - var f = evaled_ast[0] + var f = eval(ast[0], env) if (f is MalNativeFn) { - return f.call(evaled_ast[1..-1]) + 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, evaled_ast[1..-1]) - tco = true + env = Env.new(f.env, f.params, args) + } } else { Fiber.abort("unknown function type") } diff --git a/impls/wren/step9_try.wren b/impls/wren/step9_try.wren index d891cb36eb..7997813f9a 100644 --- a/impls/wren/step9_try.wren +++ b/impls/wren/step9_try.wren @@ -45,28 +45,21 @@ class Mal { } } - static isMacro(ast, env) { - return (ast is MalList && - !ast.isEmpty && - ast[0] is MalSymbol && - env.find(ast[0].value) && - env.get(ast[0].value) is MalFn && - env.get(ast[0].value).isMacro) - } + static eval(ast, env) { - static macroexpand(ast, env) { - while (isMacro(ast, env)) { - var macro = env.get(ast[0].value) - ast = macro.call(ast.elements[1..-1]) - } - return ast - } + while (true) { + var tco = false - static eval_ast(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) { - return MalList.new(ast.elements.map { |e| eval(e, env) }.toList) + // 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) { @@ -78,14 +71,8 @@ class Mal { } else { return ast } - } + // ast is a list, search for special forms - static eval(ast, env) { - while (true) { - var tco = false - if (!(ast is MalList)) return eval_ast(ast, env) - ast = macroexpand(ast, env) - if (!(ast is MalList)) return eval_ast(ast, env) if (ast.isEmpty) return ast if (ast[0] is MalSymbol) { if (ast[0].value == "def!") { @@ -102,15 +89,11 @@ class Mal { tco = true } else if (ast[0].value == "quote") { return ast[1] - } else if (ast[0].value == "quasiquoteexpand") { - return quasiquote(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 == "macroexpand") { - return macroexpand(ast[1], env) } 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) } @@ -146,14 +129,18 @@ class Mal { } } if (!tco) { - var evaled_ast = eval_ast(ast, env) - var f = evaled_ast[0] + var f = eval(ast[0], env) if (f is MalNativeFn) { - return f.call(evaled_ast[1..-1]) + 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, evaled_ast[1..-1]) - tco = true + env = Env.new(f.env, f.params, args) + } } else { Fiber.abort("unknown function type") } diff --git a/impls/wren/stepA_mal.wren b/impls/wren/stepA_mal.wren index aa2f130543..0f4945611f 100644 --- a/impls/wren/stepA_mal.wren +++ b/impls/wren/stepA_mal.wren @@ -45,28 +45,21 @@ class Mal { } } - static isMacro(ast, env) { - return (ast is MalList && - !ast.isEmpty && - ast[0] is MalSymbol && - env.find(ast[0].value) && - env.get(ast[0].value) is MalFn && - env.get(ast[0].value).isMacro) - } + static eval(ast, env) { - static macroexpand(ast, env) { - while (isMacro(ast, env)) { - var macro = env.get(ast[0].value) - ast = macro.call(ast.elements[1..-1]) - } - return ast - } + while (true) { + var tco = false - static eval_ast(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) { - return MalList.new(ast.elements.map { |e| eval(e, env) }.toList) + // 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) { @@ -78,14 +71,8 @@ class Mal { } else { return ast } - } + // ast is a list, search for special forms - static eval(ast, env) { - while (true) { - var tco = false - if (!(ast is MalList)) return eval_ast(ast, env) - ast = macroexpand(ast, env) - if (!(ast is MalList)) return eval_ast(ast, env) if (ast.isEmpty) return ast if (ast[0] is MalSymbol) { if (ast[0].value == "def!") { @@ -102,15 +89,11 @@ class Mal { tco = true } else if (ast[0].value == "quote") { return ast[1] - } else if (ast[0].value == "quasiquoteexpand") { - return quasiquote(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 == "macroexpand") { - return macroexpand(ast[1], env) } 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) } @@ -146,14 +129,18 @@ class Mal { } } if (!tco) { - var evaled_ast = eval_ast(ast, env) - var f = evaled_ast[0] + var f = eval(ast[0], env) if (f is MalNativeFn) { - return f.call(evaled_ast[1..-1]) + 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, evaled_ast[1..-1]) - tco = true + env = Env.new(f.env, f.params, args) + } } else { Fiber.abort("unknown function type") } diff --git a/impls/yorick/step2_eval.i b/impls/yorick/step2_eval.i index 4b9cb6861f..40730a4967 100644 --- a/impls/yorick/step2_eval.i +++ b/impls/yorick/step2_eval.i @@ -10,12 +10,6 @@ func READ(str) func eval_ast(ast, env) { - 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) { seq = *(ast.val) if (numberof(seq) == 0) return ast res = array(pointer, numberof(seq)) @@ -25,6 +19,19 @@ func eval_ast(ast, env) 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 @@ -46,12 +53,7 @@ func eval_ast(ast, env) } return MalHashmap(val=&res) } else return ast -} - -func EVAL(ast, env) -{ - if (structof(ast) == MalError) return ast - if (structof(ast) != MalList) return eval_ast(ast, env) + // 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 diff --git a/impls/yorick/step3_env.i b/impls/yorick/step3_env.i index cf56f84c37..604fb35a20 100644 --- a/impls/yorick/step3_env.i +++ b/impls/yorick/step3_env.i @@ -11,10 +11,6 @@ func READ(str) func eval_ast(ast, env) { - type = structof(ast) - if (type == MalSymbol) { - return env_get(env, ast.val) - } else if (type == MalList) { seq = *(ast.val) if (numberof(seq) == 0) return ast res = array(pointer, numberof(seq)) @@ -24,6 +20,20 @@ func eval_ast(ast, env) 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 @@ -45,12 +55,7 @@ func eval_ast(ast, env) } return MalHashmap(val=&res) } else return ast -} - -func EVAL(ast, env) -{ - if (structof(ast) == MalError) return ast - if (structof(ast) != MalList) return eval_ast(ast, env) + // The else branch includes MalError. Now ast is a list. lst = *ast.val if (numberof(lst) == 0) return ast a1 = lst(1)->val diff --git a/impls/yorick/step4_if_fn_do.i b/impls/yorick/step4_if_fn_do.i index 8c20c070d9..6dac870716 100644 --- a/impls/yorick/step4_if_fn_do.i +++ b/impls/yorick/step4_if_fn_do.i @@ -11,10 +11,6 @@ func READ(str) func eval_ast(ast, env) { - type = structof(ast) - if (type == MalSymbol) { - return env_get(env, ast.val) - } else if (type == MalList) { seq = *(ast.val) if (numberof(seq) == 0) return ast res = array(pointer, numberof(seq)) @@ -24,6 +20,20 @@ func eval_ast(ast, env) 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 @@ -45,12 +55,7 @@ func eval_ast(ast, env) } return MalHashmap(val=&res) } else return ast -} - -func EVAL(ast, env) -{ - if (structof(ast) == MalError) return ast - if (structof(ast) != MalList) return eval_ast(ast, env) + // The else branch includes MalError. Now ast is a list. lst = *ast.val if (numberof(lst) == 0) return ast a1 = lst(1)->val diff --git a/impls/yorick/step5_tco.i b/impls/yorick/step5_tco.i index 159d95640c..a9c8ffd96b 100644 --- a/impls/yorick/step5_tco.i +++ b/impls/yorick/step5_tco.i @@ -11,10 +11,6 @@ func READ(str) func eval_ast(ast, env) { - type = structof(ast) - if (type == MalSymbol) { - return env_get(env, ast.val) - } else if (type == MalList) { seq = *(ast.val) if (numberof(seq) == 0) return ast res = array(pointer, numberof(seq)) @@ -24,6 +20,21 @@ func eval_ast(ast, env) 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 @@ -45,13 +56,7 @@ func eval_ast(ast, env) } return MalHashmap(val=&res) } else return ast -} - -func EVAL(ast, env) -{ - while (1) { - if (structof(ast) == MalError) return ast - if (structof(ast) != MalList) return eval_ast(ast, env) + // The else branch includes MalError. Now ast is a list. lst = *ast.val if (numberof(lst) == 0) return ast a1 = lst(1)->val diff --git a/impls/yorick/step6_file.i b/impls/yorick/step6_file.i index 3ae3a8dabd..9780f11926 100644 --- a/impls/yorick/step6_file.i +++ b/impls/yorick/step6_file.i @@ -11,10 +11,6 @@ func READ(str) func eval_ast(ast, env) { - type = structof(ast) - if (type == MalSymbol) { - return env_get(env, ast.val) - } else if (type == MalList) { seq = *(ast.val) if (numberof(seq) == 0) return ast res = array(pointer, numberof(seq)) @@ -24,6 +20,21 @@ func eval_ast(ast, env) 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 @@ -45,13 +56,7 @@ func eval_ast(ast, env) } return MalHashmap(val=&res) } else return ast -} - -func EVAL(ast, env) -{ - while (1) { - if (structof(ast) == MalError) return ast - if (structof(ast) != MalList) return eval_ast(ast, env) + // The else branch includes MalError. Now ast is a list. lst = *ast.val if (numberof(lst) == 0) return ast a1 = lst(1)->val diff --git a/impls/yorick/step7_quote.i b/impls/yorick/step7_quote.i index 273aa0efe4..4cd664ac38 100644 --- a/impls/yorick/step7_quote.i +++ b/impls/yorick/step7_quote.i @@ -49,10 +49,6 @@ func quasiquote(ast) func eval_ast(ast, env) { - type = structof(ast) - if (type == MalSymbol) { - return env_get(env, ast.val) - } else if (type == MalList) { seq = *(ast.val) if (numberof(seq) == 0) return ast res = array(pointer, numberof(seq)) @@ -62,6 +58,21 @@ func eval_ast(ast, env) 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 @@ -83,13 +94,7 @@ func eval_ast(ast, env) } return MalHashmap(val=&res) } else return ast -} - -func EVAL(ast, env) -{ - while (1) { - if (structof(ast) == MalError) return ast - if (structof(ast) != MalList) return eval_ast(ast, env) + // The else branch includes MalError. Now ast is a list. lst = *ast.val if (numberof(lst) == 0) return ast a1 = lst(1)->val @@ -111,8 +116,6 @@ func EVAL(ast, env) // TCO } else if (a1 == "quote") { return *lst(2) - } else if (a1 == "quasiquoteexpand") { - return quasiquote(*lst(2)) } else if (a1 == "quasiquote") { ast = quasiquote(*lst(2)) // TCO } else if (a1 == "do") { diff --git a/impls/yorick/step8_macros.i b/impls/yorick/step8_macros.i index a52a0d3b6b..0060ecec7e 100644 --- a/impls/yorick/step8_macros.i +++ b/impls/yorick/step8_macros.i @@ -47,46 +47,19 @@ func quasiquote(ast) } } -func is_macro_call(ast, env) -{ - if (structof(ast) != MalList) return 0 - if (count(ast) == 0) return 0 - a1 = *((*ast.val)(1)) - if (structof(a1) != MalSymbol) return 0 - var_name = a1.val - found_env = env_find(env, var_name) - if (is_void(found_env)) return 0 - obj = env_get(env, var_name) - return is_macro(obj) -} - -func macroexpand(ast, env) -{ - while (is_macro_call(ast, env)) { - macro_name = (*ast.val)(1)->val - macro_obj = env_get(env, macro_name) - macro_args = *rest(ast).val - fn_env = env_new(macro_obj.env, binds=*macro_obj.binds, exprs=macro_args) - ast = EVAL(*macro_obj.ast, fn_env) - } - return ast -} - -func eval_ast(ast, env) +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) { - 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) + // Proceed after this switch. } else if (type == MalVector) { seq = *(ast.val) if (numberof(seq) == 0) return ast @@ -108,15 +81,7 @@ func eval_ast(ast, env) } return MalHashmap(val=&res) } else return ast -} - -func EVAL(ast, env) -{ - while (1) { - if (structof(ast) == MalError) return ast - if (structof(ast) != MalList) return eval_ast(ast, env) - ast = macroexpand(ast, env) - if (structof(ast) != MalList) return eval_ast(ast, env) + // The else branch includes MalError. Now ast is a list. lst = *ast.val if (numberof(lst) == 0) return ast a1 = lst(1)->val @@ -138,8 +103,6 @@ func EVAL(ast, env) // TCO } else if (a1 == "quote") { return *lst(2) - } else if (a1 == "quasiquoteexpand") { - return quasiquote(*lst(2)) } else if (a1 == "quasiquote") { ast = quasiquote(*lst(2)) // TCO } else if (a1 == "defmacro!") { @@ -147,8 +110,6 @@ func EVAL(ast, 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 == "macroexpand") { - return macroexpand(*lst(2), env) } else if (a1 == "do") { for (i = 2; i < numberof(lst); ++i) { ret = EVAL(*lst(i), env) @@ -172,16 +133,34 @@ func EVAL(ast, env) } else if (a1 == "fn*") { return MalFunction(env=&env, binds=lst(2)->val, ast=lst(3), macro=0) } 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) + 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 diff --git a/impls/yorick/step9_try.i b/impls/yorick/step9_try.i index 6d46571ddc..73df6647b9 100644 --- a/impls/yorick/step9_try.i +++ b/impls/yorick/step9_try.i @@ -47,46 +47,19 @@ func quasiquote(ast) } } -func is_macro_call(ast, env) -{ - if (structof(ast) != MalList) return 0 - if (count(ast) == 0) return 0 - a1 = *((*ast.val)(1)) - if (structof(a1) != MalSymbol) return 0 - var_name = a1.val - found_env = env_find(env, var_name) - if (is_void(found_env)) return 0 - obj = env_get(env, var_name) - return is_macro(obj) -} - -func macroexpand(ast, env) -{ - while (is_macro_call(ast, env)) { - macro_name = (*ast.val)(1)->val - macro_obj = env_get(env, macro_name) - macro_args = *rest(ast).val - fn_env = env_new(macro_obj.env, binds=*macro_obj.binds, exprs=macro_args) - ast = EVAL(*macro_obj.ast, fn_env) - } - return ast -} - -func eval_ast(ast, env) +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) { - 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) + // Proceed after this switch. } else if (type == MalVector) { seq = *(ast.val) if (numberof(seq) == 0) return ast @@ -108,15 +81,7 @@ func eval_ast(ast, env) } return MalHashmap(val=&res) } else return ast -} - -func EVAL(ast, env) -{ - while (1) { - if (structof(ast) == MalError) return ast - if (structof(ast) != MalList) return eval_ast(ast, env) - ast = macroexpand(ast, env) - if (structof(ast) != MalList) return eval_ast(ast, env) + // The else branch includes MalError. Now ast is a list. lst = *ast.val if (numberof(lst) == 0) return ast a1 = lst(1)->val @@ -138,8 +103,6 @@ func EVAL(ast, env) // TCO } else if (a1 == "quote") { return *lst(2) - } else if (a1 == "quasiquoteexpand") { - return quasiquote(*lst(2)) } else if (a1 == "quasiquote") { ast = quasiquote(*lst(2)) // TCO } else if (a1 == "defmacro!") { @@ -147,8 +110,6 @@ func EVAL(ast, 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 == "macroexpand") { - return macroexpand(*lst(2), env) } else if (a1 == "try*") { ret = EVAL(*lst(2), env) if (structof(ret) == MalError && numberof(lst) > 2) { @@ -186,16 +147,34 @@ func EVAL(ast, env) } else if (a1 == "fn*") { return MalFunction(env=&env, binds=lst(2)->val, ast=lst(3), macro=0) } 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) + 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 diff --git a/impls/yorick/stepA_mal.i b/impls/yorick/stepA_mal.i index fe90a24892..5251fafe8c 100644 --- a/impls/yorick/stepA_mal.i +++ b/impls/yorick/stepA_mal.i @@ -47,46 +47,19 @@ func quasiquote(ast) } } -func is_macro_call(ast, env) -{ - if (structof(ast) != MalList) return 0 - if (count(ast) == 0) return 0 - a1 = *((*ast.val)(1)) - if (structof(a1) != MalSymbol) return 0 - var_name = a1.val - found_env = env_find(env, var_name) - if (is_void(found_env)) return 0 - obj = env_get(env, var_name) - return is_macro(obj) -} - -func macroexpand(ast, env) -{ - while (is_macro_call(ast, env)) { - macro_name = (*ast.val)(1)->val - macro_obj = env_get(env, macro_name) - macro_args = *rest(ast).val - fn_env = env_new(macro_obj.env, binds=*macro_obj.binds, exprs=macro_args) - ast = EVAL(*macro_obj.ast, fn_env) - } - return ast -} - -func eval_ast(ast, env) +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) { - 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) + // Proceed after this switch. } else if (type == MalVector) { seq = *(ast.val) if (numberof(seq) == 0) return ast @@ -108,15 +81,7 @@ func eval_ast(ast, env) } return MalHashmap(val=&res) } else return ast -} - -func EVAL(ast, env) -{ - while (1) { - if (structof(ast) == MalError) return ast - if (structof(ast) != MalList) return eval_ast(ast, env) - ast = macroexpand(ast, env) - if (structof(ast) != MalList) return eval_ast(ast, env) + // The else branch includes MalError. Now ast is a list. lst = *ast.val if (numberof(lst) == 0) return ast a1 = lst(1)->val @@ -138,8 +103,6 @@ func EVAL(ast, env) // TCO } else if (a1 == "quote") { return *lst(2) - } else if (a1 == "quasiquoteexpand") { - return quasiquote(*lst(2)) } else if (a1 == "quasiquote") { ast = quasiquote(*lst(2)) // TCO } else if (a1 == "defmacro!") { @@ -147,8 +110,6 @@ func EVAL(ast, 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 == "macroexpand") { - return macroexpand(*lst(2), env) } else if (a1 == "try*") { ret = EVAL(*lst(2), env) if (structof(ret) == MalError && numberof(lst) > 2) { @@ -186,16 +147,34 @@ func EVAL(ast, env) } else if (a1 == "fn*") { return MalFunction(env=&env, binds=lst(2)->val, ast=lst(3), macro=0) } 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) + 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 diff --git a/process/guide.md b/process/guide.md index 3f0ee86c81..1fc22483cb 100644 --- a/process/guide.md +++ b/process/guide.md @@ -541,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 if 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 @@ -585,8 +579,17 @@ 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 @@ -634,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: @@ -667,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 @@ -757,7 +759,7 @@ diff -urp ../process/step3_env.txt ../process/step4_if_fn_do.txt * 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 @@ -905,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). @@ -930,7 +932,7 @@ diff -urp ../process/step4_if_fn_do.txt ../process/step5_tco.txt * 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 of the + 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 @@ -1216,15 +1218,11 @@ Mal borrows most of its syntax and feature-set). Such forms are not affected by evaluation, so you may quote them as in the previous case if implementation is easier. -* Optionally, add a the `quasiquoteexpand` special form. - This form calls the `quasiquote` function using the first `ast` - argument (second list element) and returns the result. - It has no other practical purpose than testing your implementation - of the `quasiquote` internal function. - * Add the `quasiquote` special form. - This form does the same than `quasiquoteexpand`, - but evaluates the result in the current environment before returning it, + + 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). @@ -1234,6 +1232,11 @@ 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 exciting step: @@ -1313,35 +1316,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: ``` @@ -1352,14 +1348,14 @@ 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 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.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.txt b/process/step4_if_fn_do.txt index f92e141c60..8085df5c12 100644 --- a/process/step4_if_fn_do.txt +++ b/process/step4_if_fn_do.txt @@ -3,24 +3,34 @@ 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) @@ -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.txt b/process/step5_tco.txt index cb1d4125b4..1fd6d0540c 100644 --- a/process/step5_tco.txt +++ b/process/step5_tco.txt @@ -3,26 +3,35 @@ 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) @@ -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.txt b/process/step6_file.txt index ca4f7061ac..221f4ba7e5 100644 --- a/process/step6_file.txt +++ b/process/step6_file.txt @@ -3,26 +3,35 @@ 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) @@ -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.txt b/process/step7_quote.txt index fb29c98bb3..fb103551fc 100644 --- a/process/step7_quote.txt +++ b/process/step7_quote.txt @@ -5,28 +5,37 @@ READ(str): return reader.read_str(str) 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) @@ -55,8 +64,7 @@ class Env (outer=null,binds=[],exprs=[]) if binds[i] == '&: data[binds[i+1]] = exprs.drop(i); break else: data[binds[i]] = exprs[i] set(k,v): return data.set(k,v) - find(k): return data.has(k) ? this : (if outer ? find(outer) : null) - get(k): return data.find(k).get(k) OR raise "'" + k + "' not found" + get(k): return data.has(k) ? data.get(k) : (outer ? outer.get(k) : null) --- core module --------------------------------- ns = {'=: equal?, diff --git a/process/step8_macros.txt b/process/step8_macros.txt index 52f01e33f6..87cabd7e62 100644 --- a/process/step8_macros.txt +++ b/process/step8_macros.txt @@ -5,37 +5,40 @@ READ(str): return reader.read_str(str) 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) @@ -65,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?, diff --git a/process/step9_try.txt b/process/step9_try.txt index 35217b98ee..a27c785a36 100644 --- a/process/step9_try.txt +++ b/process/step9_try.txt @@ -5,38 +5,46 @@ READ(str): return reader.read_str(str) 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) @@ -66,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?, diff --git a/process/stepA_mal.txt b/process/stepA_mal.txt index 1ea14698f8..432bdef706 100644 --- a/process/stepA_mal.txt +++ b/process/stepA_mal.txt @@ -5,38 +5,46 @@ READ(str): return reader.read_str(str) 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) @@ -68,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?, From a60581e0a2411f2d850c66204c2ce94ca41ce9d8 Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Mon, 10 Apr 2023 18:41:02 +0200 Subject: [PATCH 31/32] test: check that a: is a valid symbol. This is required by the current mal implementation of DBG-EVAL. Fix resulting errors in powershell, prolog, swift5 --- impls/powershell/reader.psm1 | 2 +- impls/prolog/reader.pl | 1 + impls/swift5/Sources/core/Reader.swift | 2 +- impls/tests/step1_read_print.mal | 4 ++++ 4 files changed, 7 insertions(+), 2 deletions(-) diff --git a/impls/powershell/reader.psm1 b/impls/powershell/reader.psm1 index bd7f95c34b..06ac18bdd4 100644 --- a/impls/powershell/reader.psm1 +++ b/impls/powershell/reader.psm1 @@ -40,7 +40,7 @@ function read_atom([Reader] $rdr) { return $s } elseif ($token -match "^`".*") { throw "expected '`"', got EOF" - } elseif ($token -match ":.*") { + } elseif ($token -match "^:.*") { return "$([char]0x29e)$($token.substring(1))" } elseif ($token -eq "true") { return $true diff --git a/impls/prolog/reader.pl b/impls/prolog/reader.pl index 515f67c69d..63846c5a22 100644 --- a/impls/prolog/reader.pl +++ b/impls/prolog/reader.pl @@ -63,3 +63,4 @@ symcode(0'?). symcode(0'_). symcode(0'|). +symcode(0':). diff --git a/impls/swift5/Sources/core/Reader.swift b/impls/swift5/Sources/core/Reader.swift index 32f70c4093..287cfe83d0 100644 --- a/impls/swift5/Sources/core/Reader.swift +++ b/impls/swift5/Sources/core/Reader.swift @@ -84,7 +84,7 @@ private extension Parsers { // MARK: - Symbol static let symbolHead = char(excluding: "0123456789^`'\"#~@:%()[]{} \n\r\t,") - static let symbolRest = oneOf(symbolHead, char(from: "0123456789.")) + 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) diff --git a/impls/tests/step1_read_print.mal b/impls/tests/step1_read_print.mal index 403af6b49f..4afd4bfeba 100644 --- a/impls/tests/step1_read_print.mal +++ b/impls/tests/step1_read_print.mal @@ -233,6 +233,10 @@ false @a ;=>(deref a) +;; Colon character inside a symbol +a: +;=>a: + ;>>> soft=True ;>>> optional=True ;; From a0fe8e4355dfcf410a61c9308c72ed8397620e71 Mon Sep 17 00:00:00 2001 From: Joel Martin Date: Mon, 5 Aug 2024 10:06:45 -0500 Subject: [PATCH 32/32] c.2,make,perl6,ocaml,objpascal: update to ubuntu:24.04 c.2: By updating to 24.04 we get around an error with declarations after labels which is allowed in more recent compiler versions. make: With older make, the newer make code results in this error: ../make/readline.mk:13: *** unterminated call to function 'eval': missing ')'. Stop. Newer versions of make work fine. perl6: With older rakudo, this error occurs: user> (let* (DEBUG-EVAL false) (- 3 1)) Cannot resolve caller Numeric(types::MalFalse: ); none of these signatures match: ocaml: Fixes build error that happens with older versions of ocaml: ocamlopt -a types.ml reader.ml printer.ml env.ml core.ml -o mal_lib.cmxa File "env.ml", line 15, characters 8-21: Error: Unbound value Data.find_opt objpascal: With older compiler, the following error occurs: user> (apply str (seq "this is a test")) *** Error in `../objpascal/stepA_mal': corrupted size vs. prev_size: 0x000000000246c360 *** --- impls/c.2/Dockerfile | 8 +++----- impls/make/Dockerfile | 5 +++-- impls/objpascal/Dockerfile | 5 +++-- impls/ocaml/Dockerfile | 5 +++-- impls/perl6/Dockerfile | 19 ++++--------------- 5 files changed, 16 insertions(+), 26 deletions(-) diff --git a/impls/c.2/Dockerfile b/impls/c.2/Dockerfile index 79bab2ecad..2795e538d2 100644 --- a/impls/c.2/Dockerfile +++ b/impls/c.2/Dockerfile @@ -1,4 +1,4 @@ -FROM ubuntu:bionic +FROM ubuntu:24.04 MAINTAINER Duncan Watts ########################################################## @@ -9,10 +9,8 @@ MAINTAINER Duncan Watts 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 +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal diff --git a/impls/make/Dockerfile b/impls/make/Dockerfile index 457f951968..0890fa83de 100644 --- a/impls/make/Dockerfile +++ b/impls/make/Dockerfile @@ -1,4 +1,4 @@ -FROM ubuntu:xenial +FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## @@ -9,7 +9,8 @@ MAINTAINER Joel Martin RUN apt-get -y update # Required for running tests -RUN apt-get -y install make python +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 diff --git a/impls/objpascal/Dockerfile b/impls/objpascal/Dockerfile index 7173442f3d..743ec8bbea 100644 --- a/impls/objpascal/Dockerfile +++ b/impls/objpascal/Dockerfile @@ -1,4 +1,4 @@ -FROM ubuntu:xenial +FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## @@ -9,7 +9,8 @@ MAINTAINER Joel Martin RUN apt-get -y update # Required for running tests -RUN apt-get -y install make python +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 diff --git a/impls/ocaml/Dockerfile b/impls/ocaml/Dockerfile index 2d8a83da24..4f7392ab3b 100644 --- a/impls/ocaml/Dockerfile +++ b/impls/ocaml/Dockerfile @@ -1,4 +1,4 @@ -FROM ubuntu:xenial +FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## @@ -9,7 +9,8 @@ MAINTAINER Joel Martin RUN apt-get -y update # Required for running tests -RUN apt-get -y install make python +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 diff --git a/impls/perl6/Dockerfile b/impls/perl6/Dockerfile index ea081e882a..d77ab0de62 100644 --- a/impls/perl6/Dockerfile +++ b/impls/perl6/Dockerfile @@ -1,4 +1,4 @@ -FROM ubuntu:vivid +FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## @@ -9,10 +9,8 @@ MAINTAINER Joel Martin 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 apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal @@ -22,13 +20,4 @@ WORKDIR /mal ########################################################## # Perl6 build deps -RUN apt-get -y install libfile-copy-recursive-perl build-essential git - -RUN curl -O http://rakudo.org/downloads/star/rakudo-star-2016.07.tar.gz && \ - tar xzf rakudo-star-2016.07.tar.gz && \ - cd rakudo-star-2016.07 && \ - perl Configure.pl --prefix=/usr --gen-moar --gen-nqp --backends=moar && \ - make && \ - make install && \ - cd .. && \ - rm -rf rakudo-star-2016.07* +RUN apt-get -y install rakudo