From 32559fa40c19c6b3889fa67a4185966ceffda607 Mon Sep 17 00:00:00 2001 From: Tim Morgan Date: Thu, 3 Oct 2019 23:43:16 -0500 Subject: [PATCH] Moving to GitHub --- .github/workflows/build.yml | 19 - .gitignore | 17 - .gitmodules | 3 - Dockerfile | 25 - LICENSE | 21 - Makefile | 145 ---- README.md | 143 +--- core.c | 808 --------------------- core.h | 74 -- env.c | 57 -- env.h | 20 - examples/fib.mal | 19 - examples/filter.mal | 12 - examples/hello.mal | 1 - hashmap.c | 724 ------------------- hashmap.h | 281 -------- mal/LICENSE | 387 ---------- mal/Makefile | 504 ------------- mal/README.md | 1232 -------------------------------- mal/core.mal | 87 --- mal/mal/Dockerfile | 34 - mal/mal/Makefile | 7 - mal/mal/core.mal | 80 --- mal/mal/env.mal | 40 -- mal/mal/run | 5 - mal/mal/step0_repl.mal | 30 - mal/mal/step1_read_print.mal | 30 - mal/mal/step2_eval.mal | 64 -- mal/mal/step3_env.mal | 85 --- mal/mal/step4_if_fn_do.mal | 103 --- mal/mal/step6_file.mal | 108 --- mal/mal/step7_quote.mal | 136 ---- mal/mal/step8_macros.mal | 170 ----- mal/mal/step9_try.mal | 182 ----- mal/mal/stepA_mal.mal | 187 ----- mal/perf.mal | 27 - mal/run_argv_test.sh | 39 - mal/runtest.py | 360 ---------- mal/tests/docker-build.sh | 6 - mal/tests/docker-run.sh | 9 - mal/tests/docker/Dockerfile | 178 ----- mal/tests/inc.mal | 4 - mal/tests/incA.mal | 3 - mal/tests/incB.mal | 10 - mal/tests/incC.mal | 6 - mal/tests/perf1.mal | 11 - mal/tests/perf2.mal | 13 - mal/tests/perf3.mal | 18 - mal/tests/print_argv.mal | 2 - mal/tests/step0_repl.mal | 17 - mal/tests/step1_read_print.mal | 165 ----- mal/tests/step2_eval.mal | 44 -- mal/tests/step3_env.mal | 79 -- mal/tests/step4_if_fn_do.mal | 481 ------------- mal/tests/step5_tco.mal | 23 - mal/tests/step6_file.mal | 132 ---- mal/tests/step7_quote.mal | 183 ----- mal/tests/step8_macros.mal | 169 ----- mal/tests/step9_try.mal | 374 ---------- mal/tests/stepA_mal.mal | 276 ------- mal/tests/test.txt | 1 - malcc.c | 1066 --------------------------- printer.c | 186 ----- printer.h | 17 - reader.c | 374 ---------- reader.h | 37 - self_hosted_run | 3 - step0_repl.c | 36 - step1_read_print.c | 39 - step2_eval.c | 488 ------------- step3_env.c | 556 -------------- step4_if_fn_do.c | 733 ------------------- step5_tco.c | 754 ------------------- step6_file.c | 784 -------------------- step7_quote.c | 828 --------------------- step8_macros.c | 913 ----------------------- step9_try.c | 963 ------------------------- stepA_mal.c | 978 ------------------------- tests/regex.mal | 49 -- tests/utf-8.mal | 37 - tinycc | 1 - types.c | 631 ---------------- types.h | 216 ------ util.c | 89 --- util.h | 21 - 85 files changed, 2 insertions(+), 18267 deletions(-) delete mode 100644 .github/workflows/build.yml delete mode 100644 .gitignore delete mode 100644 .gitmodules delete mode 100644 Dockerfile delete mode 100644 LICENSE delete mode 100644 Makefile delete mode 100644 core.c delete mode 100644 core.h delete mode 100644 env.c delete mode 100644 env.h delete mode 100644 examples/fib.mal delete mode 100644 examples/filter.mal delete mode 100644 examples/hello.mal delete mode 100644 hashmap.c delete mode 100644 hashmap.h delete mode 100644 mal/LICENSE delete mode 100644 mal/Makefile delete mode 100644 mal/README.md delete mode 100644 mal/core.mal delete mode 100644 mal/mal/Dockerfile delete mode 100644 mal/mal/Makefile delete mode 100644 mal/mal/core.mal delete mode 100644 mal/mal/env.mal delete mode 100755 mal/mal/run delete mode 100644 mal/mal/step0_repl.mal delete mode 100644 mal/mal/step1_read_print.mal delete mode 100644 mal/mal/step2_eval.mal delete mode 100644 mal/mal/step3_env.mal delete mode 100644 mal/mal/step4_if_fn_do.mal delete mode 100644 mal/mal/step6_file.mal delete mode 100644 mal/mal/step7_quote.mal delete mode 100644 mal/mal/step8_macros.mal delete mode 100644 mal/mal/step9_try.mal delete mode 100644 mal/mal/stepA_mal.mal delete mode 100644 mal/perf.mal delete mode 100755 mal/run_argv_test.sh delete mode 100755 mal/runtest.py delete mode 100755 mal/tests/docker-build.sh delete mode 100755 mal/tests/docker-run.sh delete mode 100644 mal/tests/docker/Dockerfile delete mode 100644 mal/tests/inc.mal delete mode 100644 mal/tests/incA.mal delete mode 100644 mal/tests/incB.mal delete mode 100644 mal/tests/incC.mal delete mode 100644 mal/tests/perf1.mal delete mode 100644 mal/tests/perf2.mal delete mode 100644 mal/tests/perf3.mal delete mode 100644 mal/tests/print_argv.mal delete mode 100644 mal/tests/step0_repl.mal delete mode 100644 mal/tests/step1_read_print.mal delete mode 100644 mal/tests/step2_eval.mal delete mode 100644 mal/tests/step3_env.mal delete mode 100644 mal/tests/step4_if_fn_do.mal delete mode 100644 mal/tests/step5_tco.mal delete mode 100644 mal/tests/step6_file.mal delete mode 100644 mal/tests/step7_quote.mal delete mode 100644 mal/tests/step8_macros.mal delete mode 100644 mal/tests/step9_try.mal delete mode 100644 mal/tests/stepA_mal.mal delete mode 100644 mal/tests/test.txt delete mode 100644 malcc.c delete mode 100644 printer.c delete mode 100644 printer.h delete mode 100644 reader.c delete mode 100644 reader.h delete mode 100755 self_hosted_run delete mode 100644 step0_repl.c delete mode 100644 step1_read_print.c delete mode 100644 step2_eval.c delete mode 100644 step3_env.c delete mode 100644 step4_if_fn_do.c delete mode 100644 step5_tco.c delete mode 100644 step6_file.c delete mode 100644 step7_quote.c delete mode 100644 step8_macros.c delete mode 100644 step9_try.c delete mode 100644 stepA_mal.c delete mode 100644 tests/regex.mal delete mode 100644 tests/utf-8.mal delete mode 160000 tinycc delete mode 100644 types.c delete mode 100644 types.h delete mode 100644 util.c delete mode 100644 util.h diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml deleted file mode 100644 index 10d0bf3..0000000 --- a/.github/workflows/build.yml +++ /dev/null @@ -1,19 +0,0 @@ -name: Build - -on: push - -jobs: - build: - runs-on: ubuntu-18.04 - steps: - - uses: actions/checkout@v1 - - name: fetch submodules - run: git submodule update --init - - name: install dependencies - run: sudo apt update && sudo apt install -y -q build-essential libedit-dev libgc-dev libpcre3-dev python - - name: set environment - run: export LC_ALL="C.UTF-8" - - name: build - run: make all - - name: test - run: make test diff --git a/.gitignore b/.gitignore deleted file mode 100644 index 8ddb6ed..0000000 --- a/.gitignore +++ /dev/null @@ -1,17 +0,0 @@ -step0_repl -step1_read_print -step2_eval -step3_env -step4_if_fn_do -step5_tco -step6_file -step7_quote -step8_macros -step9_try -stepA_mal -malcc -mal-in-mal -mal-in-mal.c -mal-in-mal.dSYM -*.o -history.txt diff --git a/.gitmodules b/.gitmodules deleted file mode 100644 index d30a336..0000000 --- a/.gitmodules +++ /dev/null @@ -1,3 +0,0 @@ -[submodule "tinycc"] - path = tinycc - url = https://repo.or.cz/tinycc.git diff --git a/Dockerfile b/Dockerfile deleted file mode 100644 index e4f9d4a..0000000 --- a/Dockerfile +++ /dev/null @@ -1,25 +0,0 @@ -FROM ubuntu:18.04 - -RUN apt-get update -RUN apt-get install -y -q \ - build-essential \ - gdb \ - libedit-dev \ - libgc-dev \ - libpcre3-dev \ - python \ - valgrind \ - wget - -RUN cd /tmp && \ - wget http://eradman.com/entrproject/code/entr-4.1.tar.gz && \ - tar xzf entr-4.1.tar.gz && \ - cd eradman-entr-* && \ - ./configure && \ - make install - -ENV LC_ALL C.UTF-8 - -WORKDIR /malcc - -CMD ["bash"] diff --git a/LICENSE b/LICENSE deleted file mode 100644 index 470eaa5..0000000 --- a/LICENSE +++ /dev/null @@ -1,21 +0,0 @@ -MIT License - -Copyright (c) 2019 Tim Morgan - -Permission is hereby granted, free of charge, to any person obtaining a copy -of this software and associated documentation files (the "Software"), to deal -in the Software without restriction, including without limitation the rights -to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -copies of the Software, and to permit persons to whom the Software is -furnished to do so, subject to the following conditions: - -The above copyright notice and this permission notice shall be included in all -copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE -SOFTWARE. diff --git a/Makefile b/Makefile deleted file mode 100644 index 348e118..0000000 --- a/Makefile +++ /dev/null @@ -1,145 +0,0 @@ -OS:=$(shell uname) -CC=gcc -CFLAGS=-Itinycc -Wall -Wextra -Werror -g -LDLIBS=-ledit -ltermcap -lgc -lpcre -ldl - -ALL_STEPS=step0_repl step1_read_print step2_eval step3_env step4_if_fn_do step5_tco step6_file step7_quote step8_macros step9_try stepA_mal malcc - -.PHONY: all clean test test-current cloc docker-build - -all: $(ALL_STEPS) - -step0_repl: step0_repl.o -step1_read_print: step1_read_print.o hashmap.o printer.o reader.o types.o util.o -step2_eval: step2_eval.o hashmap.o printer.o reader.o types.o util.o tinycc/libtcc.a -step3_env: step3_env.o env.o hashmap.o printer.o reader.o types.o util.o tinycc/libtcc.a -step4_if_fn_do: step4_if_fn_do.o core.o env.o hashmap.o printer.o reader.o types.o util.o tinycc/libtcc.a -step5_tco: step5_tco.o core.o env.o hashmap.o printer.o reader.o types.o util.o tinycc/libtcc.a -step6_file: step6_file.o core.o env.o hashmap.o printer.o reader.o types.o util.o tinycc/libtcc.a -step7_quote: step7_quote.o core.o env.o hashmap.o printer.o reader.o types.o util.o tinycc/libtcc.a -step8_macros: step8_macros.o core.o env.o hashmap.o printer.o reader.o types.o util.o tinycc/libtcc.a -step9_try: step9_try.o core.o env.o hashmap.o printer.o reader.o types.o util.o tinycc/libtcc.a -stepA_mal: stepA_mal.o core.o env.o hashmap.o printer.o reader.o types.o util.o tinycc/libtcc.a -malcc: malcc.o core.o env.o hashmap.o printer.o reader.o types.o util.o tinycc/libtcc.a - -tinycc/libtcc.a: - cd tinycc && ./configure && make - -clean: - rm -f $(ALL_STEPS) *.o - cd tinycc && make clean - -mal-in-mal: all - cd mal/mal && ../../malcc --compile stepA_mal.mal ../../mal-in-mal - -test: test0 test1 test2 test3 test4 test5 test6 test7 test8 test9 testA test-malcc test-self-hosted test-supplemental test-mal-in-mal - -RUN_TEST_CMD=mal/runtest.py --rundir mal/tests --hard --deferrable --optional --start-timeout 1 --test-timeout 1 - -test0: all - $(RUN_TEST_CMD) step0_repl.mal ../../step0_repl - -test1: all - $(RUN_TEST_CMD) step1_read_print.mal ../../step1_read_print - -test2: all - $(RUN_TEST_CMD) step2_eval.mal ../../step2_eval - -test3: all - $(RUN_TEST_CMD) step3_env.mal ../../step3_env - -test4: all - $(RUN_TEST_CMD) step4_if_fn_do.mal ../../step4_if_fn_do - -test5: all - $(RUN_TEST_CMD) step5_tco.mal ../../step5_tco - -test6: all - $(RUN_TEST_CMD) step6_file.mal ../../step6_file - mal/run_argv_test.sh ./step6_file - -test7: all - $(RUN_TEST_CMD) step7_quote.mal ../../step7_quote - -test8: all - $(RUN_TEST_CMD) step8_macros.mal ../../step8_macros - -test9: all - $(RUN_TEST_CMD) step9_try.mal ../../step9_try - -testA: all - $(RUN_TEST_CMD) step2_eval.mal ../../stepA_mal - $(RUN_TEST_CMD) step3_env.mal ../../stepA_mal - $(RUN_TEST_CMD) step4_if_fn_do.mal ../../stepA_mal - $(RUN_TEST_CMD) step5_tco.mal ../../stepA_mal - $(RUN_TEST_CMD) step6_file.mal ../../stepA_mal - $(RUN_TEST_CMD) step7_quote.mal ../../stepA_mal - $(RUN_TEST_CMD) step8_macros.mal ../../stepA_mal - $(RUN_TEST_CMD) step9_try.mal ../../stepA_mal - $(RUN_TEST_CMD) stepA_mal.mal ../../stepA_mal - -test-malcc: all - $(RUN_TEST_CMD) step2_eval.mal ../../malcc - $(RUN_TEST_CMD) step3_env.mal ../../malcc - $(RUN_TEST_CMD) step4_if_fn_do.mal ../../malcc - $(RUN_TEST_CMD) step5_tco.mal ../../malcc - $(RUN_TEST_CMD) step6_file.mal ../../malcc - $(RUN_TEST_CMD) step7_quote.mal ../../malcc - $(RUN_TEST_CMD) step8_macros.mal ../../malcc - $(RUN_TEST_CMD) step9_try.mal ../../malcc - $(RUN_TEST_CMD) stepA_mal.mal ../../malcc - -test-self-hosted: all - $(RUN_TEST_CMD) --test-timeout 30 step2_eval.mal ../../self_hosted_run - $(RUN_TEST_CMD) --test-timeout 30 step3_env.mal ../../self_hosted_run - $(RUN_TEST_CMD) --test-timeout 30 step4_if_fn_do.mal ../../self_hosted_run - $(RUN_TEST_CMD) --test-timeout 30 step5_tco.mal ../../self_hosted_run - $(RUN_TEST_CMD) --test-timeout 30 step6_file.mal ../../self_hosted_run - $(RUN_TEST_CMD) --test-timeout 30 step7_quote.mal ../../self_hosted_run - $(RUN_TEST_CMD) --test-timeout 30 step8_macros.mal ../../self_hosted_run - $(RUN_TEST_CMD) --test-timeout 30 step9_try.mal ../../self_hosted_run - $(RUN_TEST_CMD) --test-timeout 30 stepA_mal.mal ../../self_hosted_run - -test-supplemental: all - $(RUN_TEST_CMD) --test-timeout 30 ../../tests/utf-8.mal ../../malcc - $(RUN_TEST_CMD) --test-timeout 30 ../../tests/regex.mal ../../malcc - -test-mal-in-mal: mal-in-mal - $(RUN_TEST_CMD) --test-timeout 30 step2_eval.mal ../../mal-in-mal - $(RUN_TEST_CMD) --test-timeout 30 step3_env.mal ../../mal-in-mal - $(RUN_TEST_CMD) --test-timeout 30 step4_if_fn_do.mal ../../mal-in-mal - $(RUN_TEST_CMD) --test-timeout 30 step5_tco.mal ../../mal-in-mal - $(RUN_TEST_CMD) --test-timeout 30 step6_file.mal ../../mal-in-mal - $(RUN_TEST_CMD) --test-timeout 30 step7_quote.mal ../../mal-in-mal - $(RUN_TEST_CMD) --test-timeout 30 step8_macros.mal ../../mal-in-mal - $(RUN_TEST_CMD) --test-timeout 30 step9_try.mal ../../mal-in-mal - $(RUN_TEST_CMD) --test-timeout 30 stepA_mal.mal ../../mal-in-mal - -perf: all - cd mal/tests && ../../malcc perf1.mal && ../../malcc perf2.mal && ../../malcc perf3.mal - -cloc: - cloc --exclude-dir='tinycc,mal' --not-match-f='hashmap.*|step.*' . - -docker-build: - docker build . -t malcc - -RUN_DOCKER_CMD=docker run --security-opt seccomp=unconfined -t -i --rm -v $(PWD):/malcc malcc - -docker-bash: docker-build - $(RUN_DOCKER_CMD) bash - -docker-test: docker-build - $(RUN_DOCKER_CMD) make test - -docker-test-supplemental: docker-build - $(RUN_DOCKER_CMD) make test-supplemental - -docker-watch: docker-build - $(RUN_DOCKER_CMD) bash -c "ls *.c *.h Makefile | entr -c -s 'make test'" - -update-mal-directory: - rm -rf /tmp/mal mal - mkdir mal - git clone https://github.com/kanaka/mal.git /tmp/mal - cp -r /tmp/mal/LICENSE /tmp/mal/Makefile /tmp/mal/README.md /tmp/mal/core.mal /tmp/mal/mal /tmp/mal/perf.mal /tmp/mal/run_argv_test.sh /tmp/mal/runtest.py /tmp/mal/tests mal/ diff --git a/README.md b/README.md index 26f28b2..509657b 100644 --- a/README.md +++ b/README.md @@ -1,142 +1,3 @@ -# malcc +# Moved -Mal (Make A Lisp) Compiler in C - -![](https://github.com/seven1m/malcc/workflows/Build/badge.svg) - -## Overview - -[Mal](https://github.com/kanaka/mal) is Clojure inspired Lisp interpreter -created by Joel Martin. - -**malcc** is an incremental compiler implementation for the Mal language. -It uses the [Tiny C Compiler](https://bellard.org/tcc/) as the compiler backend -and has full support for the Mal language, including macros, tail-call elimination, -and even run-time eval. - -malcc can also be used as an ahead-of-time compiler for Mal, producing a single -binary file for distribution (though using it this way sacrifices run-time eval -functionality since the compiler is not shipped in the resulting binary). - -## Building and Running - -malcc has been tested on Ubuntu 18.04 and macOS 10.14 Mojave. - -**Prerequisites on Mac:** - -```bash -sudo xcode-select --install -brew install pcre libgc -``` - -On Macos 10.14.4, there is a problem building TinyCC. This fixes that: - -```bash -cd /usr/local/lib -sudo ln -s ../../lib/libSystem.B.dylib libgcc_s.10.4.dylib -``` - -**Prerequisites on Ubuntu/Debian:** - -```bash -apt-get install libpcre3-dev libedit-dev libgc-dev -``` - -**Building malcc:** - -```bash -git submodule update --init -make all -``` - -**Running the REPL:** - -```bash -→ ./malcc -Mal [malcc] -user> (+ 1 2) -3 -user> ^D -``` - -**Running a mal file:** - -```bash -→ ./malcc examples/fib.mal -55 -12586269025 -``` - -**Ahead-of-Time compiling a mal file:** - -```bash -→ ./malcc --compile examples/fib.mal fib -→ ./fib -55 -12586269025 -``` - -## Speed - -malcc is fast! Running the microbenchmarks on my Macbook Pro yields an -order-of-magnitude speedup for long-running code vs the C++ implementation: - -**C++:** - -```bash -→ ../cpp/stepA_mal perf1.mal -"Elapsed time: 1 msecs" -→ ../cpp/stepA_mal perf2.mal -"Elapsed time: 2 msecs" -→ ../cpp/stepA_mal perf3.mal -iters over 10 seconds: 12415 -``` - -**malcc:** - -```bash -→ ../../stepA_mal perf1.mal -"Elapsed time: 0 msecs" -→ ../../stepA_mal perf2.mal -"Elapsed time: 3 msecs" -→ ../../stepA_mal perf3.mal -iters over 10 seconds: 226216 -``` - -Note: I'm not sure if this is a fair comparison, but I could not coax the C -interpreter implementation of mal to run the perf3 test, so I figured the C++ -implementation was the next-best thing. - -## Approach - -I followed the Mal guide to implement malcc, using the same steps that any -other implementation would follow. Naturally, since malcc is a compiler -rather than a straight interpreter, there are some differences from other -implementations: - -1. Additional functions not specified in the Mal guide are employed to - generate the C code that is passed to the TinyCC compiler. These functions - all start with `gen_` and should be fairly self-explanatory. -2. `load-file` is implemented as a special form rather than a simple function. - This is because macros defined in a file must be found and compiled during - code generation--they cannot be discovered at run-time. -3. I chose to publish malcc in a separate repository and have structured it to - suit my taste. A copy of the mal implementation of mal and the mal tests - were copied into the `mal` directory to provide test coverage. - -## Contributing - -Contributors are welcome! ❤️ - -File an issue on [GitHub](https://github.com/seven1m/malcc/issues) if you find -a bug or you want to propose a new feature! - -## License - -This project's sourcecode is copyrighted by Tim Morgan and licensed under the -MIT license, included in the `LICENSE` file in this repository. - -The subdirectory `mal` contains a copy of the Mal language repository and is -copyrighted by Joel Martin and released under the Mozilla Public License 2.0 -(MPL 2.0). The text of the MPL 2.0 license is included in the `mal/LICENSE` -file. +I have moved this back to GitHub here: https://github.com/seven1m/malcc diff --git a/core.c b/core.c deleted file mode 100644 index 2e64348..0000000 --- a/core.c +++ /dev/null @@ -1,808 +0,0 @@ -#include -#include -#include -#include -#include -#include -#include - -#include "env.h" -#include "core.h" -#include "reader.h" -#include "printer.h" -#include "types.h" -#include "util.h" - -struct hashmap* core_ns() { - struct hashmap *ns = GC_MALLOC(sizeof(struct hashmap)); - hashmap_init(ns, hashmap_hash_string, hashmap_compare_string, 100); - hashmap_set_key_alloc_funcs(ns, hashmap_alloc_key_string, NULL); - hashmap_put(ns, "+", core_add); - hashmap_put(ns, "-", core_sub); - hashmap_put(ns, "*", core_mul); - hashmap_put(ns, "/", core_div); - hashmap_put(ns, "count", core_count); - hashmap_put(ns, "prn", core_prn); - hashmap_put(ns, "list", core_list); - hashmap_put(ns, "list?", core_is_list); - hashmap_put(ns, "empty?", core_is_empty); - hashmap_put(ns, "=", core_is_equal); - hashmap_put(ns, ">", core_is_gt); - hashmap_put(ns, ">=", core_is_gte); - hashmap_put(ns, "<", core_is_lt); - hashmap_put(ns, "<=", core_is_lte); - hashmap_put(ns, "pr-str", core_pr_str); - hashmap_put(ns, "str", core_str); - hashmap_put(ns, "println", core_println); - hashmap_put(ns, "read-string", core_read_string); - hashmap_put(ns, "slurp", core_slurp); - hashmap_put(ns, "atom", core_atom); - hashmap_put(ns, "atom?", core_is_atom); - hashmap_put(ns, "deref", core_deref); - hashmap_put(ns, "reset!", core_reset); - hashmap_put(ns, "swap!", core_swap); - hashmap_put(ns, "cons", core_cons); - hashmap_put(ns, "concat", core_concat); - hashmap_put(ns, "nth", core_nth); - hashmap_put(ns, "first", core_first); - hashmap_put(ns, "rest", core_rest); - hashmap_put(ns, "throw", core_throw); - hashmap_put(ns, "apply", core_apply); - hashmap_put(ns, "map", core_map); - hashmap_put(ns, "nil?", core_is_nil); - hashmap_put(ns, "true?", core_is_true); - hashmap_put(ns, "false?", core_is_false); - hashmap_put(ns, "symbol?", core_is_symbol); - hashmap_put(ns, "keyword?", core_is_keyword); - hashmap_put(ns, "vector?", core_is_vector); - hashmap_put(ns, "map?", core_is_map); - hashmap_put(ns, "sequential?", core_is_sequential); - hashmap_put(ns, "symbol", core_symbol); - hashmap_put(ns, "keyword", core_keyword); - hashmap_put(ns, "vector", core_vector); - hashmap_put(ns, "hash-map", core_hash_map); - hashmap_put(ns, "assoc", core_assoc); - hashmap_put(ns, "dissoc", core_dissoc); - hashmap_put(ns, "get", core_get); - hashmap_put(ns, "contains?", core_contains); - hashmap_put(ns, "keys", core_keys); - hashmap_put(ns, "vals", core_vals); - hashmap_put(ns, "readline", core_readline); - hashmap_put(ns, "meta", core_meta); - hashmap_put(ns, "with-meta", core_with_meta); - hashmap_put(ns, "seq", core_seq); - hashmap_put(ns, "conj", core_conj); - hashmap_put(ns, "time-ms", core_time_ms); - hashmap_put(ns, "string?", core_is_string); - hashmap_put(ns, "number?", core_is_number); - hashmap_put(ns, "fn?", core_is_fn); - hashmap_put(ns, "macro?", core_is_macro); - hashmap_put(ns, "regex?", core_is_regex); - hashmap_put(ns, "regex-match", core_regex_match); - return ns; -} - -MalType* core_add(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - if (argc == 0) { - return mal_number(0); - } else { - long long result = args[0]->number; - for (size_t i=1; inumber; - } - return mal_number(result); - } -} - -MalType* core_sub(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - assert(argc > 0); - long long result = args[0]->number; - for (size_t i=1; inumber; - } - return mal_number(result); -} - -MalType* core_mul(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - if (argc == 0) { - return mal_number(1); - } else { - long long result = args[0]->number; - for (size_t i=1; inumber; - } - return mal_number(result); - } -} - -MalType* core_div(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - assert(argc > 0); - long long result = args[0]->number; - for (size_t i=1; inumber; - } - return mal_number(result); -} - -MalType* core_count(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc == 1, "Expected 1 argument to count"); - MalType *arg = args[0]; - switch (arg->type) { - case MAL_EMPTY_TYPE: - case MAL_NIL_TYPE: - return mal_number(0); - case MAL_CONS_TYPE: - return mal_number(mal_list_len(arg)); - case MAL_VECTOR_TYPE: - return mal_number(mal_vector_len(arg)); - default: - printf("Object type to count not supported\n"); - return mal_nil(); - } -} - -MalType* core_prn(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - MalType *out = mal_string(""); - for (size_t i=0; istr); - return mal_nil(); -} - -MalType* core_list(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - MalType *vec = mal_vector(); - for (size_t i=0; ivec_len == 0) return mal_true(); - return mal_false(); -} - -MalType* core_is_equal(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc == 2, "Expected 2 argument to ="); - return is_equal(args[0], args[1]) ? mal_true() : mal_false(); -} - -MalType* core_is_gt(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc == 2, "Expected 2 argument to >"); - MalType *arg1 = args[0]; - MalType *arg2 = args[1]; - mal_assert(is_number(arg1) && is_number(arg2), "Both arguments to > must be numbers"); - return arg1->number > arg2->number ? mal_true() : mal_false(); -} - -MalType* core_is_gte(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc == 2, "Expected 2 argument to >="); - MalType *arg1 = args[0]; - MalType *arg2 = args[1]; - mal_assert(is_number(arg1) && is_number(arg2), "Both arguments to >= must be numbers"); - return arg1->number == arg2->number || arg1->number > arg2->number ? mal_true() : mal_false(); -} - -MalType* core_is_lt(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc == 2, "Expected 2 argument to <"); - MalType *arg1 = args[0]; - MalType *arg2 = args[1]; - mal_assert(is_number(arg1) && is_number(arg2), "Both arguments to < must be numbers"); - return arg1->number < arg2->number ? mal_true() : mal_false(); -} - -MalType* core_is_lte(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc == 2, "Expected 2 argument to <="); - MalType *arg1 = args[0]; - MalType *arg2 = args[1]; - mal_assert(is_number(arg1) && is_number(arg2), "Both arguments to <= must be numbers"); - return arg1->number == arg2->number || arg1->number < arg2->number ? mal_true() : mal_false(); -} - -MalType* core_pr_str(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - MalType *out = mal_string(""); - for (size_t i=0; istr); - return mal_nil(); -} - -MalType* core_read_string(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc == 1, "Expected 1 argument to read-string"); - MalType *code = args[0]; - mal_assert(is_string(code), "read-string expects a string argument"); - return read_str(code->str); -} - -MalType* core_slurp(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc == 1, "Expected 1 argument to slurp"); - MalType *filename = args[0]; - mal_assert(is_string(filename), "slurp expects a string argument"); - return read_file(filename->str); -} - -MalType* core_atom(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc == 1, "Expected 1 argument to atom"); - return mal_atom(args[0]); -} - -MalType* core_is_atom(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc == 1, "Expected 1 argument to atom?"); - return is_atom(args[0]) ? mal_true() : mal_false(); -} - -MalType* core_deref(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc == 1, "Expected 1 argument to deref"); - MalType *val = args[0]; - mal_assert(is_atom(val), "deref expects an atom argument"); - return val->atom_val; -} - -MalType* core_reset(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc == 2, "Expected 2 arguments to reset!"); - MalType *atom = args[0]; - mal_assert(is_atom(atom), "reset! expects an atom argument"); - MalType *inner_val = args[1]; - atom->atom_val = inner_val; - return inner_val; -} - -MalType* core_swap(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc >= 2, "Expected at least 2 arguments to swap!"); - MalType *atom = args[0]; - mal_assert(is_atom(atom), "swap! expects an atom argument"); - MalType *lambda = args[1]; - mal_assert(is_lambda(lambda), "swap! expects a lambda argument"); - MalType **swap_args = GC_MALLOC(argc * sizeof(MalType*)); - swap_args[0] = atom->atom_val; - for(size_t i=2; iatom_val = trampoline(mal_continuation(lambda->fn, lambda->env, argc - 1, swap_args)); - return atom->atom_val; -} - -MalType* core_cons(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc == 2, "Expected 2 arguments to cons"); - MalType *new_item = args[0]; - if (is_vector(args[1])) { - MalType *vec = args[1]; - MalType *new_vec = mal_vector(); - mal_vector_push(new_vec, new_item); - for (size_t i=0; ivec[i]); - } - return mal_vector_to_list(new_vec); - } else { - return mal_cons(new_item, args[1]); - } -} - -MalType* core_concat(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - MalType *final = mal_vector(), *item; - struct list_or_vector_iter *iter; - for (size_t i=0; inumber; - if (is_vector(list_or_vector)) { - size_t size = mal_vector_len(list_or_vector); - if (index >= size) { - return mal_error(mal_string("nth index out of range")); - } - return mal_vector_ref(list_or_vector, index); - } else { - size_t size = mal_list_len(list_or_vector); - if (index >= size) { - return mal_error(mal_string("nth index out of range")); - } - return mal_list_ref(list_or_vector, index); - } -} - -MalType* core_first(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc == 1, "Expected 1 argument to first"); - MalType *list = args[0]; - mal_assert(is_list_like(list) || is_nil(list), "first expects a list or a vector argument"); - if (is_empty(list) || is_nil(list)) { - return mal_nil(); - } else if (is_cons(list)) { - return list->car; - } else if (list->vec_len > 0) { - return list->vec[0]; - } else { - return mal_nil(); - } -} - -MalType* core_rest(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc == 1, "Expected 1 argument to rest"); - MalType *list = args[0]; - mal_assert(is_list_like(list) || is_nil(list), "rest expects a list or a vector argument"); - if (is_empty(list) || is_nil(list)) { - return mal_empty(); - } else if (is_cons(list)) { - return list->cdr; - } else if (list->vec_len > 0) { - return mal_cdr2(list); - } else { - return mal_empty(); - } -} - -MalType* core_throw(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc == 1, "Expected 1 argument to throw"); - MalType *val = args[0]; - return mal_error(val); -} - -MalType* core_apply(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc >= 2, "Expected at least 2 arguments to apply"); - MalType *lambda = args[0]; - mal_assert(is_lambda(lambda), "Expected first argument of apply to be a lambda"); - MalType *args_vec = mal_vector(); - struct list_or_vector_iter *iter; - MalType *arg; - for (size_t i=1; ifn, lambda->env, args_vec->vec_len, args_vec->vec)); -} - -MalType* core_map(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc == 2, "Expected 2 arguments to map"); - MalType *lambda = args[0]; - mal_assert(is_lambda(lambda), "Expected first argument of map to be a lambda"); - MalType *list = args[1]; - mal_assert(is_list_like(list), "Expected second argument of map to be a list or vector"); - MalType *result_vec = mal_vector(); - struct list_or_vector_iter *iter; - MalType *val; - for (iter = list_or_vector_iter(list); iter; iter = list_or_vector_iter_next(iter)) { - val = list_or_vector_iter_get_obj(iter); - val = trampoline(mal_continuation_1(lambda->fn, lambda->env, val)); - bubble_if_error(val); - mal_vector_push(result_vec, val); - } - return mal_vector_to_list(result_vec); -} - -MalType* core_is_nil(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc == 1, "Expected 1 argument to nil?"); - MalType *val = args[0]; - return is_nil(val) ? mal_true() : mal_false(); -} - -MalType* core_is_true(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc == 1, "Expected 1 argument to true?"); - MalType *val = args[0]; - return is_true(val) ? mal_true() : mal_false(); -} - -MalType* core_is_false(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc == 1, "Expected 1 argument to false?"); - MalType *val = args[0]; - return is_false(val) ? mal_true() : mal_false(); -} - -MalType* core_is_symbol(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc == 1, "Expected 1 argument to symbol?"); - MalType *val = args[0]; - return is_symbol(val) ? mal_true() : mal_false(); -} - -MalType* core_is_keyword(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc == 1, "Expected 1 argument to keyword?"); - MalType *val = args[0]; - return is_keyword(val) ? mal_true() : mal_false(); -} - -MalType* core_is_vector(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc == 1, "Expected 1 argument to vector?"); - MalType *val = args[0]; - return is_vector(val) ? mal_true() : mal_false(); -} - -MalType* core_is_map(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc == 1, "Expected 1 argument to map?"); - MalType *val = args[0]; - return is_hashmap(val) ? mal_true() : mal_false(); -} - -MalType* core_is_sequential(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc == 1, "Expected 1 argument to sequential?"); - MalType *val = args[0]; - return is_list_like(val) ? mal_true() : mal_false(); -} - -MalType* core_symbol(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc == 1, "Expected 1 argument to symbol function"); - MalType *val = args[0]; - mal_assert(is_string(val), "symbol function expects a string argument"); - return mal_symbol(val->str); -} - -MalType* core_keyword(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc == 1, "Expected 1 argument to keyword function"); - MalType *val = args[0]; - if (is_keyword(val)) { - return val; - } - mal_assert(is_string(val), "keyword function expects a string argument"); - return mal_keyword(val->str); -} - -MalType* core_vector(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - MalType *vec = mal_vector(); - for (size_t i=0; ihashmap); iter; iter = hashmap_iter_next(&map->hashmap, iter)) { - key = read_str((char*)hashmap_iter_get_key(iter)); - val = (MalType*)hashmap_iter_get_data(iter); - mal_hashmap_put(new_map, key, val); - } - for (size_t i=1; i= 2, "Expected at least 2 arguments to disassoc"); - MalType *map = args[0]; - mal_assert(is_hashmap(map), "Expected first argument to disassoc to be a hash-map"); - MalType *new_map = mal_hashmap(); - struct hashmap_iter *iter; - MalType *key, *val; - int skip; - for (iter = hashmap_iter(&map->hashmap); iter; iter = hashmap_iter_next(&map->hashmap, iter)) { - skip = 0; - key = read_str((char*)hashmap_iter_get_key(iter)); - for (size_t i=1; ihashmap); iter; iter = hashmap_iter_next(&map->hashmap, iter)) { - val = (MalType*)hashmap_iter_get_data(iter); - mal_vector_push(vals_vec, val); - } - return mal_vector_to_list(vals_vec); -} - -MalType* core_readline(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc == 1, "Expected 1 argument to readline"); - MalType *prompt = args[0]; - mal_assert(is_string(prompt), "Expected first argument to readline to be a string"); - char buffer[1000]; - printf("%s", prompt->str); - if (fgets(buffer, 1000, stdin) == NULL) { - return mal_nil(); - } else { - size_t len = strlen(buffer); - if (buffer[len-1] == '\n') { - buffer[len-1] = 0; // strip the newline - } - return mal_string(buffer); - } -} - -MalType* core_meta(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc == 1, "Expected 1 argument to meta"); - MalType *val = args[0]; - if (val->meta) { - return val->meta; - } else { - return mal_nil(); - } -} - -MalType* core_with_meta(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc == 2, "Expected 2 arguments to with-meta"); - MalType *val = args[0]; - MalType *new_val = mal_alloc(); - memcpy(new_val, val, sizeof(MalType)); - new_val->meta = args[1]; - return new_val; -} - -MalType* core_seq(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc == 1, "Expected 1 arguments to seq"); - MalType *val = args[0]; - switch (val->type) { - case MAL_CONS_TYPE: - return val; - case MAL_STRING_TYPE: - if (val->str_len == 0) { - return mal_nil(); - } else { - return mal_string_to_list(val); - } - case MAL_VECTOR_TYPE: - if (val->vec_len == 0) { - return mal_nil(); - } else { - return mal_vector_to_list(val); - } - default: - return mal_nil(); - } -} - -MalType* core_conj(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc >= 2, "Expected at least 2 arguments to conj"); - MalType *collection = args[0]; - mal_assert( - is_empty(collection) || is_cons(collection) || is_vector(collection), - "Expected first argument to conj to be a list or vector" - ); - if (is_empty(collection) || is_cons(collection)) { - MalType *node = collection; - for (size_t i=1; ivec_len; i++) { - mal_vector_push(vec, collection->vec[i]); - } - for (size_t i=1; iis_macro ? mal_true() : mal_false(); -} - -MalType* core_is_macro(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc == 1, "Expected 1 argument to macro?"); - MalType *val = args[0]; - return is_macro(val) ? mal_true() : mal_false(); -} - -MalType* core_is_regex(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc == 1, "Expected 1 argument to regex?"); - MalType *val = args[0]; - return is_regex(val) ? mal_true() : mal_false(); -} - -MalType* core_regex_match(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - mal_assert(argc == 2, "Expected 2 argument to regex-match"); - MalType *regex = args[0]; - mal_assert(is_regex(regex), "Expected first argument to regex-match to be a regex"); - MalType *str = args[1]; - mal_assert(is_string(str), "Expected second argument to regex-match to be a string"); - - const char *pcreErrorStr; - int pcreErrorOffset; - pcre *reCompiled = pcre_compile(regex->regex, 0, &pcreErrorStr, &pcreErrorOffset, NULL); - if(reCompiled == NULL) { - return mal_error(mal_string("Could not compile regex.")); - } - - pcre_extra *pcreExtra = pcre_study(reCompiled, PCRE_EXTENDED, &pcreErrorStr); - if(pcreErrorStr != NULL) { - return mal_error(mal_string("Could not study regex.")); - } - - int subStrVec[30]; - int pcreExecRet = pcre_exec(reCompiled, pcreExtra, str->str, str->str_len, 0, 0, subStrVec, 30); - - pcre_free(reCompiled); - - return pcreExecRet < 0 ? mal_nil() : mal_number(subStrVec[0]); -} - -void add_core_ns_to_env(MalEnv *env) { - struct hashmap *ns = core_ns(); - struct hashmap_iter *core_iter; - char *name; - MalType* (*fn)(MalEnv*, size_t, MalType**); - for (core_iter = hashmap_iter(ns); core_iter; core_iter = hashmap_iter_next(ns, core_iter)) { - name = (char*)hashmap_iter_get_key(core_iter); - fn = hashmap_iter_get_data(core_iter); - env_set(env, name, mal_builtin_function(fn, name, env)); - } -} diff --git a/core.h b/core.h deleted file mode 100644 index c8bf8eb..0000000 --- a/core.h +++ /dev/null @@ -1,74 +0,0 @@ -#ifndef __MAL_CORE__ -#define __MAL_CORE__ - -#include - -#include "env.h" -#include "types.h" - -struct hashmap* core_ns(); -MalType* core_add(MalEnv *env, size_t argc, MalType **args); -MalType* core_sub(MalEnv *env, size_t argc, MalType **args); -MalType* core_mul(MalEnv *env, size_t argc, MalType **args); -MalType* core_div(MalEnv *env, size_t argc, MalType **args); -MalType* core_count(MalEnv *env, size_t argc, MalType **args); -MalType* core_prn(MalEnv *env, size_t argc, MalType **args); -MalType* core_list(MalEnv *env, size_t argc, MalType **args); -MalType* core_is_list(MalEnv *env, size_t argc, MalType **args); -MalType* core_is_empty(MalEnv *env, size_t argc, MalType **args); -MalType* core_is_equal(MalEnv *env, size_t argc, MalType **args); -MalType* core_is_gt(MalEnv *env, size_t argc, MalType **args); -MalType* core_is_gte(MalEnv *env, size_t argc, MalType **args); -MalType* core_is_lt(MalEnv *env, size_t argc, MalType **args); -MalType* core_is_lte(MalEnv *env, size_t argc, MalType **args); -MalType* core_pr_str(MalEnv *env, size_t argc, MalType **args); -MalType* core_str(MalEnv *env, size_t argc, MalType **args); -MalType* core_println(MalEnv *env, size_t argc, MalType **args); -MalType* core_read_string(MalEnv *env, size_t argc, MalType **args); -MalType* core_slurp(MalEnv *env, size_t argc, MalType **args); -MalType* core_atom(MalEnv *env, size_t argc, MalType **args); -MalType* core_is_atom(MalEnv *env, size_t argc, MalType **args); -MalType* core_deref(MalEnv *env, size_t argc, MalType **args); -MalType* core_reset(MalEnv *env, size_t argc, MalType **args); -MalType* core_swap(MalEnv *env, size_t argc, MalType **args); -MalType* core_cons(MalEnv *env, size_t argc, MalType **args); -MalType* core_concat(MalEnv *env, size_t argc, MalType **args); -MalType* core_nth(MalEnv *env, size_t argc, MalType **args); -MalType* core_first(MalEnv *env, size_t argc, MalType **args); -MalType* core_rest(MalEnv *env, size_t argc, MalType **args); -MalType* core_throw(MalEnv *env, size_t argc, MalType **args); -MalType* core_apply(MalEnv *env, size_t argc, MalType **args); -MalType* core_map(MalEnv *env, size_t argc, MalType **args); -MalType* core_is_nil(MalEnv *env, size_t argc, MalType **args); -MalType* core_is_true(MalEnv *env, size_t argc, MalType **args); -MalType* core_is_false(MalEnv *env, size_t argc, MalType **args); -MalType* core_is_symbol(MalEnv *env, size_t argc, MalType **args); -MalType* core_is_keyword(MalEnv *env, size_t argc, MalType **args); -MalType* core_is_vector(MalEnv *env, size_t argc, MalType **args); -MalType* core_is_map(MalEnv *env, size_t argc, MalType **args); -MalType* core_is_sequential(MalEnv *env, size_t argc, MalType **args); -MalType* core_symbol(MalEnv *env, size_t argc, MalType **args); -MalType* core_keyword(MalEnv *env, size_t argc, MalType **args); -MalType* core_vector(MalEnv *env, size_t argc, MalType **args); -MalType* core_hash_map(MalEnv *env, size_t argc, MalType **args); -MalType* core_assoc(MalEnv *env, size_t argc, MalType **args); -MalType* core_dissoc(MalEnv *env, size_t argc, MalType **args); -MalType* core_get(MalEnv *env, size_t argc, MalType **args); -MalType* core_contains(MalEnv *env, size_t argc, MalType **args); -MalType* core_keys(MalEnv *env, size_t argc, MalType **args); -MalType* core_vals(MalEnv *env, size_t argc, MalType **args); -MalType* core_readline(MalEnv *env, size_t argc, MalType **args); -MalType* core_meta(MalEnv *env, size_t argc, MalType **args); -MalType* core_with_meta(MalEnv *env, size_t argc, MalType **args); -MalType* core_seq(MalEnv *env, size_t argc, MalType **args); -MalType* core_conj(MalEnv *env, size_t argc, MalType **args); -MalType* core_time_ms(MalEnv *env, size_t argc, MalType **args); -MalType* core_is_string(MalEnv *env, size_t argc, MalType **args); -MalType* core_is_number(MalEnv *env, size_t argc, MalType **args); -MalType* core_is_fn(MalEnv *env, size_t argc, MalType **args); -MalType* core_is_macro(MalEnv *env, size_t argc, MalType **args); -MalType* core_is_regex(MalEnv *env, size_t argc, MalType **args); -MalType* core_regex_match(MalEnv *env, size_t argc, MalType **args); -void add_core_ns_to_env(MalEnv *env); - -#endif diff --git a/env.c b/env.c deleted file mode 100644 index 2a9bcfc..0000000 --- a/env.c +++ /dev/null @@ -1,57 +0,0 @@ -#include -#include -#include - -#include "env.h" -#include "hashmap.h" -#include "printer.h" -#include "types.h" -#include "util.h" - -MalEnv* build_top_env() { - MalEnv *top_env = build_env(NULL); - top_env->num = 0; - return top_env; -} - -MalEnv* build_env(MalEnv *outer) { - MalEnv *env = GC_MALLOC(sizeof(MalEnv)); - env->outer = outer; - hashmap_init(&env->data, hashmap_hash_string, hashmap_compare_string, 100); - hashmap_set_key_alloc_funcs(&env->data, hashmap_alloc_key_string, NULL); - return env; -} - -MalType* env_get(MalEnv *env, char *key) { - env = env_find(env, key); - if (!env) { - return mal_error(mal_sprintf("'%s' not found", key)); - } - MalType *val = hashmap_get(&env->data, key); - if (val) { - return val; - } else { - return mal_error(mal_sprintf("'%s' not found", key)); - } -} - -MalType* env_set(MalEnv *env, char *key, MalType *val) { - if (is_blank_line(val)) return val; - hashmap_remove(&env->data, key); - hashmap_put(&env->data, key, val); - return val; -} - -void env_delete(MalEnv *env, char *key) { - hashmap_remove(&env->data, key); -} - -MalEnv* env_find(MalEnv *env, char *key) { - if (hashmap_get(&env->data, key)) { - return env; - } else if (env->outer) { - return env_find(env->outer, key); - } else { - return NULL; - } -} diff --git a/env.h b/env.h deleted file mode 100644 index 3e07569..0000000 --- a/env.h +++ /dev/null @@ -1,20 +0,0 @@ -#ifndef __MAL_ENV__ -#define __MAL_ENV__ - -#include -#include - -#include "hashmap.h" -#include "types.h" - -#define env_get_bubble_error(env, key) ({ MalType *v = env_get((env), (key)); if (is_error(v)) { return v; }; v; }) - -MalEnv* build_top_env(); -MalEnv* build_env(MalEnv *outer); -MalType* env_get(MalEnv *env, char *key); -MalType* env_set(MalEnv *env, char *key, MalType *val); -void env_delete(MalEnv *env, char *key); -MalEnv* env_find(MalEnv *env, char *key); -void inspect_env(MalEnv *env); - -#endif diff --git a/examples/fib.mal b/examples/fib.mal deleted file mode 100644 index 954d4b0..0000000 --- a/examples/fib.mal +++ /dev/null @@ -1,19 +0,0 @@ -(def! fib - (fn* (n) - (if (< n 2) - n - (+ - (fib (- n 1)) - (fib (- n 2)))))) - -(def! fib2 - (fn* (n) - (let* (f (fn* (n1 n2 c) - (if (= c n) - n2 - (f n2 (+ n1 n2) (+ c 1))))) - (f 0 1 1)))) - -(println (fib 10)) -(println (fib2 50)) - diff --git a/examples/filter.mal b/examples/filter.mal deleted file mode 100644 index 061fef1..0000000 --- a/examples/filter.mal +++ /dev/null @@ -1,12 +0,0 @@ -(def! filter - (fn* (l f) - (let* [filter* (fn* (l1 l2 f) - (if (empty? l1) - (seq l2) - (if (apply f (first l1)) - (filter* (rest l1) (concat l2 (list (first l1))) f) - (filter* (rest l1) l2 f))))] - (filter* l [] f)))) - -(prn (filter '(1 2 3 4 5 6 7 8 0 9) (fn* (i) (< i 5)))) -(prn (filter [0 1 2 3 4 5 6 7 8 9] (fn* (i) (< i 5)))) diff --git a/examples/hello.mal b/examples/hello.mal deleted file mode 100644 index 9c26276..0000000 --- a/examples/hello.mal +++ /dev/null @@ -1 +0,0 @@ -(println "hello world") diff --git a/hashmap.c b/hashmap.c deleted file mode 100644 index a634ee0..0000000 --- a/hashmap.c +++ /dev/null @@ -1,724 +0,0 @@ -/* - * Copyright (c) 2016-2018 David Leeds - * - * Hashmap is free software; you can redistribute it and/or modify - * it under the terms of the MIT license. See LICENSE for details. - * - * Updated 2018-02-16 by Tim Morgan to use GC_MALLOC and friends. - */ - -#include -#include -#include -#include -#include -#include -#include - -#include "hashmap.h" - -#ifndef HASHMAP_NOASSERT -#include -#define HASHMAP_ASSERT(expr) assert(expr) -#else -#define HASHMAP_ASSERT(expr) -#endif - -/* Table sizes must be powers of 2 */ -#define HASHMAP_SIZE_MIN (1 << 5) /* 32 */ -#define HASHMAP_SIZE_DEFAULT (1 << 8) /* 256 */ -#define HASHMAP_SIZE_MOD(map, val) ((val) & ((map)->table_size - 1)) - -/* Limit for probing is 1/2 of table_size */ -#define HASHMAP_PROBE_LEN(map) ((map)->table_size >> 1) -/* Return the next linear probe index */ -#define HASHMAP_PROBE_NEXT(map, index) HASHMAP_SIZE_MOD(map, (index) + 1) - -/* Check if index b is less than or equal to index a */ -#define HASHMAP_INDEX_LE(map, a, b) \ - ((a) == (b) || (((b) - (a)) & ((map)->table_size >> 1)) != 0) - - -struct hashmap_entry { - void *key; - void *data; -#ifdef HASHMAP_METRICS - size_t num_collisions; -#endif -}; - - -/* - * Enforce a maximum 0.75 load factor. - */ -static inline size_t hashmap_table_min_size_calc(size_t num_entries) -{ - return num_entries + (num_entries / 3); -} - -/* - * Calculate the optimal table size, given the specified max number - * of elements. - */ -static size_t hashmap_table_size_calc(size_t num_entries) -{ - size_t table_size; - size_t min_size; - - table_size = hashmap_table_min_size_calc(num_entries); - - /* Table size is always a power of 2 */ - min_size = HASHMAP_SIZE_MIN; - while (min_size < table_size) { - min_size <<= 1; - } - return min_size; -} - -/* - * Get a valid hash table index from a key. - */ -static inline size_t hashmap_calc_index(const struct hashmap *map, - const void *key) -{ - return HASHMAP_SIZE_MOD(map, map->hash(key)); -} - -/* - * Return the next populated entry, starting with the specified one. - * Returns NULL if there are no more valid entries. - */ -static struct hashmap_entry *hashmap_entry_get_populated( - const struct hashmap *map, struct hashmap_entry *entry) -{ - for (; entry < &map->table[map->table_size]; ++entry) { - if (entry->key) { - return entry; - } - } - return NULL; -} - -/* - * Find the hashmap entry with the specified key, or an empty slot. - * Returns NULL if the entire table has been searched without finding a match. - */ -static struct hashmap_entry *hashmap_entry_find(const struct hashmap *map, - const void *key, bool find_empty) -{ - size_t i; - size_t index; - size_t probe_len = HASHMAP_PROBE_LEN(map); - struct hashmap_entry *entry; - - index = hashmap_calc_index(map, key); - - /* Linear probing */ - for (i = 0; i < probe_len; ++i) { - entry = &map->table[index]; - if (!entry->key) { - if (find_empty) { -#ifdef HASHMAP_METRICS - entry->num_collisions = i; -#endif - return entry; - } - return NULL; - } - if (map->key_compare(key, entry->key) == 0) { - return entry; - } - index = HASHMAP_PROBE_NEXT(map, index); - } - return NULL; -} - -/* - * Removes the specified entry and processes the proceeding entries to reduce - * the load factor and keep the chain continuous. This is a required - * step for hash maps using linear probing. - */ -static void hashmap_entry_remove(struct hashmap *map, - struct hashmap_entry *removed_entry) -{ - size_t i; -#ifdef HASHMAP_METRICS - size_t removed_i = 0; -#endif - size_t index; - size_t entry_index; - size_t removed_index = (removed_entry - map->table); - struct hashmap_entry *entry; - - /* Free the key */ - if (map->key_free) { - map->key_free(removed_entry->key); - } - --map->num_entries; - - /* Fill the free slot in the chain */ - index = HASHMAP_PROBE_NEXT(map, removed_index); - for (i = 1; i < map->table_size; ++i) { - entry = &map->table[index]; - if (!entry->key) { - /* Reached end of chain */ - break; - } - entry_index = hashmap_calc_index(map, entry->key); - /* Shift in entries with an index <= to the removed slot */ - if (HASHMAP_INDEX_LE(map, removed_index, entry_index)) { -#ifdef HASHMAP_METRICS - entry->num_collisions -= (i - removed_i); - removed_i = i; -#endif - memcpy(removed_entry, entry, sizeof(*removed_entry)); - removed_index = index; - removed_entry = entry; - } - index = HASHMAP_PROBE_NEXT(map, index); - } - /* Clear the last removed entry */ - memset(removed_entry, 0, sizeof(*removed_entry)); -} - -/* - * Reallocates the hash table to the new size and rehashes all entries. - * new_size MUST be a power of 2. - * Returns 0 on success and -errno on allocation or hash function failure. - */ -static int hashmap_rehash(struct hashmap *map, size_t new_size) -{ - size_t old_size; - struct hashmap_entry *old_table; - struct hashmap_entry *new_table; - struct hashmap_entry *entry; - struct hashmap_entry *new_entry; - - HASHMAP_ASSERT(new_size >= HASHMAP_SIZE_MIN); - HASHMAP_ASSERT((new_size & (new_size - 1)) == 0); - - new_table = (struct hashmap_entry *)GC_MALLOC(new_size * sizeof(struct hashmap_entry)); - if (!new_table) { - return -ENOMEM; - } - /* Backup old elements in case of rehash failure */ - old_size = map->table_size; - old_table = map->table; - map->table_size = new_size; - map->table = new_table; - /* Rehash */ - for (entry = old_table; entry < &old_table[old_size]; ++entry) { - if (!entry->data) { - /* Only copy entries with data */ - continue; - } - new_entry = hashmap_entry_find(map, entry->key, true); - if (!new_entry) { - /* - * The load factor is too high with the new table - * size, or a poor hash function was used. - */ - goto revert; - } - /* Shallow copy (intentionally omits num_collisions) */ - new_entry->key = entry->key; - new_entry->data = entry->data; - } - GC_FREE(old_table); - return 0; -revert: - map->table_size = old_size; - map->table = old_table; - GC_FREE(new_table); - return -EINVAL; -} - -/* - * Iterate through all entries and free all keys. - */ -static void hashmap_free_keys(struct hashmap *map) -{ - struct hashmap_iter *iter; - - if (!map->key_free) { - return; - } - for (iter = hashmap_iter(map); iter; - iter = hashmap_iter_next(map, iter)) { - map->key_free((void *)hashmap_iter_get_key(iter)); - } -} - -/* - * Initialize an empty hashmap. - * - * hash_func should return an even distribution of numbers between 0 - * and SIZE_MAX varying on the key provided. If set to NULL, the default - * case-sensitive string hash function is used: hashmap_hash_string - * - * key_compare_func should return 0 if the keys match, and non-zero otherwise. - * If set to NULL, the default case-sensitive string comparator function is - * used: hashmap_compare_string - * - * initial_size is optional, and may be set to the max number of entries - * expected to be put in the hash table. This is used as a hint to - * pre-allocate the hash table to the minimum size needed to avoid - * gratuitous rehashes. If initial_size is 0, a default size will be used. - * - * Returns 0 on success and -errno on failure. - */ -int hashmap_init(struct hashmap *map, size_t (*hash_func)(const void *), - int (*key_compare_func)(const void *, const void *), - size_t initial_size) -{ - HASHMAP_ASSERT(map != NULL); - - if (!initial_size) { - initial_size = HASHMAP_SIZE_DEFAULT; - } else { - /* Convert init size to valid table size */ - initial_size = hashmap_table_size_calc(initial_size); - } - map->table_size_init = initial_size; - map->table_size = initial_size; - map->num_entries = 0; - map->table = (struct hashmap_entry *)GC_MALLOC(initial_size * sizeof(struct hashmap_entry)); - if (!map->table) { - return -ENOMEM; - } - map->hash = hash_func ? - hash_func : hashmap_hash_string; - map->key_compare = key_compare_func ? - key_compare_func : hashmap_compare_string; - map->key_alloc = NULL; - map->key_free = NULL; - return 0; -} - -/* - * Free the hashmap and all associated memory. - */ -void hashmap_destroy(struct hashmap *map) -{ - if (!map) { - return; - } - hashmap_free_keys(map); - GC_FREE(map->table); - memset(map, 0, sizeof(*map)); -} - -/* - * Enable internal memory management of hash keys. - */ -void hashmap_set_key_alloc_funcs(struct hashmap *map, - void *(*key_alloc_func)(const void *), - void (*key_free_func)(void *)) -{ - HASHMAP_ASSERT(map != NULL); - - map->key_alloc = key_alloc_func; - map->key_free = key_free_func; -} - -/* - * Add an entry to the hashmap. If an entry with a matching key already - * exists and has a data pointer associated with it, the existing data - * pointer is returned, instead of assigning the new value. Compare - * the return value with the data passed in to determine if a new entry was - * created. Returns NULL if memory allocation failed. - */ -void *hashmap_put(struct hashmap *map, const void *key, void *data) -{ - struct hashmap_entry *entry; - - HASHMAP_ASSERT(map != NULL); - HASHMAP_ASSERT(key != NULL); - - /* Rehash with 2x capacity if load factor is approaching 0.75 */ - if (map->table_size <= hashmap_table_min_size_calc(map->num_entries)) { - hashmap_rehash(map, map->table_size << 1); - } - entry = hashmap_entry_find(map, key, true); - if (!entry) { - /* - * Cannot find an empty slot. Either out of memory, or using - * a poor hash function. Attempt to rehash once to reduce - * chain length. - */ - if (hashmap_rehash(map, map->table_size << 1) < 0) { - return NULL; - } - entry = hashmap_entry_find(map, key, true); - if (!entry) { - return NULL; - } - } - if (!entry->key) { - /* Allocate copy of key to simplify memory management */ - if (map->key_alloc) { - entry->key = map->key_alloc(key); - if (!entry->key) { - return NULL; - } - } else { - entry->key = (void *)key; - } - ++map->num_entries; - } else if (entry->data) { - /* Do not overwrite existing data */ - return entry->data; - } - entry->data = data; - return data; -} - -/* - * Return the data pointer, or NULL if no entry exists. - */ -void *hashmap_get(const struct hashmap *map, const void *key) -{ - struct hashmap_entry *entry; - - HASHMAP_ASSERT(map != NULL); - HASHMAP_ASSERT(key != NULL); - - entry = hashmap_entry_find(map, key, false); - if (!entry) { - return NULL; - } - return entry->data; -} - -/* - * Remove an entry with the specified key from the map. - * Returns the data pointer, or NULL, if no entry was found. - */ -void *hashmap_remove(struct hashmap *map, const void *key) -{ - struct hashmap_entry *entry; - void *data; - - HASHMAP_ASSERT(map != NULL); - HASHMAP_ASSERT(key != NULL); - - entry = hashmap_entry_find(map, key, false); - if (!entry) { - return NULL; - } - data = entry->data; - /* Clear the entry and make the chain contiguous */ - hashmap_entry_remove(map, entry); - return data; -} - -/* - * Remove all entries. - */ -void hashmap_clear(struct hashmap *map) -{ - HASHMAP_ASSERT(map != NULL); - - hashmap_free_keys(map); - map->num_entries = 0; - memset(map->table, 0, sizeof(struct hashmap_entry) * map->table_size); -} - -/* - * Remove all entries and reset the hash table to its initial size. - */ -void hashmap_reset(struct hashmap *map) -{ - struct hashmap_entry *new_table; - - HASHMAP_ASSERT(map != NULL); - - hashmap_clear(map); - if (map->table_size == map->table_size_init) { - return; - } - new_table = (struct hashmap_entry *)GC_REALLOC(map->table, - sizeof(struct hashmap_entry) * map->table_size_init); - if (!new_table) { - return; - } - map->table = new_table; - map->table_size = map->table_size_init; -} - -/* - * Return the number of entries in the hash map. - */ -size_t hashmap_size(const struct hashmap *map) -{ - HASHMAP_ASSERT(map != NULL); - - return map->num_entries; -} - -/* - * Get a new hashmap iterator. The iterator is an opaque - * pointer that may be used with hashmap_iter_*() functions. - * Hashmap iterators are INVALID after a put or remove operation is performed. - * hashmap_iter_remove() allows safe removal during iteration. - */ -struct hashmap_iter *hashmap_iter(const struct hashmap *map) -{ - HASHMAP_ASSERT(map != NULL); - - if (!map->num_entries) { - return NULL; - } - return (struct hashmap_iter *)hashmap_entry_get_populated(map, - map->table); -} - -/* - * Return an iterator to the next hashmap entry. Returns NULL if there are - * no more entries. - */ -struct hashmap_iter *hashmap_iter_next(const struct hashmap *map, - const struct hashmap_iter *iter) -{ - struct hashmap_entry *entry = (struct hashmap_entry *)iter; - - HASHMAP_ASSERT(map != NULL); - - if (!iter) { - return NULL; - } - return (struct hashmap_iter *)hashmap_entry_get_populated(map, - entry + 1); -} - -/* - * Remove the hashmap entry pointed to by this iterator and return an - * iterator to the next entry. Returns NULL if there are no more entries. - */ -struct hashmap_iter *hashmap_iter_remove(struct hashmap *map, - const struct hashmap_iter *iter) -{ - struct hashmap_entry *entry = (struct hashmap_entry *)iter; - - HASHMAP_ASSERT(map != NULL); - - if (!iter) { - return NULL; - } - if (!entry->key) { - /* Iterator is invalid, so just return the next valid entry */ - return hashmap_iter_next(map, iter); - } - hashmap_entry_remove(map, entry); - return (struct hashmap_iter *)hashmap_entry_get_populated(map, entry); -} - -/* - * Return the key of the entry pointed to by the iterator. - */ -const void *hashmap_iter_get_key(const struct hashmap_iter *iter) -{ - if (!iter) { - return NULL; - } - return (const void *)((struct hashmap_entry *)iter)->key; -} - -/* - * Return the data of the entry pointed to by the iterator. - */ -void *hashmap_iter_get_data(const struct hashmap_iter *iter) -{ - if (!iter) { - return NULL; - } - return ((struct hashmap_entry *)iter)->data; -} - -/* - * Set the data pointer of the entry pointed to by the iterator. - */ -void hashmap_iter_set_data(const struct hashmap_iter *iter, void *data) -{ - if (!iter) { - return; - } - ((struct hashmap_entry *)iter)->data = data; -} - -/* - * Invoke func for each entry in the hashmap. Unlike the hashmap_iter_*() - * interface, this function supports calls to hashmap_remove() during iteration. - * However, it is an error to put or remove an entry other than the current one, - * and doing so will immediately halt iteration and return an error. - * Iteration is stopped if func returns non-zero. Returns func's return - * value if it is < 0, otherwise, 0. - */ -int hashmap_foreach(const struct hashmap *map, - int (*func)(const void *, void *, void *), void *arg) -{ - struct hashmap_entry *entry; - size_t num_entries; - const void *key; - int rc; - - HASHMAP_ASSERT(map != NULL); - HASHMAP_ASSERT(func != NULL); - - entry = map->table; - for (entry = map->table; entry < &map->table[map->table_size]; - ++entry) { - if (!entry->key) { - continue; - } - num_entries = map->num_entries; - key = entry->key; - rc = func(entry->key, entry->data, arg); - if (rc < 0) { - return rc; - } - if (rc > 0) { - return 0; - } - /* Run this entry again if func() deleted it */ - if (entry->key != key) { - --entry; - } else if (num_entries != map->num_entries) { - /* Stop immediately if func put/removed another entry */ - return -1; - } - } - return 0; -} - -/* - * Default hash function for string keys. - * This is an implementation of the well-documented Jenkins one-at-a-time - * hash function. - */ -size_t hashmap_hash_string(const void *key) -{ - const char *key_str = (const char *)key; - size_t hash = 0; - - for (; *key_str; ++key_str) { - hash += *key_str; - hash += (hash << 10); - hash ^= (hash >> 6); - } - hash += (hash << 3); - hash ^= (hash >> 11); - hash += (hash << 15); - return hash; -} - -/* - * Default key comparator function for string keys. - */ -int hashmap_compare_string(const void *a, const void *b) -{ - return strcmp((const char *)a, (const char *)b); -} - -/* - * Default key allocation function for string keys. Use free() for the - * key_free_func. - */ -void *hashmap_alloc_key_string(const void *key) -{ - return (void *)strdup((const char *)key); -} - -/* - * Case insensitive hash function for string keys. - */ -size_t hashmap_hash_string_i(const void *key) -{ - const char *key_str = (const char *)key; - size_t hash = 0; - - for (; *key_str; ++key_str) { - hash += tolower(*key_str); - hash += (hash << 10); - hash ^= (hash >> 6); - } - hash += (hash << 3); - hash ^= (hash >> 11); - hash += (hash << 15); - return hash; -} - -/* - * Case insensitive key comparator function for string keys. - */ -int hashmap_compare_string_i(const void *a, const void *b) -{ - return strcasecmp((const char *)a, (const char *)b); -} - - -#ifdef HASHMAP_METRICS -/* - * Return the load factor. - */ -double hashmap_load_factor(const struct hashmap *map) -{ - HASHMAP_ASSERT(map != NULL); - - if (!map->table_size) { - return 0; - } - return (double)map->num_entries / map->table_size; -} - -/* - * Return the average number of collisions per entry. - */ -double hashmap_collisions_mean(const struct hashmap *map) -{ - struct hashmap_entry *entry; - size_t total_collisions = 0; - - HASHMAP_ASSERT(map != NULL); - - if (!map->num_entries) { - return 0; - } - for (entry = map->table; entry < &map->table[map->table_size]; - ++entry) { - if (!entry->key) { - continue; - } - total_collisions += entry->num_collisions; - } - return (double)total_collisions / map->num_entries; -} - -/* - * Return the variance between entry collisions. The higher the variance, - * the more likely the hash function is poor and is resulting in clustering. - */ -double hashmap_collisions_variance(const struct hashmap *map) -{ - struct hashmap_entry *entry; - double mean_collisions; - double variance; - double total_variance = 0; - - HASHMAP_ASSERT(map != NULL); - - if (!map->num_entries) { - return 0; - } - mean_collisions = hashmap_collisions_mean(map); - for (entry = map->table; entry < &map->table[map->table_size]; - ++entry) { - if (!entry->key) { - continue; - } - variance = (double)entry->num_collisions - mean_collisions; - total_variance += variance * variance; - } - return total_variance / map->num_entries; -} -#endif diff --git a/hashmap.h b/hashmap.h deleted file mode 100644 index c344c4c..0000000 --- a/hashmap.h +++ /dev/null @@ -1,281 +0,0 @@ -/* - * Copyright (c) 2016-2018 David Leeds - * - * Hashmap is free software; you can redistribute it and/or modify - * it under the terms of the MIT license. See LICENSE for details. - */ - -#ifndef __HASHMAP_H__ -#define __HASHMAP_H__ - -#include - -/* - * Define HASHMAP_METRICS to compile in performance analysis - * functions for use in assessing hash function performance. - */ -/* #define HASHMAP_METRICS */ - -/* - * Define HASHMAP_NOASSERT to compile out all assertions used internally. - */ -/* #define HASHMAP_NOASSERT */ - -/* - * Macros to declare type-specific versions of hashmap_*() functions to - * allow compile-time type checking and avoid the need for type casting. - */ -#define HASHMAP_FUNCS_DECLARE(name, key_type, data_type) \ - data_type *name##_hashmap_put(struct hashmap *map, \ - const key_type *key, data_type *data); \ - data_type *name##_hashmap_get(const struct hashmap *map, \ - const key_type *key); \ - data_type *name##_hashmap_remove(struct hashmap *map, \ - const key_type *key); \ - const key_type *name##_hashmap_iter_get_key( \ - const struct hashmap_iter *iter); \ - data_type *name##_hashmap_iter_get_data( \ - const struct hashmap_iter *iter); \ - void name##_hashmap_iter_set_data(const struct hashmap_iter *iter, \ - data_type *data); \ - int name##_hashmap_foreach(const struct hashmap *map, \ - int (*func)(const key_type *, data_type *, void *), void *arg); - -#define HASHMAP_FUNCS_CREATE(name, key_type, data_type) \ - data_type *name##_hashmap_put(struct hashmap *map, \ - const key_type *key, data_type *data) \ - { \ - return (data_type *)hashmap_put(map, (const void *)key, \ - (void *)data); \ - } \ - data_type *name##_hashmap_get(const struct hashmap *map, \ - const key_type *key) \ - { \ - return (data_type *)hashmap_get(map, (const void *)key); \ - } \ - data_type *name##_hashmap_remove(struct hashmap *map, \ - const key_type *key) \ - { \ - return (data_type *)hashmap_remove(map, (const void *)key); \ - } \ - const key_type *name##_hashmap_iter_get_key( \ - const struct hashmap_iter *iter) \ - { \ - return (const key_type *)hashmap_iter_get_key(iter); \ - } \ - data_type *name##_hashmap_iter_get_data( \ - const struct hashmap_iter *iter) \ - { \ - return (data_type *)hashmap_iter_get_data(iter); \ - } \ - void name##_hashmap_iter_set_data(const struct hashmap_iter *iter, \ - data_type *data) \ - { \ - hashmap_iter_set_data(iter, (void *)data); \ - } \ - struct __##name##_hashmap_foreach_state { \ - int (*func)(const key_type *, data_type *, void *); \ - void *arg; \ - }; \ - static inline int __##name##_hashmap_foreach_callback( \ - const void *key, void *data, void *arg) \ - { \ - struct __##name##_hashmap_foreach_state *s = \ - (struct __##name##_hashmap_foreach_state *)arg; \ - return s->func((const key_type *)key, \ - (data_type *)data, s->arg); \ - } \ - int name##_hashmap_foreach(const struct hashmap *map, \ - int (*func)(const key_type *, data_type *, void *), \ - void *arg) \ - { \ - struct __##name##_hashmap_foreach_state s = { func, arg }; \ - return hashmap_foreach(map, \ - __##name##_hashmap_foreach_callback, &s); \ - } - - -struct hashmap_iter; -struct hashmap_entry; - -/* - * The hashmap state structure. - */ -struct hashmap { - size_t table_size_init; - size_t table_size; - size_t num_entries; - struct hashmap_entry *table; - size_t (*hash)(const void *); - int (*key_compare)(const void *, const void *); - void *(*key_alloc)(const void *); - void (*key_free)(void *); -}; - -/* - * Initialize an empty hashmap. - * - * hash_func should return an even distribution of numbers between 0 - * and SIZE_MAX varying on the key provided. If set to NULL, the default - * case-sensitive string hash function is used: hashmap_hash_string - * - * key_compare_func should return 0 if the keys match, and non-zero otherwise. - * If set to NULL, the default case-sensitive string comparator function is - * used: hashmap_compare_string - * - * initial_size is optional, and may be set to the max number of entries - * expected to be put in the hash table. This is used as a hint to - * pre-allocate the hash table to the minimum size needed to avoid - * gratuitous rehashes. If initial_size is 0, a default size will be used. - * - * Returns 0 on success and -errno on failure. - */ -int hashmap_init(struct hashmap *map, size_t (*hash_func)(const void *), - int (*key_compare_func)(const void *, const void *), - size_t initial_size); - -/* - * Free the hashmap and all associated memory. - */ -void hashmap_destroy(struct hashmap *map); - -/* - * Enable internal memory allocation and management of hash keys. - */ -void hashmap_set_key_alloc_funcs(struct hashmap *map, - void *(*key_alloc_func)(const void *), - void (*key_free_func)(void *)); - -/* - * Add an entry to the hashmap. If an entry with a matching key already - * exists and has a data pointer associated with it, the existing data - * pointer is returned, instead of assigning the new value. Compare - * the return value with the data passed in to determine if a new entry was - * created. Returns NULL if memory allocation failed. - */ -void *hashmap_put(struct hashmap *map, const void *key, void *data); - -/* - * Return the data pointer, or NULL if no entry exists. - */ -void *hashmap_get(const struct hashmap *map, const void *key); - -/* - * Remove an entry with the specified key from the map. - * Returns the data pointer, or NULL, if no entry was found. - */ -void *hashmap_remove(struct hashmap *map, const void *key); - -/* - * Remove all entries. - */ -void hashmap_clear(struct hashmap *map); - -/* - * Remove all entries and reset the hash table to its initial size. - */ -void hashmap_reset(struct hashmap *map); - -/* - * Return the number of entries in the hash map. - */ -size_t hashmap_size(const struct hashmap *map); - -/* - * Get a new hashmap iterator. The iterator is an opaque - * pointer that may be used with hashmap_iter_*() functions. - * Hashmap iterators are INVALID after a put or remove operation is performed. - * hashmap_iter_remove() allows safe removal during iteration. - */ -struct hashmap_iter *hashmap_iter(const struct hashmap *map); - -/* - * Return an iterator to the next hashmap entry. Returns NULL if there are - * no more entries. - */ -struct hashmap_iter *hashmap_iter_next(const struct hashmap *map, - const struct hashmap_iter *iter); - -/* - * Remove the hashmap entry pointed to by this iterator and returns an - * iterator to the next entry. Returns NULL if there are no more entries. - */ -struct hashmap_iter *hashmap_iter_remove(struct hashmap *map, - const struct hashmap_iter *iter); - -/* - * Return the key of the entry pointed to by the iterator. - */ -const void *hashmap_iter_get_key(const struct hashmap_iter *iter); - -/* - * Return the data of the entry pointed to by the iterator. - */ -void *hashmap_iter_get_data(const struct hashmap_iter *iter); - -/* - * Set the data pointer of the entry pointed to by the iterator. - */ -void hashmap_iter_set_data(const struct hashmap_iter *iter, void *data); - -/* - * Invoke func for each entry in the hashmap. Unlike the hashmap_iter_*() - * interface, this function supports calls to hashmap_remove() during iteration. - * However, it is an error to put or remove an entry other than the current one, - * and doing so will immediately halt iteration and return an error. - * Iteration is stopped if func returns non-zero. Returns func's return - * value if it is < 0, otherwise, 0. - */ -int hashmap_foreach(const struct hashmap *map, - int (*func)(const void *, void *, void *), void *arg); - -/* - * Default hash function for string keys. - * This is an implementation of the well-documented Jenkins one-at-a-time - * hash function. - */ -size_t hashmap_hash_string(const void *key); - -/* - * Default key comparator function for string keys. - */ -int hashmap_compare_string(const void *a, const void *b); - -/* - * Default key allocation function for string keys. Use free() for the - * key_free_func. - */ -void *hashmap_alloc_key_string(const void *key); - -/* - * Case insensitive hash function for string keys. - */ -size_t hashmap_hash_string_i(const void *key); - -/* - * Case insensitive key comparator function for string keys. - */ -int hashmap_compare_string_i(const void *a, const void *b); - - -#ifdef HASHMAP_METRICS -/* - * Return the load factor. - */ -double hashmap_load_factor(const struct hashmap *map); - -/* - * Return the average number of collisions per entry. - */ -double hashmap_collisions_mean(const struct hashmap *map); - -/* - * Return the variance between entry collisions. The higher the variance, - * the more likely the hash function is poor and is resulting in clustering. - */ -double hashmap_collisions_variance(const struct hashmap *map); -#endif - - -#endif /* __HASHMAP_H__ */ - diff --git a/mal/LICENSE b/mal/LICENSE deleted file mode 100644 index 88b2867..0000000 --- a/mal/LICENSE +++ /dev/null @@ -1,387 +0,0 @@ -Copyright (C) 2015 Joel Martin - -Mal (make-a-lisp) is licensed under the MPL 2.0 (Mozilla Public -License 2.0). The text of the MPL 2.0 license is included below and -can be found at https://www.mozilla.org/MPL/2.0/ - -Many of the implementations run or compile using a line editing -library. In some cases, the implementations provide an option in the -code to switch between the GNU GPL licensed GNU readline library and -the BSD licensed editline (libedit) library. - - -Mozilla Public License Version 2.0 -================================== - -1. Definitions --------------- - -1.1. "Contributor" - means each individual or legal entity that creates, contributes to - the creation of, or owns Covered Software. - -1.2. "Contributor Version" - means the combination of the Contributions of others (if any) used - by a Contributor and that particular Contributor's Contribution. - -1.3. "Contribution" - means Covered Software of a particular Contributor. - -1.4. "Covered Software" - means Source Code Form to which the initial Contributor has attached - the notice in Exhibit A, the Executable Form of such Source Code - Form, and Modifications of such Source Code Form, in each case - including portions thereof. - -1.5. "Incompatible With Secondary Licenses" - means - - (a) that the initial Contributor has attached the notice described - in Exhibit B to the Covered Software; or - - (b) that the Covered Software was made available under the terms of - version 1.1 or earlier of the License, but not also under the - terms of a Secondary License. - -1.6. "Executable Form" - means any form of the work other than Source Code Form. - -1.7. "Larger Work" - means a work that combines Covered Software with other material, in - a separate file or files, that is not Covered Software. - -1.8. "License" - means this document. - -1.9. "Licensable" - means having the right to grant, to the maximum extent possible, - whether at the time of the initial grant or subsequently, any and - all of the rights conveyed by this License. - -1.10. "Modifications" - means any of the following: - - (a) any file in Source Code Form that results from an addition to, - deletion from, or modification of the contents of Covered - Software; or - - (b) any new file in Source Code Form that contains any Covered - Software. - -1.11. "Patent Claims" of a Contributor - means any patent claim(s), including without limitation, method, - process, and apparatus claims, in any patent Licensable by such - Contributor that would be infringed, but for the grant of the - License, by the making, using, selling, offering for sale, having - made, import, or transfer of either its Contributions or its - Contributor Version. - -1.12. "Secondary License" - means either the GNU General Public License, Version 2.0, the GNU - Lesser General Public License, Version 2.1, the GNU Affero General - Public License, Version 3.0, or any later versions of those - licenses. - -1.13. "Source Code Form" - means the form of the work preferred for making modifications. - -1.14. "You" (or "Your") - means an individual or a legal entity exercising rights under this - License. For legal entities, "You" includes any entity that - controls, is controlled by, or is under common control with You. For - purposes of this definition, "control" means (a) the power, direct - or indirect, to cause the direction or management of such entity, - whether by contract or otherwise, or (b) ownership of more than - fifty percent (50%) of the outstanding shares or beneficial - ownership of such entity. - -2. License Grants and Conditions --------------------------------- - -2.1. Grants - -Each Contributor hereby grants You a world-wide, royalty-free, -non-exclusive license: - -(a) under intellectual property rights (other than patent or trademark) - Licensable by such Contributor to use, reproduce, make available, - modify, display, perform, distribute, and otherwise exploit its - Contributions, either on an unmodified basis, with Modifications, or - as part of a Larger Work; and - -(b) under Patent Claims of such Contributor to make, use, sell, offer - for sale, have made, import, and otherwise transfer either its - Contributions or its Contributor Version. - -2.2. Effective Date - -The licenses granted in Section 2.1 with respect to any Contribution -become effective for each Contribution on the date the Contributor first -distributes such Contribution. - -2.3. Limitations on Grant Scope - -The licenses granted in this Section 2 are the only rights granted under -this License. No additional rights or licenses will be implied from the -distribution or licensing of Covered Software under this License. -Notwithstanding Section 2.1(b) above, no patent license is granted by a -Contributor: - -(a) for any code that a Contributor has removed from Covered Software; - or - -(b) for infringements caused by: (i) Your and any other third party's - modifications of Covered Software, or (ii) the combination of its - Contributions with other software (except as part of its Contributor - Version); or - -(c) under Patent Claims infringed by Covered Software in the absence of - its Contributions. - -This License does not grant any rights in the trademarks, service marks, -or logos of any Contributor (except as may be necessary to comply with -the notice requirements in Section 3.4). - -2.4. Subsequent Licenses - -No Contributor makes additional grants as a result of Your choice to -distribute the Covered Software under a subsequent version of this -License (see Section 10.2) or under the terms of a Secondary License (if -permitted under the terms of Section 3.3). - -2.5. Representation - -Each Contributor represents that the Contributor believes its -Contributions are its original creation(s) or it has sufficient rights -to grant the rights to its Contributions conveyed by this License. - -2.6. Fair Use - -This License is not intended to limit any rights You have under -applicable copyright doctrines of fair use, fair dealing, or other -equivalents. - -2.7. Conditions - -Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted -in Section 2.1. - -3. Responsibilities -------------------- - -3.1. Distribution of Source Form - -All distribution of Covered Software in Source Code Form, including any -Modifications that You create or to which You contribute, must be under -the terms of this License. You must inform recipients that the Source -Code Form of the Covered Software is governed by the terms of this -License, and how they can obtain a copy of this License. You may not -attempt to alter or restrict the recipients' rights in the Source Code -Form. - -3.2. Distribution of Executable Form - -If You distribute Covered Software in Executable Form then: - -(a) such Covered Software must also be made available in Source Code - Form, as described in Section 3.1, and You must inform recipients of - the Executable Form how they can obtain a copy of such Source Code - Form by reasonable means in a timely manner, at a charge no more - than the cost of distribution to the recipient; and - -(b) You may distribute such Executable Form under the terms of this - License, or sublicense it under different terms, provided that the - license for the Executable Form does not attempt to limit or alter - the recipients' rights in the Source Code Form under this License. - -3.3. Distribution of a Larger Work - -You may create and distribute a Larger Work under terms of Your choice, -provided that You also comply with the requirements of this License for -the Covered Software. If the Larger Work is a combination of Covered -Software with a work governed by one or more Secondary Licenses, and the -Covered Software is not Incompatible With Secondary Licenses, this -License permits You to additionally distribute such Covered Software -under the terms of such Secondary License(s), so that the recipient of -the Larger Work may, at their option, further distribute the Covered -Software under the terms of either this License or such Secondary -License(s). - -3.4. Notices - -You may not remove or alter the substance of any license notices -(including copyright notices, patent notices, disclaimers of warranty, -or limitations of liability) contained within the Source Code Form of -the Covered Software, except that You may alter any license notices to -the extent required to remedy known factual inaccuracies. - -3.5. Application of Additional Terms - -You may choose to offer, and to charge a fee for, warranty, support, -indemnity or liability obligations to one or more recipients of Covered -Software. However, You may do so only on Your own behalf, and not on -behalf of any Contributor. You must make it absolutely clear that any -such warranty, support, indemnity, or liability obligation is offered by -You alone, and You hereby agree to indemnify every Contributor for any -liability incurred by such Contributor as a result of warranty, support, -indemnity or liability terms You offer. You may include additional -disclaimers of warranty and limitations of liability specific to any -jurisdiction. - -4. Inability to Comply Due to Statute or Regulation ---------------------------------------------------- - -If it is impossible for You to comply with any of the terms of this -License with respect to some or all of the Covered Software due to -statute, judicial order, or regulation then You must: (a) comply with -the terms of this License to the maximum extent possible; and (b) -describe the limitations and the code they affect. Such description must -be placed in a text file included with all distributions of the Covered -Software under this License. Except to the extent prohibited by statute -or regulation, such description must be sufficiently detailed for a -recipient of ordinary skill to be able to understand it. - -5. Termination --------------- - -5.1. The rights granted under this License will terminate automatically -if You fail to comply with any of its terms. However, if You become -compliant, then the rights granted under this License from a particular -Contributor are reinstated (a) provisionally, unless and until such -Contributor explicitly and finally terminates Your grants, and (b) on an -ongoing basis, if such Contributor fails to notify You of the -non-compliance by some reasonable means prior to 60 days after You have -come back into compliance. Moreover, Your grants from a particular -Contributor are reinstated on an ongoing basis if such Contributor -notifies You of the non-compliance by some reasonable means, this is the -first time You have received notice of non-compliance with this License -from such Contributor, and You become compliant prior to 30 days after -Your receipt of the notice. - -5.2. If You initiate litigation against any entity by asserting a patent -infringement claim (excluding declaratory judgment actions, -counter-claims, and cross-claims) alleging that a Contributor Version -directly or indirectly infringes any patent, then the rights granted to -You by any and all Contributors for the Covered Software under Section -2.1 of this License shall terminate. - -5.3. In the event of termination under Sections 5.1 or 5.2 above, all -end user license agreements (excluding distributors and resellers) which -have been validly granted by You or Your distributors under this License -prior to termination shall survive termination. - -************************************************************************ -* * -* 6. Disclaimer of Warranty * -* ------------------------- * -* * -* Covered Software is provided under this License on an "as is" * -* basis, without warranty of any kind, either expressed, implied, or * -* statutory, including, without limitation, warranties that the * -* Covered Software is free of defects, merchantable, fit for a * -* particular purpose or non-infringing. The entire risk as to the * -* quality and performance of the Covered Software is with You. * -* Should any Covered Software prove defective in any respect, You * -* (not any Contributor) assume the cost of any necessary servicing, * -* repair, or correction. This disclaimer of warranty constitutes an * -* essential part of this License. No use of any Covered Software is * -* authorized under this License except under this disclaimer. * -* * -************************************************************************ - -************************************************************************ -* * -* 7. Limitation of Liability * -* -------------------------- * -* * -* Under no circumstances and under no legal theory, whether tort * -* (including negligence), contract, or otherwise, shall any * -* Contributor, or anyone who distributes Covered Software as * -* permitted above, be liable to You for any direct, indirect, * -* special, incidental, or consequential damages of any character * -* including, without limitation, damages for lost profits, loss of * -* goodwill, work stoppage, computer failure or malfunction, or any * -* and all other commercial damages or losses, even if such party * -* shall have been informed of the possibility of such damages. This * -* limitation of liability shall not apply to liability for death or * -* personal injury resulting from such party's negligence to the * -* extent applicable law prohibits such limitation. Some * -* jurisdictions do not allow the exclusion or limitation of * -* incidental or consequential damages, so this exclusion and * -* limitation may not apply to You. * -* * -************************************************************************ - -8. Litigation -------------- - -Any litigation relating to this License may be brought only in the -courts of a jurisdiction where the defendant maintains its principal -place of business and such litigation shall be governed by laws of that -jurisdiction, without reference to its conflict-of-law provisions. -Nothing in this Section shall prevent a party's ability to bring -cross-claims or counter-claims. - -9. Miscellaneous ----------------- - -This License represents the complete agreement concerning the subject -matter hereof. If any provision of this License is held to be -unenforceable, such provision shall be reformed only to the extent -necessary to make it enforceable. Any law or regulation which provides -that the language of a contract shall be construed against the drafter -shall not be used to construe this License against a Contributor. - -10. Versions of the License ---------------------------- - -10.1. New Versions - -Mozilla Foundation is the license steward. Except as provided in Section -10.3, no one other than the license steward has the right to modify or -publish new versions of this License. Each version will be given a -distinguishing version number. - -10.2. Effect of New Versions - -You may distribute the Covered Software under the terms of the version -of the License under which You originally received the Covered Software, -or under the terms of any subsequent version published by the license -steward. - -10.3. Modified Versions - -If you create software not governed by this License, and you want to -create a new license for such software, you may create and use a -modified version of this License if you rename the license and remove -any references to the name of the license steward (except to note that -such modified license differs from this License). - -10.4. Distributing Source Code Form that is Incompatible With Secondary -Licenses - -If You choose to distribute Source Code Form that is Incompatible With -Secondary Licenses under the terms of this version of the License, the -notice described in Exhibit B of this License must be attached. - -Exhibit A - Source Code Form License Notice -------------------------------------------- - - This Source Code Form is subject to the terms of the Mozilla Public - License, v. 2.0. If a copy of the MPL was not distributed with this - file, You can obtain one at http://mozilla.org/MPL/2.0/. - -If it is not possible or desirable to put the notice in a particular -file, then You may include the notice in a location (such as a LICENSE -file in a relevant directory) where a recipient would be likely to look -for such a notice. - -You may add additional accurate notices of copyright ownership. - -Exhibit B - "Incompatible With Secondary Licenses" Notice ---------------------------------------------------------- - - This Source Code Form is "Incompatible With Secondary Licenses", as - defined by the Mozilla Public License, v. 2.0. - - diff --git a/mal/Makefile b/mal/Makefile deleted file mode 100644 index 8626a3a..0000000 --- a/mal/Makefile +++ /dev/null @@ -1,504 +0,0 @@ -# Usage/help -all help: - @echo - @echo 'USAGE:' - @echo - @echo 'Rules/Targets:' - @echo - @echo 'make "IMPL" # build all steps of IMPL' - @echo 'make "IMPL^STEP" # build STEP of IMPL' - @echo - @echo 'make "test" # test all implementations' - @echo 'make "test^IMPL" # test all steps of IMPL' - @echo 'make "test^STEP" # test STEP for all implementations' - @echo 'make "test^IMPL^STEP" # test STEP of IMPL' - @echo - @echo 'make "perf" # run microbenchmarks for all implementations' - @echo 'make "perf^IMPL" # run microbenchmarks for IMPL' - @echo - @echo 'make "repl^IMPL" # run stepA of IMPL' - @echo 'make "repl^IMPL^STEP" # test STEP of IMPL' - @echo - @echo 'make "clean" # run 'make clean' for all implementations' - @echo 'make "clean^IMPL" # run 'make clean' for IMPL' - @echo - @echo 'make "stats" # run 'make stats' for all implementations' - @echo 'make "stats-lisp" # run 'make stats-lisp' for all implementations' - @echo 'make "stats^IMPL" # run 'make stats' for IMPL' - @echo 'make "stats-lisp^IMPL" # run 'make stats-lisp' for IMPL' - @echo - @echo 'Options/Settings:' - @echo - @echo 'make MAL_IMPL=IMPL "test^mal..." # use IMPL for self-host tests' - @echo 'make REGRESS=1 "test..." # test with previous step tests too' - @echo 'make DOCKERIZE=1 ... # to dockerize above rules/targets' - @echo 'make TEST_OPTS="--opt ..." # options to pass to runtest.py' - @echo - @echo 'Other:' - @echo - @echo 'make "docker-build^IMPL" # build docker image for IMPL' - @echo - @echo 'make "docker-shell^IMPL" # start bash shell in docker image for IMPL' - @echo - -# -# Command line settings -# - -MAL_IMPL = js - -# cbm or qbasic -basic_MODE = cbm -# clj or cljs (Clojure vs ClojureScript/lumo) -clojure_MODE = clj -# python, js, cpp, or neko -haxe_MODE = neko -# octave or matlab -matlab_MODE = octave -# python, python2 or python3 -python_MODE = python -# scheme (chibi, kawa, gauche, chicken, sagittarius, cyclone, foment) -scheme_MODE = chibi -# js wace_libc wace_fooboot -wasm_MODE = wace_libc - -# Path to loccount for counting LOC stats -LOCCOUNT = loccount - -# Extra options to pass to runtest.py -TEST_OPTS = - -# Test with previous test files not just the test files for the -# current step. Step 0 and 1 tests are special and not included in -# later steps. -REGRESS = - -DEFERRABLE=1 -OPTIONAL=1 - -# Run target/rule within docker image for the implementation -DOCKERIZE = - - -# -# Implementation specific settings -# - -IMPLS = ada ada.2 awk bash basic c chuck clojure coffee common-lisp cpp crystal cs d dart \ - elisp elixir elm erlang es6 factor fantom forth fsharp go groovy gnu-smalltalk \ - guile haskell haxe hy io java js julia kotlin livescript logo lua make mal \ - matlab miniMAL nasm nim objc objpascal ocaml perl perl6 php picolisp plpgsql \ - plsql powershell ps python r racket rexx rpython ruby rust scala scheme skew \ - swift swift3 swift4 tcl ts vb vhdl vimscript wasm yorick - -EXTENSION = .mal - -step0 = step0_repl -step1 = step1_read_print -step2 = step2_eval -step3 = step3_env -step4 = step4_if_fn_do -step5 = step5_tco -step6 = step6_file -step7 = step7_quote -step8 = step8_macros -step9 = step9_try -stepA = stepA_mal - -argv_STEP = step6_file - - -regress_step0 = step0 -regress_step1 = step1 -regress_step2 = step2 -regress_step3 = $(regress_step2) step3 -regress_step4 = $(regress_step3) step4 -regress_step5 = $(regress_step4) step5 -regress_step6 = $(regress_step5) step6 -regress_step7 = $(regress_step6) step7 -regress_step8 = $(regress_step7) step8 -regress_step9 = $(regress_step8) step9 -regress_stepA = $(regress_step9) stepA - -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 -step5_EXCLUDES += plpgsql # too slow for 10,000 -step5_EXCLUDES += plsql # too slow for 10,000 -step5_EXCLUDES += powershell # too slow for 10,000 -step5_EXCLUDES += $(if $(filter cpp,$(haxe_MODE)),haxe,) # cpp finishes 10,000, segfaults at 100,000 - -dist_EXCLUDES += mal -# TODO: still need to implement dist -dist_EXCLUDES += guile io julia matlab swift - - -# Extra options to pass to runtest.py -logo_TEST_OPTS = --start-timeout 60 --test-timeout 120 -mal_TEST_OPTS = --start-timeout 60 --test-timeout 120 -miniMAL_TEST_OPTS = --start-timeout 60 --test-timeout 120 -perl6_TEST_OPTS = --test-timeout=60 -plpgsql_TEST_OPTS = --start-timeout 60 --test-timeout 180 -plsql_TEST_OPTS = --start-timeout 120 --test-timeout 120 -vimscript_TEST_OPTS = --test-timeout 30 -ifeq ($(MAL_IMPL),vimscript) -mal_TEST_OPTS = --start-timeout 60 --test-timeout 180 -else ifeq ($(MAL_IMPL),powershell) -mal_TEST_OPTS = --start-timeout 60 --test-timeout 180 -endif - - -# -# Implementation specific utility functions -# - -basic_STEP_TO_PROG_cbm = basic/$($(1)).bas -basic_STEP_TO_PROG_qbasic = basic/$($(1)) - -clojure_STEP_TO_PROG_clj = clojure/target/$($(1)).jar -clojure_STEP_TO_PROG_cljs = clojure/src/mal/$($(1)).cljc - -haxe_STEP_TO_PROG_neko = haxe/$($(1)).n -haxe_STEP_TO_PROG_python = haxe/$($(1)).py -haxe_STEP_TO_PROG_cpp = haxe/cpp/$($(1)) -haxe_STEP_TO_PROG_js = haxe/$($(1)).js - -scheme_STEP_TO_PROG_chibi = scheme/$($(1)).scm -scheme_STEP_TO_PROG_kawa = scheme/out/$($(1)).class -scheme_STEP_TO_PROG_gauche = scheme/$($(1)).scm -scheme_STEP_TO_PROG_chicken = scheme/$($(1)) -scheme_STEP_TO_PROG_sagittarius = scheme/$($(1)).scm -scheme_STEP_TO_PROG_cyclone = scheme/$($(1)) -scheme_STEP_TO_PROG_foment = scheme/$($(1)).scm - -# Map of step (e.g. "step8") to executable file for that step -ada_STEP_TO_PROG = ada/$($(1)) -ada.2_STEP_TO_PROG = ada.2/$($(1)) -awk_STEP_TO_PROG = awk/$($(1)).awk -bash_STEP_TO_PROG = bash/$($(1)).sh -basic_STEP_TO_PROG = $(basic_STEP_TO_PROG_$(basic_MODE)) -c_STEP_TO_PROG = c/$($(1)) -chuck_STEP_TO_PROG = chuck/$($(1)).ck -clojure_STEP_TO_PROG = $(clojure_STEP_TO_PROG_$(clojure_MODE)) -coffee_STEP_TO_PROG = coffee/$($(1)).coffee -common-lisp_STEP_TO_PROG = common-lisp/$($(1)) -cpp_STEP_TO_PROG = cpp/$($(1)) -crystal_STEP_TO_PROG = crystal/$($(1)) -cs_STEP_TO_PROG = cs/$($(1)).exe -d_STEP_TO_PROG = d/$($(1)) -dart_STEP_TO_PROG = dart/$($(1)).dart -elisp_STEP_TO_PROG = elisp/$($(1)).el -elixir_STEP_TO_PROG = elixir/lib/mix/tasks/$($(1)).ex -elm_STEP_TO_PROG = elm/$($(1)).js -erlang_STEP_TO_PROG = erlang/$($(1)) -es6_STEP_TO_PROG = es6/$($(1)).mjs -factor_STEP_TO_PROG = factor/$($(1))/$($(1)).factor -fantom_STEP_TO_PROG = fantom/lib/fan/$($(1)).pod -forth_STEP_TO_PROG = forth/$($(1)).fs -fsharp_STEP_TO_PROG = fsharp/$($(1)).exe -go_STEP_TO_PROG = go/$($(1)) -groovy_STEP_TO_PROG = groovy/$($(1)).groovy -gnu-smalltalk_STEP_TO_PROG = gnu-smalltalk/$($(1)).st -guile_STEP_TO_PROG = guile/$($(1)).scm -haskell_STEP_TO_PROG = haskell/$($(1)) -haxe_STEP_TO_PROG = $(haxe_STEP_TO_PROG_$(haxe_MODE)) -hy_STEP_TO_PROG = hy/$($(1)).hy -io_STEP_TO_PROG = io/$($(1)).io -java_STEP_TO_PROG = java/target/classes/mal/$($(1)).class -js_STEP_TO_PROG = js/$($(1)).js -julia_STEP_TO_PROG = julia/$($(1)).jl -kotlin_STEP_TO_PROG = kotlin/$($(1)).jar -livescript_STEP_TO_PROG = livescript/$($(1)).js -logo_STEP_TO_PROG = logo/$($(1)).lg -lua_STEP_TO_PROG = lua/$($(1)).lua -make_STEP_TO_PROG = make/$($(1)).mk -mal_STEP_TO_PROG = mal/$($(1)).mal -matlab_STEP_TO_PROG = matlab/$($(1)).m -miniMAL_STEP_TO_PROG = miniMAL/$($(1)).json -nasm_STEP_TO_PROG = nasm/$($(1)) -nim_STEP_TO_PROG = nim/$($(1)) -objc_STEP_TO_PROG = objc/$($(1)) -objpascal_STEP_TO_PROG = objpascal/$($(1)) -ocaml_STEP_TO_PROG = ocaml/$($(1)) -perl_STEP_TO_PROG = perl/$($(1)).pl -perl6_STEP_TO_PROG = perl6/$($(1)).pl -php_STEP_TO_PROG = php/$($(1)).php -picolisp_STEP_TO_PROG = picolisp/$($(1)).l -plpgsql_STEP_TO_PROG = plpgsql/$($(1)).sql -plsql_STEP_TO_PROG = plsql/$($(1)).sql -powershell_STEP_TO_PROG = powershell/$($(1)).ps1 -ps_STEP_TO_PROG = ps/$($(1)).ps -python_STEP_TO_PROG = python/$($(1)).py -r_STEP_TO_PROG = r/$($(1)).r -racket_STEP_TO_PROG = racket/$($(1)).rkt -rexx_STEP_TO_PROG = rexx/$($(1)).rexxpp -rpython_STEP_TO_PROG = rpython/$($(1)) -ruby_STEP_TO_PROG = ruby/$($(1)).rb -rust_STEP_TO_PROG = rust/$($(1)) -scala_STEP_TO_PROG = scala/target/scala-2.11/classes/$($(1)).class -scheme_STEP_TO_PROG = $(scheme_STEP_TO_PROG_$(scheme_MODE)) -skew_STEP_TO_PROG = skew/$($(1)).js -swift_STEP_TO_PROG = swift/$($(1)) -swift3_STEP_TO_PROG = swift3/$($(1)) -swift4_STEP_TO_PROG = swift4/$($(1)) -tcl_STEP_TO_PROG = tcl/$($(1)).tcl -ts_STEP_TO_PROG = ts/$($(1)).js -vb_STEP_TO_PROG = vb/$($(1)).exe -vhdl_STEP_TO_PROG = vhdl/$($(1)) -vimscript_STEP_TO_PROG = vimscript/$($(1)).vim -wasm_STEP_TO_PROG = wasm/$($(1)).wasm -yorick_STEP_TO_PROG = yorick/$($(1)).i - - -# -# General settings and utility functions -# - -# Needed some argument munging -COMMA = , -noop = -SPACE = $(noop) $(noop) -export FACTOR_ROOTS := . - -opt_DEFERRABLE = $(if $(strip $(DEFERRABLE)),$(if $(filter t true T True TRUE 1 y yes Yes YES,$(DEFERRABLE)),--deferrable,--no-deferrable),--no-deferrable) -opt_OPTIONAL = $(if $(strip $(OPTIONAL)),$(if $(filter t true T True TRUE 1 y yes Yes YES,$(OPTIONAL)),--optional,--no-optional),--no-optional) - -# Return list of test files for a given step. If REGRESS is set then -# test files will include step 2 tests through tests for the step -# being tested. -STEP_TEST_FILES = $(strip $(wildcard \ - $(foreach s,$(if $(strip $(REGRESS)),\ - $(filter-out $(if $(filter $(1),$(step5_EXCLUDES)),step5,),\ - $(regress_$(2)))\ - ,$(2)),\ - $(1)/tests/$($(s))$(EXTENSION) tests/$($(s))$(EXTENSION)))) - -# DOCKERIZE utility functions -lc = $(subst A,a,$(subst B,b,$(subst C,c,$(subst D,d,$(subst E,e,$(subst F,f,$(subst G,g,$(subst H,h,$(subst I,i,$(subst J,j,$(subst K,k,$(subst L,l,$(subst M,m,$(subst N,n,$(subst O,o,$(subst P,p,$(subst Q,q,$(subst R,r,$(subst S,s,$(subst T,t,$(subst U,u,$(subst V,v,$(subst W,w,$(subst X,x,$(subst Y,y,$(subst Z,z,$1)))))))))))))))))))))))))) -impl_to_image = kanaka/mal-test-$(call lc,$(1)) - -actual_impl = $(if $(filter mal,$(1)),$(MAL_IMPL),$(1)) - -# Takes impl -# Returns nothing if DOCKERIZE is not set, otherwise returns the -# docker prefix necessary to run make within the docker environment -# for this impl -get_build_command = $(strip $(if $(strip $(DOCKERIZE)),\ - docker run \ - -it --rm -u $(shell id -u) \ - -v $(dir $(abspath $(lastword $(MAKEFILE_LIST)))):/mal \ - -w /mal/$(1) \ - $(if $(strip $($(1)_MODE)),-e $(1)_MODE=$($(1)_MODE),) \ - $(if $(filter factor,$(1)),-e FACTOR_ROOTS=$(FACTOR_ROOTS),) \ - $(call impl_to_image,$(1)) \ - $(MAKE) $(if $(strip $($(1)_MODE)),$(1)_MODE=$($(1)_MODE),) \ - ,\ - $(MAKE) $(if $(strip $($(1)_MODE)),$(1)_MODE=$($(1)_MODE),))) - -# Takes impl and step args. Optional env vars and dockerize args -# Returns a command prefix (docker command and environment variables) -# necessary to launch the given impl and step -get_run_prefix = $(strip $(if $(strip $(DOCKERIZE) $(4)),\ - docker run -e STEP=$($2) -e MAL_IMPL=$(MAL_IMPL) \ - -it --rm -u $(shell id -u) \ - -v $(dir $(abspath $(lastword $(MAKEFILE_LIST)))):/mal \ - -w /mal/$(call actual_impl,$(1)) \ - $(if $(strip $($(1)_MODE)),-e $(1)_MODE=$($(1)_MODE),) \ - $(if $(filter factor,$(1)),-e FACTOR_ROOTS=$(FACTOR_ROOTS),) \ - $(foreach env,$(3),-e $(env)) \ - $(call impl_to_image,$(call actual_impl,$(1))) \ - ,\ - env STEP=$($2) MAL_IMPL=$(MAL_IMPL) \ - $(if $(strip $($(1)_MODE)),$(1)_MODE=$($(1)_MODE),) \ - $(if $(filter factor,$(1)),FACTOR_ROOTS=$(FACTOR_ROOTS),) \ - $(3))) - -# Takes impl and step -# Returns the runtest command prefix (with runtest options) for testing the given step -get_runtest_cmd = $(call get_run_prefix,$(1),$(2),$(if $(filter cs fsharp tcl vb,$(1)),RAW=1,)) \ - ../runtest.py $(opt_DEFERRABLE) $(opt_OPTIONAL) $(call $(1)_TEST_OPTS) $(TEST_OPTS) - -# Takes impl and step -# Returns the runtest command prefix (with runtest options) for testing the given step -get_argvtest_cmd = $(call get_run_prefix,$(1),$(2)) ../run_argv_test.sh - -# Derived lists -STEPS = $(sort $(filter-out %_EXCLUDES,$(filter step%,$(.VARIABLES)))) -DO_IMPLS = $(filter-out $(SKIP_IMPLS),$(IMPLS)) -IMPL_TESTS = $(foreach impl,$(DO_IMPLS),test^$(impl)) -STEP_TESTS = $(foreach step,$(STEPS),test^$(step)) -ALL_TESTS = $(filter-out $(foreach e,$(step5_EXCLUDES),test^$(e)^step5),\ - $(strip $(sort \ - $(foreach impl,$(DO_IMPLS),\ - $(foreach step,$(STEPS),test^$(impl)^$(step)))))) - -DOCKER_BUILD = $(foreach impl,$(DO_IMPLS),docker-build^$(impl)) - -DOCKER_SHELL = $(foreach impl,$(DO_IMPLS),docker-shell^$(impl)) - -IMPL_PERF = $(foreach impl,$(filter-out $(perf_EXCLUDES),$(DO_IMPLS)),perf^$(impl)) - -IMPL_STATS = $(foreach impl,$(DO_IMPLS),stats^$(impl)) - -IMPL_REPL = $(foreach impl,$(DO_IMPLS),repl^$(impl)) -ALL_REPL = $(strip $(sort \ - $(foreach impl,$(DO_IMPLS),\ - $(foreach step,$(STEPS),repl^$(impl)^$(step))))) - - -# -# Build rules -# - -# Enable secondary expansion for all rules -.SECONDEXPANSION: - -# Build a program in an implementation directory -# Make sure we always try and build first because the dependencies are -# encoded in the implementation Makefile not here -.PHONY: $(foreach i,$(DO_IMPLS),$(foreach s,$(STEPS),$(call $(i)_STEP_TO_PROG,$(s)))) -$(foreach i,$(DO_IMPLS),$(foreach s,$(STEPS),$(call $(i)_STEP_TO_PROG,$(s)))): - $(foreach impl,$(word 1,$(subst /, ,$(@))),\ - $(if $(DOCKERIZE), \ - $(call get_build_command,$(impl)) $(patsubst $(impl)/%,%,$(@)), \ - $(call get_build_command,$(impl)) -C $(impl) $(subst $(impl)/,,$(@)))) - -# Allow IMPL, and IMPL^STEP -$(DO_IMPLS): $$(foreach s,$$(STEPS),$$(call $$(@)_STEP_TO_PROG,$$(s))) - -$(foreach i,$(DO_IMPLS),$(foreach s,$(STEPS),$(i)^$(s))): $$(call $$(word 1,$$(subst ^, ,$$(@)))_STEP_TO_PROG,$$(word 2,$$(subst ^, ,$$(@)))) - - -# -# Test rules -# - -$(ALL_TESTS): $$(call $$(word 2,$$(subst ^, ,$$(@)))_STEP_TO_PROG,$$(word 3,$$(subst ^, ,$$(@)))) - @$(foreach impl,$(word 2,$(subst ^, ,$(@))),\ - $(foreach step,$(word 3,$(subst ^, ,$(@))),\ - cd $(if $(filter mal,$(impl)),$(MAL_IMPL),$(impl)) && \ - $(foreach test,$(call STEP_TEST_FILES,$(impl),$(step)),\ - echo '----------------------------------------------' && \ - echo 'Testing $@; step file: $+, test file: $(test)' && \ - echo 'Running: $(call get_runtest_cmd,$(impl),$(step)) ../$(test) -- ../$(impl)/run' && \ - $(call get_runtest_cmd,$(impl),$(step)) ../$(test) -- ../$(impl)/run && \ - $(if $(filter tests/$(argv_STEP)$(EXTENSION),$(test)),\ - echo '----------------------------------------------' && \ - echo 'Testing ARGV of $@; step file: $+' && \ - echo 'Running: $(call get_argvtest_cmd,$(impl),$(step)) ../$(impl)/run ' && \ - $(call get_argvtest_cmd,$(impl),$(step)) ../$(impl)/run && ,\ - true && ))\ - true)) - -# Allow test, tests, test^STEP, test^IMPL, and test^IMPL^STEP -test: $(ALL_TESTS) -tests: $(ALL_TESTS) - -$(IMPL_TESTS): $$(filter $$@^%,$$(ALL_TESTS)) - -$(STEP_TESTS): $$(foreach step,$$(subst test^,,$$@),$$(filter %^$$(step),$$(ALL_TESTS))) - - -# -# Docker build rules -# - -docker-build: $(DOCKER_BUILD) - -$(DOCKER_BUILD): - @echo "----------------------------------------------"; \ - $(foreach impl,$(word 2,$(subst ^, ,$(@))),\ - echo "Running: docker build -t $(call impl_to_image,$(impl)) .:"; \ - cd $(impl) && docker build -t $(call impl_to_image,$(impl)) .) - -# -# Docker shell rules -# - -$(DOCKER_SHELL): - @echo "----------------------------------------------"; \ - $(foreach impl,$(word 2,$(subst ^, ,$(@))),\ - echo "Running: $(call get_run_prefix,$(impl),stepA,,dockerize) bash"; \ - $(call get_run_prefix,$(impl),stepA,,dockerize) bash) - - -# -# Performance test rules -# - -perf: $(IMPL_PERF) - -$(IMPL_PERF): - @echo "----------------------------------------------"; \ - $(foreach impl,$(word 2,$(subst ^, ,$(@))),\ - cd $(if $(filter mal,$(impl)),$(MAL_IMPL),$(impl)); \ - echo "Performance test for $(impl):"; \ - echo 'Running: $(call get_run_prefix,$(impl),stepA) ../$(impl)/run ../tests/perf1.mal'; \ - $(call get_run_prefix,$(impl),stepA) ../$(impl)/run ../tests/perf1.mal; \ - echo 'Running: $(call get_run_prefix,$(impl),stepA) ../$(impl)/run ../tests/perf2.mal'; \ - $(call get_run_prefix,$(impl),stepA) ../$(impl)/run ../tests/perf2.mal; \ - echo 'Running: $(call get_run_prefix,$(impl),stepA) ../$(impl)/run ../tests/perf3.mal'; \ - $(call get_run_prefix,$(impl),stepA) ../$(impl)/run ../tests/perf3.mal) - - -# -# REPL invocation rules -# - -$(ALL_REPL): $$(call $$(word 2,$$(subst ^, ,$$(@)))_STEP_TO_PROG,$$(word 3,$$(subst ^, ,$$(@)))) - @$(foreach impl,$(word 2,$(subst ^, ,$(@))),\ - $(foreach step,$(word 3,$(subst ^, ,$(@))),\ - cd $(if $(filter mal,$(impl)),$(MAL_IMPL),$(impl)); \ - echo 'REPL implementation $(impl), step file: $+'; \ - echo 'Running: $(call get_run_prefix,$(impl),$(step)) ../$(impl)/run $(RUN_ARGS)'; \ - $(call get_run_prefix,$(impl),$(step)) ../$(impl)/run $(RUN_ARGS);)) - -# Allow repl^IMPL^STEP and repl^IMPL (which starts REPL of stepA) -$(IMPL_REPL): $$@^stepA - -# -# Stats test rules -# - -# For a concise summary: -# make stats | egrep -A1 "^Stats for|^all" | egrep -v "^all|^--" -stats: $(IMPL_STATS) - -$(IMPL_STATS): - @$(foreach impl,$(word 2,$(subst ^, ,$(@))),\ - echo "Stats for $(impl):"; \ - $(LOCCOUNT) -x "Makefile|node_modules" $(impl)) - -# -# Utility functions -# -print-%: - @echo "$($(*))" - -# -# Recursive rules (call make FOO in each subdirectory) -# - -define recur_template -.PHONY: $(1) -$(1): $(2) -$(2): - @echo "----------------------------------------------"; \ - $$(foreach impl,$$(word 2,$$(subst ^, ,$$(@))),\ - $$(if $$(DOCKERIZE), \ - echo "Running: $$(call get_build_command,$$(impl)) --no-print-directory $(1)"; \ - $$(call get_build_command,$$(impl)) --no-print-directory $(1), \ - echo "Running: $$(call get_build_command,$$(impl)) --no-print-directory -C $$(impl) $(1)"; \ - $$(call get_build_command,$$(impl)) --no-print-directory -C $$(impl) $(1))) -endef - -recur_impls_ = $(filter-out $(foreach impl,$($(1)_EXCLUDES),$(1)^$(impl)),$(foreach impl,$(IMPLS),$(1)^$(impl))) - -# recursive clean -$(eval $(call recur_template,clean,$(call recur_impls_,clean))) - -# recursive dist -$(eval $(call recur_template,dist,$(call recur_impls_,dist))) diff --git a/mal/README.md b/mal/README.md deleted file mode 100644 index 29481c4..0000000 --- a/mal/README.md +++ /dev/null @@ -1,1232 +0,0 @@ -# mal - Make a Lisp - -[![Build Status](https://travis-ci.org/kanaka/mal.svg?branch=master)](https://travis-ci.org/kanaka/mal) - -## Description - -**1. Mal is a Clojure inspired Lisp interpreter** - -**2. Mal is implemented in 75 languages (76 implementations total)** - -| Language | Creator | -| -------- | ------- | -| [Ada](#ada) | [Chris Moore](https://github.com/zmower) | -| [Ada #2](#ada2) | [Nicolas Boulenguez](https://github.com/asarhaddon) | -| [GNU Awk](#gnu-awk) | [Miutsuru Kariya](https://github.com/kariya-mitsuru) | -| [Bash 4](#bash-4) | [Joel Martin](https://github.com/kanaka) | -| [BASIC](#basic-c64-and-qbasic) (C64 & QBasic) | [Joel Martin](https://github.com/kanaka) | -| [C](#c) | [Joel Martin](https://github.com/kanaka) | -| [C++](#c-1) | [Stephen Thirlwall](https://github.com/sdt) | -| [C#](#c-2) | [Joel Martin](https://github.com/kanaka) | -| [ChucK](#chuck) | [Vasilij Schneidermann](https://github.com/wasamasa) | -| [Clojure](#clojure) (Clojure & ClojureScript) | [Joel Martin](https://github.com/kanaka) | -| [CoffeeScript](#coffeescript) | [Joel Martin](https://github.com/kanaka) | -| [Common Lisp](#common-lisp) | [Iqbal Ansari](https://github.com/iqbalansari) | -| [Crystal](#crystal) | [Linda_pp](https://github.com/rhysd) | -| [D](#d) | [Dov Murik](https://github.com/dubek) | -| [Dart](#dart) | [Harry Terkelsen](https://github.com/hterkelsen) | -| [Elixir](#elixir) | [Martin Ek](https://github.com/ekmartin) | -| [Elm](#elm) | [Jos van Bakel](https://github.com/c0deaddict) | -| [Emacs Lisp](#emacs-lisp) | [Vasilij Schneidermann](https://github.com/wasamasa) | -| [Erlang](#erlang) | [Nathan Fiedler](https://github.com/nlfiedler) | -| [ES6](#es6-ecmascript-2015) (ECMAScript 2015) | [Joel Martin](https://github.com/kanaka) | -| [F#](#f) | [Peter Stephens](https://github.com/pstephens) | -| [Factor](#factor) | [Jordan Lewis](https://github.com/jordanlewis) | -| [Fantom](#fantom) | [Dov Murik](https://github.com/dubek) | -| [Forth](#forth) | [Chris Houser](https://github.com/chouser) | -| [GNU Guile](#gnu-guile-21) | [Mu Lei](https://github.com/NalaGinrut) | -| [GNU Smalltalk](#gnu-smalltalk) | [Vasilij Schneidermann](https://github.com/wasamasa) | -| [Go](#go) | [Joel Martin](https://github.com/kanaka) | -| [Groovy](#groovy) | [Joel Martin](https://github.com/kanaka) | -| [Haskell](#haskell) | [Joel Martin](https://github.com/kanaka) | -| [Haxe](#haxe-neko-python-c-and-javascript) (Neko, Python, C++, & JS) | [Joel Martin](https://github.com/kanaka) | -| [Hy](#hy) | [Joel Martin](https://github.com/kanaka) | -| [Io](#io) | [Dov Murik](https://github.com/dubek) | -| [Java](#java-17) | [Joel Martin](https://github.com/kanaka) | -| [JavaScript](#javascriptnode) ([Demo](http://kanaka.github.io/mal)) | [Joel Martin](https://github.com/kanaka) | -| [Julia](#julia) | [Joel Martin](https://github.com/kanaka) | -| [Kotlin](#kotlin) | [Javier Fernandez-Ivern](https://github.com/ivern) | -| [LiveScript](#livescript) | [Jos van Bakel](https://github.com/c0deaddict) | -| [Logo](#logo) | [Dov Murik](https://github.com/dubek) | -| [Lua](#lua) | [Joel Martin](https://github.com/kanaka) | -| [GNU Make](#gnu-make-381) | [Joel Martin](https://github.com/kanaka) | -| [mal itself](#mal) | [Joel Martin](https://github.com/kanaka) | -| [MATLAB](#matlab-gnu-octave-and-matlab) (GNU Octave & MATLAB) | [Joel Martin](https://github.com/kanaka) | -| [miniMAL](#minimal) ([Repo](https://github.com/kanaka/miniMAL), [Demo](https://kanaka.github.io/miniMAL/)) | [Joel Martin](https://github.com/kanaka) | -| [NASM](#nasm) | [Ben Dudson](https://github.com/bendudson) | -| [Nim](#nim-0170) | [Dennis Felsing](https://github.com/def-) | -| [Object Pascal](#object-pascal) | [Joel Martin](https://github.com/kanaka) | -| [Objective C](#objective-c) | [Joel Martin](https://github.com/kanaka) | -| [OCaml](#ocaml-4010) | [Chris Houser](https://github.com/chouser) | -| [Perl](#perl-58) | [Joel Martin](https://github.com/kanaka) | -| [Perl 6](#perl-6) | [Hinrik Örn Sigurðsson](https://github.com/hinrik) | -| [PHP](#php-53) | [Joel Martin](https://github.com/kanaka) | -| [Picolisp](#picolisp) | [Vasilij Schneidermann](https://github.com/wasamasa) | -| [PL/pgSQL](#plpgsql-postgres-sql-procedural-language) (Postgres) | [Joel Martin](https://github.com/kanaka) | -| [PL/SQL](#plsql-oracle-sql-procedural-language) (Oracle) | [Joel Martin](https://github.com/kanaka) | -| [PostScript](#postscript-level-23) | [Joel Martin](https://github.com/kanaka) | -| [PowerShell](#powershell) | [Joel Martin](https://github.com/kanaka) | -| [Python](#python-2x-and-3x) (2.X & 3.X) | [Joel Martin](https://github.com/kanaka) | -| [RPython](#rpython) | [Joel Martin](https://github.com/kanaka) | -| [R](#r) | [Joel Martin](https://github.com/kanaka) | -| [Racket](#racket-53) | [Joel Martin](https://github.com/kanaka) | -| [Rexx](#rexx) | [Dov Murik](https://github.com/dubek) | -| [Ruby](#ruby-19) | [Joel Martin](https://github.com/kanaka) | -| [Rust](#rust-100-nightly) | [Joel Martin](https://github.com/kanaka) | -| [Scala](#scala) | [Joel Martin](https://github.com/kanaka) | -| [Scheme (R7RS)](#scheme-r7rs) | [Vasilij Schneidermann](https://github.com/wasamasa) | -| [Skew](#skew) | [Dov Murik](https://github.com/dubek) | -| [Swift 2](#swift) | [Keith Rollin](https://github.com/keith-rollin) | -| [Swift 3](#swift-3) | [Joel Martin](https://github.com/kanaka) | -| [Swift 4](#swift-4) | [陆遥](https://github.com/LispLY) | -| [Tcl](#tcl-86) | [Dov Murik](https://github.com/dubek) | -| [TypeScript](#typescript) | [Masahiro Wakame](https://github.com/vvakame) | -| [VHDL](#vhdl) | [Dov Murik](https://github.com/dubek) | -| [Vimscript](#vimscript) | [Dov Murik](https://github.com/dubek) | -| [Visual Basic.NET](#visual-basicnet) | [Joel Martin](https://github.com/kanaka) | -| [WebAssembly](#webassembly-wasm) (wasm) | [Joel Martin](https://github.com/kanaka) | -| [Yorick](#yorick) | [Dov Murik](https://github.com/dubek) | - - -**3. Mal is a learning tool** - -Each implementation of mal is separated into -11 incremental, self-contained (and testable) steps that demonstrate -core concepts of Lisp. The last step is capable of self-hosting -(running the mal implementation of mal). See the [make-a-lisp process -guide](process/guide.md). - -The make-a-lisp steps are: - -* [step0_repl](process/guide.md#step0) -* [step1_read_print](process/guide.md#step1) -* [step2_eval](process/guide.md#step2) -* [step3_env](process/guide.md#step3) -* [step4_if_fn_do](process/guide.md#step4) -* [step5_tco](process/guide.md#step5) -* [step6_file](process/guide.md#step6) -* [step7_quote](process/guide.md#step7) -* [step8_macros](process/guide.md#step8) -* [step9_try](process/guide.md#step9) -* [stepA_mal](process/guide.md#stepA) - -Each make-a-lisp step has an associated architectural diagram. That elements -that are new for that step are highlighted in red. -Here is the final diagram for [step A](process/guide.md#stepA): - -![stepA_mal architecture](process/stepA_mal.png) - -If you are interesting in creating a mal implementation (or just -interested in using mal for something), please drop by the #mal -channel on freenode. In addition to the [make-a-lisp process -guide](process/guide.md) there is also a [mal/make-a-lisp -FAQ](docs/FAQ.md) where I attempt to answer some common questions. - - -## Presentations - -Mal was presented publicly for the first time in a lightning talk at -Clojure West 2014 (unfortunately there is no video). See -examples/clojurewest2014.mal for the presentation that was given at the -conference (yes, the presentation is a mal program). - -At Midwest.io 2015, Joel Martin gave a presentation on Mal titled -"Achievement Unlocked: A Better Path to Language Learning". -[Video](https://www.youtube.com/watch?v=lgyOAiRtZGw), -[Slides](http://kanaka.github.io/midwest.io.mal/). - -More recently Joel gave a presentation on "Make Your Own Lisp Interpreter -in 10 Incremental Steps" at LambdaConf 2016: -[Part 1](https://www.youtube.com/watch?v=jVhupfthTEk), -[Part 2](https://www.youtube.com/watch?v=X5OQBMGpaTU), -[Part 3](https://www.youtube.com/watch?v=6mARZzGgX4U), -[Part 4](https://www.youtube.com/watch?v=dCO1SYR5kDU), -[Slides](http://kanaka.github.io/lambdaconf/). - -## Building/running implementations - -The simplest way to run any given implementation is to use docker. -Every implementation has a docker image pre-built with language -dependencies installed. You can launch the REPL using a convenient -target in the top level Makefile (where IMPL is the implementation -directory name and stepX is the step to run): - -``` -make DOCKERIZE=1 "repl^IMPL^stepX" - # OR stepA is the default step: -make DOCKERIZE=1 "repl^IMPL" -``` - - -### Ada - -The Ada implementation was developed with GNAT 4.9 on debian. It also -compiles unchanged on windows if you have windows versions of git, -GNAT and (optionally) make. There are no external dependencies -(readline not implemented). - -``` -cd ada -make -./stepX_YYY -``` - -### Ada.2 - -The second Ada implementation was developed with GNAT 8 and links with -the GNU readline library. - -``` -cd ada -make -./stepX_YYY -``` - -### GNU awk - -The GNU awk implementation of mal has been tested with GNU awk 4.1.1. - -``` -cd gawk -gawk -O -f stepX_YYY.awk -``` - -### Bash 4 - -``` -cd bash -bash stepX_YYY.sh -``` - -### BASIC (C64 and QBasic) - -The BASIC implementation uses a preprocessor that can generate BASIC -code that is compatible with both C64 BASIC (CBM v2) and QBasic. The -C64 mode has been tested with -[cbmbasic](https://github.com/kanaka/cbmbasic) (the patched version is -currently required to fix issues with line input) and the QBasic mode -has been tested with [qb64](http://www.qb64.net/). - -Generate C64 code and run it using cbmbasic: - -``` -cd basic -make stepX_YYY.bas -STEP=stepX_YYY ./run -``` - -Generate QBasic code and load it into qb64: - -``` -cd basic -make MODE=qbasic stepX_YYY.bas -./qb64 stepX_YYY.bas -``` - -Thanks to [Steven Syrek](https://github.com/sjsyrek) for the original -inspiration for this implementation. - - -### C - -The C implementation of mal requires the following libraries (lib and -header packages): glib, libffi6, libgc, and either the libedit or GNU readline -library. - -``` -cd c -make -./stepX_YYY -``` - -### C++ - -The C++ implementation of mal requires g++-4.9 or clang++-3.5 and -a readline compatible library to build. See the `cpp/README.md` for -more details: - -``` -cd cpp -make - # OR -make CXX=clang++-3.5 -./stepX_YYY -``` - - -### C# ### - -The C# implementation of mal has been tested on Linux using the Mono -C# compiler (mcs) and the Mono runtime (version 2.10.8.1). Both are -required to build and run the C# implementation. - -``` -cd cs -make -mono ./stepX_YYY.exe -``` - -### ChucK - -The ChucK implementation has been tested with ChucK 1.3.5.2. - -``` -cd chuck -./run -``` - -### Clojure - -For the most part the Clojure implementation requires Clojure 1.5, -however, to pass all tests, Clojure 1.8.0-RC4 is required. - -``` -cd clojure -lein with-profile +stepX trampoline run -``` - -### CoffeeScript - -``` -sudo npm install -g coffee-script -cd coffee -coffee ./stepX_YYY -``` - -### Common Lisp - -The implementation has been tested with SBCL, CCL, CMUCL, GNU CLISP, ECL and -Allegro CL on Ubuntu 16.04 and Ubuntu 12.04, see -the [README](common-lisp/README.org) for more details. Provided you have the -dependencies mentioned installed, do the following to run the implementation - -``` -cd common-lisp -make -./run -``` - -### Crystal - -The Crystal implementation of mal has been tested with Crystal 0.26.1. - -``` -cd crystal -crystal run ./stepX_YYY.cr - # OR -make # needed to run tests -./stepX_YYY -``` - -### D - -The D implementation of mal was tested with GDC 4.8. It requires the GNU -readline library. - -``` -cd d -make -./stepX_YYY -``` - -### Dart - -The Dart implementation has been tested with Dart 1.20. - -``` -cd dart -dart ./stepX_YYY -``` - -### Emacs Lisp - -The Emacs Lisp implementation of mal has been tested with Emacs 24.3 -and 24.5. While there is very basic readline editing (`` -and `C-d` work, `C-c` cancels the process), it is recommended to use -`rlwrap`. - -``` -cd elisp -emacs -Q --batch --load stepX_YYY.el -# with full readline support -rlwrap emacs -Q --batch --load stepX_YYY.el -``` - -### Elixir - -The Elixir implementation of mal has been tested with Elixir 1.0.5. - -``` -cd elixir -mix stepX_YYY -# Or with readline/line editing functionality: -iex -S mix stepX_YYY -``` - -### Elm - -The Elm implementation of mal has been tested with Elm 0.18.0 - -``` -cd elm -make stepX_YYY.js -STEP=stepX_YYY ./run -``` - -### Erlang - -The Erlang implementation of mal requires [Erlang/OTP R17](http://www.erlang.org/download.html) -and [rebar](https://github.com/rebar/rebar) to build. - -``` -cd erlang -make - # OR -MAL_STEP=stepX_YYY rebar compile escriptize # build individual step -./stepX_YYY -``` - -### ES6 (ECMAScript 2015) - -The ES6 / ECMAScript 2015 implementation uses the -[babel](https://babeljs.io) compiler to generate ES5 compatible -JavaScript. The generated code has been tested with Node 0.12.4. - -``` -cd es6 -make -node build/stepX_YYY.js -``` - - -### F# ### - -The F# implementation of mal has been tested on Linux using the Mono -F# compiler (fsharpc) and the Mono runtime (version 3.12.1). The mono C# -compiler (mcs) is also necessary to compile the readline dependency. All are -required to build and run the F# implementation. - -``` -cd fsharp -make -mono ./stepX_YYY.exe -``` - -### Factor - -The Factor implementation of mal has been tested with Factor 0.97 -([factorcode.org](http://factorcode.org)). - -``` -cd factor -FACTOR_ROOTS=. factor -run=stepX_YYY -``` - -### Fantom - -The Fantom implementation of mal has been tested with Fantom 1.0.70. - -``` -cd fantom -make lib/fan/stepX_YYY.pod -STEP=stepX_YYY ./run -``` - -### Forth - -``` -cd forth -gforth stepX_YYY.fs -``` - -### GNU Guile 2.1+ - -``` -cd guile -guile -L ./ stepX_YYY.scm -``` - -### GNU Smalltalk - -The Smalltalk implementation of mal has been tested with GNU Smalltalk 3.2.91. - -``` -cd gnu-smalltalk -./run -``` - -### Go - -The Go implementation of mal requires that go is installed on on the -path. The implementation has been tested with Go 1.3.1. - -``` -cd go -make -./stepX_YYY -``` - - -### Groovy - -The Groovy implementation of mal requires Groovy to run and has been -tested with Groovy 1.8.6. - -``` -cd groovy -make -groovy ./stepX_YYY.groovy -``` - -### Haskell - -The Haskell implementation requires the ghc compiler version 7.10.1 or -later and also the Haskell parsec and readline (or editline) packages. - -``` -cd haskell -make -./stepX_YYY -``` - -### Haxe (Neko, Python, C++ and JavaScript) - -The Haxe implementation of mal requires Haxe version 3.2 to compile. -Four different Haxe targets are supported: Neko, Python, C++, and -JavaScript. - -``` -cd haxe -# Neko -make all-neko -neko ./stepX_YYY.n -# Python -make all-python -python3 ./stepX_YYY.py -# C++ -make all-cpp -./cpp/stepX_YYY -# JavaScript -make all-js -node ./stepX_YYY.js -``` - -### Hy - -The Hy implementation of mal has been tested with Hy 0.13.0. - -``` -cd hy -./stepX_YYY.hy -``` - -### Io - -The Io implementation of mal has been tested with Io version 20110905. - -``` -cd io -io ./stepX_YYY.io -``` - -### Java 1.7 - -The Java implementation of mal requires maven2 to build. - -``` -cd java -mvn compile -mvn -quiet exec:java -Dexec.mainClass=mal.stepX_YYY - # OR -mvn -quiet exec:java -Dexec.mainClass=mal.stepX_YYY -Dexec.args="CMDLINE_ARGS" -``` - -### JavaScript/Node - -``` -cd js -npm update -node stepX_YYY.js -``` - -### Julia - -The Julia implementation of mal requires Julia 0.4. - -``` -cd julia -julia stepX_YYY.jl -``` - -### Kotlin - -The Kotlin implementation of mal has been tested with Kotlin 1.0. - -``` -cd kotlin -make -java -jar stepX_YYY.jar -``` - -### LiveScript - -The LiveScript implementation of mal has been tested with LiveScript 1.5. - -``` -cd livescript -make -node_modules/.bin/lsc stepX_YYY.ls -``` - -### Logo - -The Logo implementation of mal has been tested with UCBLogo 6.0. - -``` -cd logo -logo stepX_YYY.lg -``` - -### Lua - -The Lua implementation of mal has been tested with Lua 5.2. The -implementation requires that luarocks and the lua-rex-pcre library -are installed. - -``` -cd lua -make # to build and link linenoise.so -./stepX_YYY.lua -``` - -### Mal - -Running the mal implementation of mal involves running stepA of one of -the other implementations and passing the mal step to run as a command -line argument. - -``` -cd IMPL -IMPL_STEPA_CMD ../mal/stepX_YYY.mal - -``` - -### GNU Make 3.81 - -``` -cd make -make -f stepX_YYY.mk -``` - -### NASM - -The NASM implementation of mal is written for x86-64 Linux, and has been tested -with Linux 3.16.0-4-amd64 and NASM version 2.11.05. - -``` -cd nasm -make -./stepX_YYY -``` - -### Nim 0.17.0 - -The Nim implementation of mal has been tested with Nim 0.17.0. - -``` -cd nim -make - # OR -nimble build -./stepX_YYY -``` - -### Object Pascal - -The Object Pascal implementation of mal has been built and tested on -Linux using the Free Pascal compiler version 2.6.2 and 2.6.4. - -``` -cd objpascal -make -./stepX_YYY -``` - -### Objective C - -The Objective C implementation of mal has been built and tested on -Linux using clang/LLVM 3.6. It has also been built and tested on OS -X using XCode 7. - -``` -cd objc -make -./stepX_YYY -``` - -### OCaml 4.01.0 - -``` -cd ocaml -make -./stepX_YYY -``` - -### MATLAB (GNU Octave and MATLAB) - -The MatLab implementation has been tested with GNU Octave 4.2.1. -It has also been tested with MATLAB version R2014a on Linux. Note that -MATLAB is a commercial product. - -``` -cd matlab -./stepX_YYY -octave -q --no-gui --no-history --eval "stepX_YYY();quit;" -matlab -nodisplay -nosplash -nodesktop -nojvm -r "stepX_YYY();quit;" - # OR with command line arguments -octave -q --no-gui --no-history --eval "stepX_YYY('arg1','arg2');quit;" -matlab -nodisplay -nosplash -nodesktop -nojvm -r "stepX_YYY('arg1','arg2');quit;" -``` - -### miniMAL - -[miniMAL](https://github.com/kanaka/miniMAL) is small Lisp interpreter -implemented in less than 1024 bytes of JavaScript. To run the miniMAL -implementation of mal you need to download/install the miniMAL -interpreter (which requires Node.js). -``` -cd miniMAL -# Download miniMAL and dependencies -npm install -export PATH=`pwd`/node_modules/minimal-lisp/:$PATH -# Now run mal implementation in miniMAL -miniMAL ./stepX_YYY -``` - -### Perl 5.8 - -For readline line editing support, install Term::ReadLine::Perl or -Term::ReadLine::Gnu from CPAN. - -``` -cd perl -perl stepX_YYY.pl -``` - -### Perl 6 - -The Perl 6 implementation was tested on Rakudo Perl 6 2016.04. - -``` -cd perl6 -perl6 stepX_YYY.pl -``` - -### PHP 5.3 - -The PHP implementation of mal requires the php command line interface -to run. - -``` -cd php -php stepX_YYY.php -``` - -### Picolisp - -The Picolisp implementation requires libreadline and Picolisp 3.1.11 -or later. - -``` -cd picolisp -./run -``` - -### PL/pgSQL (Postgres SQL Procedural Language) - -The PL/pgSQL implementation of mal requires a running Postgres server -(the "kanaka/mal-test-plpgsql" docker image automatically starts -a Postgres server). The implementation connects to the Postgres server -and create a database named "mal" to store tables and stored -procedures. The wrapper script uses the psql command to connect to the -server and defaults to the user "postgres" but this can be overridden -with the PSQL_USER environment variable. A password can be specified -using the PGPASSWORD environment variable. The implementation has been -tested with Postgres 9.4. - -``` -cd plpgsql -./wrap.sh stepX_YYY.sql - # OR -PSQL_USER=myuser PGPASSWORD=mypass ./wrap.sh stepX_YYY.sql -``` - -### PL/SQL (Oracle SQL Procedural Language) - -The PL/pgSQL implementation of mal requires a running Oracle DB -server (the "kanaka/mal-test-plsql" docker image automatically -starts an Oracle Express server). The implementation connects to the -Oracle server to create types, tables and stored procedures. The -default SQL*Plus logon value (username/password@connect_identifier) is -"system/oracle" but this can be overridden with the ORACLE_LOGON -environment variable. The implementation has been tested with Oracle -Express Edition 11g Release 2. Note that any SQL*Plus connection -warnings (user password expiration, etc) will interfere with the -ability of the wrapper script to communicate with the DB. - -``` -cd plsql -./wrap.sh stepX_YYY.sql - # OR -ORACLE_LOGON=myuser/mypass@ORCL ./wrap.sh stepX_YYY.sql -``` - -### Postscript Level 2/3 - -The Postscript implementation of mal requires ghostscript to run. It -has been tested with ghostscript 9.10. - -``` -cd ps -gs -q -dNODISPLAY -I./ stepX_YYY.ps -``` - -### PowerShell - -The PowerShell implementation of mal requires the PowerShell script -language. It has been tested with PowerShell 6.0.0 Alpha 9 on Linux. - -``` -cd powershell -powershell ./stepX_YYY.ps1 -``` - -### Python (2.X and 3.X) - -``` -cd python -python stepX_YYY.py -``` - -### RPython - -You must have [rpython](https://rpython.readthedocs.org/) on your path -(included with [pypy](https://bitbucket.org/pypy/pypy/)). - -``` -cd rpython -make # this takes a very long time -./stepX_YYY -``` - -### R - -The R implementation of mal requires R (r-base-core) to run. - -``` -cd r -make libs # to download and build rdyncall -Rscript stepX_YYY.r -``` - -### Racket (5.3) - -The Racket implementation of mal requires the Racket -compiler/interpreter to run. - -``` -cd racket -./stepX_YYY.rkt -``` - -### Rexx - -The Rexx implementation of mal has been tested with Regina Rexx 3.6. - -``` -cd rexx -make -rexx -a ./stepX_YYY.rexxpp -``` - -### Ruby (1.9+) - -``` -cd ruby -ruby stepX_YYY.rb -``` - -### Rust (1.0.0 nightly) - -The rust implementation of mal requires the rust compiler and build -tool (cargo) to build. - -``` -cd rust -cargo run --release --bin stepX_YYY -``` - -### Scala ### - -Install scala and sbt (http://www.scala-sbt.org/0.13/tutorial/Installing-sbt-on-Linux.html): - -``` -cd scala -sbt 'run-main stepX_YYY' - # OR -sbt compile -scala -classpath target/scala*/classes stepX_YYY -``` - -### Scheme (R7RS) ### - -The Scheme implementation of mal has been tested with Chibi-Scheme -0.7.3, Kawa 2.4, Gauche 0.9.5, CHICKEN 4.11.0, Sagittarius 0.8.3, -Cyclone 0.6.3 (Git version) and Foment 0.4 (Git version). You should -be able to get it running on other conforming R7RS implementations -after figuring out how libraries are loaded and adjusting the -`Makefile` and `run` script accordingly. - -``` -cd scheme -make symlinks -# chibi -scheme_MODE=chibi ./run -# kawa -make kawa -scheme_MODE=kawa ./run -# gauche -scheme_MODE=gauche ./run -# chicken -make chicken -scheme_MODE=chicken ./run -# sagittarius -scheme_MODE=sagittarius ./run -# cyclone -make cyclone -scheme_MODE=cyclone ./run -# foment -scheme_MODE=foment ./run -``` - -### Skew ### - -The Skew implementation of mal has been tested with Skew 0.7.42. - -``` -cd skew -make -node stepX_YYY.js -``` - - -### Swift - -The Swift implementation of mal requires the Swift 2.0 compiler (XCode -7.0) to build. Older versions will not work due to changes in the -language and standard library. - -``` -cd swift -make -./stepX_YYY -``` - -### Swift 3 - -The Swift 3 implementation of mal requires the Swift 3.0 compiler. It -has been tested with Swift 3 Preview 3. - -``` -cd swift3 -make -./stepX_YYY -``` - -### Swift 4 - -The Swift 4 implementation of mal requires the Swift 4.0 compiler. It -has been tested with Swift 4.2.3 release. - -``` -cd swift4 -make -./stepX_YYY -``` - -### Tcl 8.6 - -The Tcl implementation of mal requires Tcl 8.6 to run. For readline line -editing support, install tclreadline. - -``` -cd tcl -tclsh ./stepX_YYY.tcl -``` - -### TypeScript - -The TypeScript implementation of mal requires the TypeScript 2.2 compiler. -It has been tested with Node.js v6. - -``` -cd ts -make -node ./stepX_YYY.js -``` - -### VHDL - -The VHDL implementation of mal has been tested with GHDL 0.29. - -``` -cd vhdl -make -./run_vhdl.sh ./stepX_YYY -``` - -### Vimscript - -The Vimscript implementation of mal requires Vim 8.0 to run. - -``` -cd vimscript -./run_vimscript.sh ./stepX_YYY.vim -``` - -### Visual Basic.NET ### - -The VB.NET implementation of mal has been tested on Linux using the Mono -VB compiler (vbnc) and the Mono runtime (version 2.10.8.1). Both are -required to build and run the VB.NET implementation. - -``` -cd vb -make -mono ./stepX_YYY.exe -``` - -### WebAssembly (wasm) ### - -The WebAssembly implementation is written in -[Wam](https://github.com/kanaka/wam) (WebAssembly Macro language) and -runs under the [wac/wace](https://github.com/kanaka/wac) WebAssembly -runtime. - -``` -cd wasm -make -wace ./stepX_YYY.wasm -``` - -### Yorick - -The Yorick implementation of mal was tested on Yorick 2.2.04. - -``` -cd yorick -yorick -batch ./stepX_YYY.i -``` - - - -## Running tests - -The top level Makefile has a number of useful targets to assist with -implementation development and testing. The `help` target provides -a list of the targets and options: - -``` -make help -``` - -### Functional tests - -The are over 600 generic functional tests (for all implementations) -in the `tests/` directory. Each step has a corresponding test file -containing tests specific to that step. The `runtest.py` test harness -launches a Mal step implementation and then feeds the tests one at -a time to the implementation and compares the output/return value to -the expected output/return value. - -* To run all the tests across all implementations (be prepared to wait): - -``` -make test -``` - -* To run all tests against a single implementation: - -``` -make "test^IMPL" - -# e.g. -make "test^clojure" -make "test^js" -``` - -* To run tests for a single step against all implementations: - -``` -make "test^stepX" - -# e.g. -make "test^step2" -make "test^step7" -``` - -* To run tests for a specific step against a single implementation: - -``` -make "test^IMPL^stepX" - -# e.g -make "test^ruby^step3" -make "test^ps^step4" -``` - -### Self-hosted functional tests - -* To run the functional tests in self-hosted mode, you specify `mal` - as the test implementation and use the `MAL_IMPL` make variable - to change the underlying host language (default is JavaScript): -``` -make MAL_IMPL=IMPL "test^mal^step2" - -# e.g. -make "test^mal^step2" # js is default -make MAL_IMPL=ruby "test^mal^step2" -make MAL_IMPL=python "test^mal^step2" -``` - -### Starting the REPL - -* To start the REPL of an implementation in a specific step: - -``` -make "repl^IMPL^stepX" - -# e.g -make "repl^ruby^step3" -make "repl^ps^step4" -``` - -* If you omit the step, then `stepA` is used: - -``` -make "repl^IMPL" - -# e.g -make "repl^ruby" -make "repl^ps" -``` - -* To start the REPL of the self-hosted implementation, specify `mal` as the - REPL implementation and use the `MAL_IMPL` make variable to change the - underlying host language (default is JavaScript): -``` -make MAL_IMPL=IMPL "repl^mal^stepX" - -# e.g. -make "repl^mal^step2" # js is default -make MAL_IMPL=ruby "repl^mal^step2" -make MAL_IMPL=python "repl^mal" -``` - -### Performance tests - -Warning: These performance tests are neither statistically valid nor -comprehensive; runtime performance is a not a primary goal of mal. If -you draw any serious conclusions from these performance tests, then -please contact me about some amazing oceanfront property in Kansas -that I'm willing to sell you for cheap. - -* To run performance tests against a single implementation: -``` -make "perf^IMPL" - -# e.g. -make "perf^js" -``` - -* To run performance tests against all implementations: -``` -make "perf" -``` - -### Generating language statistics - -* To report line and byte statistics for a single implementation: -``` -make "stats^IMPL" - -# e.g. -make "stats^js" -``` - -* To report line and bytes statistics for general Lisp code (env, core - and stepA): -``` -make "stats-lisp^IMPL" - -# e.g. -make "stats-lisp^js" -``` - -## Dockerized testing - -Every implementation directory contains a Dockerfile to create -a docker image containing all the dependencies for that -implementation. In addition, the top-level Makefile contains support -for running the tests target (and perf, stats, repl, etc) within -a docker container for that implementation by passing *"DOCKERIZE=1"* -on the make command line. For example: - -``` -make DOCKERIZE=1 "test^js^step3" -``` - -Existing implementations already have docker images built and pushed -to the docker registry. However, if -you wish to build or rebuild a docker image locally, the toplevel -Makefile provides a rule for building docker images: - -``` -make "docker-build^IMPL" -``` - - -**Notes**: -* Docker images are named *"kanaka/mal-test-IMPL"* -* JVM-based language implementations (Groovy, Java, Clojure, Scala): - you will probably need to run this command once manually - first `make DOCKERIZE=1 "repl^IMPL"` before you can run tests because - runtime dependencies need to be downloaded to avoid the tests timing - out. These dependencies are downloaded to dot-files in the /mal - directory so they will persist between runs. - - -## External Implementations - -The following implementations are maintained as separate projects: - -### HolyC - -* [by Alexander Bagnalla](https://github.com/bagnalla/holyc_mal) - -### Rust - -* [by Tim Morgan](https://github.com/seven1m/mal-rust) -* [by vi](https://github.com/vi/mal-rust-vi) - using [Pest](https://pest.rs/) grammar, not using typical Mal infrastructure (cargo-ized steps and built-in converted tests). - - -## Other mal Projects - - * [malc](https://github.com/dubek/malc) - Mal (Make A Lisp) compiler. Compiles a Mal program to LLVM assembly language, then binary. - * [malcc](https://git.sr.ht/~tim/malcc) (@seven1m) - malcc is an incremental compiler implementation for the Mal language. It uses the Tiny C Compiler as the compiler backend and has full support for the Mal language, including macros, tail-call elimination, and even run-time eval. ["I Built a Lisp Compiler"](https://mpov.timmorgan.org/i-built-a-lisp-compiler/) post about the process. - * [frock](https://github.com/chr15m/frock) - Clojure-flavoured PHP. Uses mal/php to run programs. - -## License - -Mal (make-a-lisp) is licensed under the MPL 2.0 (Mozilla Public -License 2.0). See LICENSE.txt for more details. diff --git a/mal/core.mal b/mal/core.mal deleted file mode 100644 index 368805f..0000000 --- a/mal/core.mal +++ /dev/null @@ -1,87 +0,0 @@ -(def! inc (fn* (a) (+ a 1))) - -(def! dec (fn* (a) (- a 1))) - -(def! zero? (fn* (n) (= 0 n))) - -(def! reduce - (fn* (f init xs) - (if (> (count xs) 0) - (reduce f (f init (first xs)) (rest xs)) - init))) - -(def! identity (fn* (x) x)) - -(def! every? - (fn* (pred xs) - (if (> (count xs) 0) - (if (pred (first xs)) - (every? pred (rest xs)) - false) - true))) - -(def! not (fn* (x) (if x false true))) - -(def! some - (fn* (pred xs) - (if (> (count xs) 0) - (let* (res (pred (first xs))) - (if (pred (first xs)) - res - (some pred (rest xs)))) - nil))) - -(defmacro! and - (fn* (& xs) - (if (empty? xs) - true - (if (= 1 (count xs)) - (first xs) - (let* (condvar (gensym)) - `(let* (~condvar ~(first xs)) - (if ~condvar (and ~@(rest xs)) ~condvar))))))) - -(defmacro! or - (fn* (& xs) - (if (empty? xs) - nil - (if (= 1 (count xs)) - (first xs) - (let* (condvar (gensym)) - `(let* (~condvar ~(first xs)) - (if ~condvar ~condvar (or ~@(rest xs))))))))) - -(defmacro! cond - (fn* (& clauses) - (if (> (count clauses) 0) - (list 'if (first clauses) - (if (> (count clauses) 1) - (nth clauses 1) - (throw "cond requires an even number of forms")) - (cons 'cond (rest (rest clauses))))))) - -(defmacro! -> - (fn* (x & xs) - (if (empty? xs) - x - (let* (form (first xs) - more (rest xs)) - (if (empty? more) - (if (list? form) - `(~(first form) ~x ~@(rest form)) - (list form x)) - `(-> (-> ~x ~form) ~@more)))))) - -(defmacro! ->> - (fn* (x & xs) - (if (empty? xs) - x - (let* (form (first xs) - more (rest xs)) - (if (empty? more) - (if (list? form) - `(~(first form) ~@(rest form) ~x) - (list form x)) - `(->> (->> ~x ~form) ~@more)))))) - -nil diff --git a/mal/mal/Dockerfile b/mal/mal/Dockerfile deleted file mode 100644 index f7677e9..0000000 --- a/mal/mal/Dockerfile +++ /dev/null @@ -1,34 +0,0 @@ -FROM ubuntu:18.04 -MAINTAINER Joel Martin - -########################################################## -# General requirements for testing or common across many -# implementations -########################################################## - -RUN apt-get -y update - -# Required for running tests -RUN apt-get -y install make python - -# Some typical implementation and test requirements -RUN apt-get -y install curl libreadline-dev libedit-dev - -RUN mkdir -p /mal -WORKDIR /mal - -########################################################## -# Specific implementation requirements -########################################################## - -# For building node modules -RUN apt-get -y install g++ - -# Add nodesource apt repo config for 10.x stable -RUN apt-get -y install gnupg -RUN curl -sL https://deb.nodesource.com/setup_10.x | bash - - -# Install nodejs -RUN apt-get -y install nodejs - -ENV NPM_CONFIG_CACHE /mal/.npm diff --git a/mal/mal/Makefile b/mal/mal/Makefile deleted file mode 100644 index e54f29c..0000000 --- a/mal/mal/Makefile +++ /dev/null @@ -1,7 +0,0 @@ -all: mal.mal - -mal.mal: stepA_mal.mal - cp $< $@ - -clean: - rm -f mal.mal diff --git a/mal/mal/core.mal b/mal/mal/core.mal deleted file mode 100644 index 15bcac3..0000000 --- a/mal/mal/core.mal +++ /dev/null @@ -1,80 +0,0 @@ -(def! _fn? (fn* [x] - (if (fn? x) - (if (get (meta x) "ismacro") - false - true) - false))) - -(def! macro? (fn* [x] - (if (fn? x) - (if (get (meta x) "ismacro") - true - false) - false))) - -(def! core_ns - [["=" =] - ["throw" throw] - ["nil?" nil?] - ["true?" true?] - ["false?" false?] - ["number?" number?] - ["string?" string?] - ["symbol" symbol] - ["symbol?" symbol?] - ["keyword" keyword] - ["keyword?" keyword?] - ["fn?" _fn?] - ["macro?" macro?] - - ["pr-str" pr-str] - ["str" str] - ["prn" prn] - ["println" println] - ["readline" readline] - ["read-string" read-string] - ["slurp" slurp] - ["<" <] - ["<=" <=] - [">" >] - [">=" >=] - ["+" +] - ["-" -] - ["*" *] - ["/" /] - ["time-ms" time-ms] - - ["list" list] - ["list?" list?] - ["vector" vector] - ["vector?" vector?] - ["hash-map" hash-map] - ["map?" map?] - ["assoc" assoc] - ["dissoc" dissoc] - ["get" get] - ["contains?" contains?] - ["keys" keys] - ["vals" vals] - - ["sequential?" sequential?] - ["cons" cons] - ["concat" concat] - ["nth" nth] - ["first" first] - ["rest" rest] - ["empty?" empty?] - ["count" count] - ["apply" apply] - ["map" map] - - ["conj" conj] - ["seq" seq] - - ["with-meta" with-meta] - ["meta" meta] - ["atom" atom] - ["atom?" atom?] - ["deref" deref] - ["reset!" reset!] - ["swap!" swap!]]) diff --git a/mal/mal/env.mal b/mal/mal/env.mal deleted file mode 100644 index 40937c5..0000000 --- a/mal/mal/env.mal +++ /dev/null @@ -1,40 +0,0 @@ -;; env - -(def! bind-env (fn* [env b e] - (if (empty? b) - env - - (if (= "&" (str (first b))) - (assoc env (str (nth b 1)) e) - - (bind-env (assoc env (str (first b)) (first e)) - (rest b) (rest e)))))) - -(def! new-env (fn* [& args] - (if (<= (count args) 1) - (atom {"--outer--" (first args)}) - (atom (bind-env {"--outer--" (first args)} - (nth args 1) (nth args 2)))))) - -(def! env-find (fn* [env k] - (let* [ks (str k) - data @env] - (if (contains? data ks) - env - (if (get data "--outer--") - (env-find (get data "--outer--") ks) - nil))))) - -(def! env-get (fn* [env k] - (let* [ks (str k) - e (env-find env ks)] - (if e - (get @e ks) - (throw (str "'" ks "' not found")))))) - -(def! env-set (fn* [env k v] - (do - (swap! env assoc (str k) v) - v))) - -;;(prn "loaded env.mal") diff --git a/mal/mal/run b/mal/mal/run deleted file mode 100755 index a6f4bfe..0000000 --- a/mal/mal/run +++ /dev/null @@ -1,5 +0,0 @@ -#!/bin/bash -cd $(dirname $0) -MAL_FILE=./../mal/${STEP:-stepA_mal}.mal -export STEP=stepA_mal # force MAL_IMPL to use stepA -exec ./../${MAL_IMPL:-js}/run ${MAL_FILE} "${@}" diff --git a/mal/mal/step0_repl.mal b/mal/mal/step0_repl.mal deleted file mode 100644 index 723c83c..0000000 --- a/mal/mal/step0_repl.mal +++ /dev/null @@ -1,30 +0,0 @@ -;; read -(def! READ (fn* [strng] - strng)) - -;; eval -(def! EVAL (fn* [ast env] - ast)) - -;; print -(def! PRINT (fn* [exp] exp)) - -;; repl -(def! rep (fn* [strng] - (PRINT (EVAL (READ strng) {})))) - -;; repl loop -(def! repl-loop (fn* [] - (let* [line (readline "mal-user> ")] - (if line - (do - (if (not (= "" line)) - (try* - (println (rep line)) - (catch* exc - (println "Uncaught exception:" exc)))) - (repl-loop)))))) - -(def! -main (fn* [& args] - (repl-loop))) -(-main) diff --git a/mal/mal/step1_read_print.mal b/mal/mal/step1_read_print.mal deleted file mode 100644 index 991a745..0000000 --- a/mal/mal/step1_read_print.mal +++ /dev/null @@ -1,30 +0,0 @@ -;; read -(def! READ (fn* [strng] - (read-string strng))) - -;; eval -(def! EVAL (fn* [ast env] - ast)) - -;; print -(def! PRINT (fn* [exp] (pr-str exp))) - -;; repl -(def! rep (fn* [strng] - (PRINT (EVAL (READ strng) {})))) - -;; repl loop -(def! repl-loop (fn* [] - (let* [line (readline "mal-user> ")] - (if line - (do - (if (not (= "" line)) - (try* - (println (rep line)) - (catch* exc - (println "Uncaught exception:" exc)))) - (repl-loop)))))) - -(def! -main (fn* [& args] - (repl-loop))) -(-main) diff --git a/mal/mal/step2_eval.mal b/mal/mal/step2_eval.mal deleted file mode 100644 index 499ff94..0000000 --- a/mal/mal/step2_eval.mal +++ /dev/null @@ -1,64 +0,0 @@ -;; read -(def! READ (fn* [strng] - (read-string strng))) - - -;; eval -(def! eval-ast (fn* [ast env] (do - ;;(do (prn "eval-ast" ast "/" (keys env)) ) - (cond - (symbol? ast) (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) (apply vector (map (fn* [exp] (EVAL exp env)) ast)) - - (map? ast) (apply hash-map - (apply concat - (map (fn* [k] [k (EVAL (get ast k) env)]) - (keys ast)))) - - "else" ast)))) - - -(def! EVAL (fn* [ast env] (do - ;;(do (prn "EVAL" ast "/" (keys @env)) ) - (if (not (list? ast)) - (eval-ast ast env) - - ;; apply list - (if (empty? ast) - ast - (let* [el (eval-ast ast env) - f (first el) - args (rest el)] - (apply f args))))))) - - -;; print -(def! PRINT (fn* [exp] (pr-str exp))) - -;; repl -(def! repl-env {"+" + - "-" - - "*" * - "/" /}) -(def! rep (fn* [strng] - (PRINT (EVAL (READ strng) repl-env)))) - -;; repl loop -(def! repl-loop (fn* [] - (let* [line (readline "mal-user> ")] - (if line - (do - (if (not (= "" line)) - (try* - (println (rep line)) - (catch* exc - (println "Uncaught exception:" exc)))) - (repl-loop)))))) - -(def! -main (fn* [& args] - (repl-loop))) -(-main) diff --git a/mal/mal/step3_env.mal b/mal/mal/step3_env.mal deleted file mode 100644 index 985e644..0000000 --- a/mal/mal/step3_env.mal +++ /dev/null @@ -1,85 +0,0 @@ -(load-file "../mal/env.mal") - -;; read -(def! READ (fn* [strng] - (read-string strng))) - - -;; eval -(def! eval-ast (fn* [ast env] (do - ;;(do (prn "eval-ast" ast "/" (keys env)) ) - (cond - (symbol? ast) (env-get env ast) - - (list? ast) (map (fn* [exp] (EVAL exp env)) ast) - - (vector? ast) (apply vector (map (fn* [exp] (EVAL exp env)) ast)) - - (map? ast) (apply hash-map - (apply concat - (map (fn* [k] [k (EVAL (get ast k) env)]) - (keys ast)))) - - "else" ast)))) - -(def! LET (fn* [env args] - (if (> (count args) 0) - (do - (env-set env (nth args 0) (EVAL (nth args 1) env)) - (LET env (rest (rest args))))))) - -(def! EVAL (fn* [ast env] (do - ;;(do (prn "EVAL" ast "/" (keys @env)) ) - (if (not (list? ast)) - (eval-ast ast env) - - ;; apply list - (let* [a0 (first ast)] - (cond - (nil? a0) - ast - - (= 'def! a0) - (env-set env (nth ast 1) (EVAL (nth ast 2) env)) - - (= 'let* a0) - (let* [let-env (new-env env)] - (do - (LET let-env (nth ast 1)) - (EVAL (nth ast 2) let-env))) - - "else" - (let* [el (eval-ast ast env) - f (first el) - args (rest el)] - (apply f args)))))))) - - -;; print -(def! PRINT (fn* [exp] (pr-str exp))) - -;; repl -(def! repl-env (new-env)) -(def! rep (fn* [strng] - (PRINT (EVAL (READ strng) repl-env)))) - -(env-set repl-env "+" +) -(env-set repl-env "-" -) -(env-set repl-env "*" *) -(env-set repl-env "/" /) - -;; repl loop -(def! repl-loop (fn* [] - (let* [line (readline "mal-user> ")] - (if line - (do - (if (not (= "" line)) - (try* - (println (rep line)) - (catch* exc - (println "Uncaught exception:" exc)))) - (repl-loop)))))) - -(def! -main (fn* [& args] - (repl-loop))) -(-main) diff --git a/mal/mal/step4_if_fn_do.mal b/mal/mal/step4_if_fn_do.mal deleted file mode 100644 index b72cd83..0000000 --- a/mal/mal/step4_if_fn_do.mal +++ /dev/null @@ -1,103 +0,0 @@ -(load-file "../mal/env.mal") -(load-file "../mal/core.mal") - -;; read -(def! READ (fn* [strng] - (read-string strng))) - - -;; eval -(def! eval-ast (fn* [ast env] (do - ;;(do (prn "eval-ast" ast "/" (keys env)) ) - (cond - (symbol? ast) (env-get env ast) - - (list? ast) (map (fn* [exp] (EVAL exp env)) ast) - - (vector? ast) (apply vector (map (fn* [exp] (EVAL exp env)) ast)) - - (map? ast) (apply hash-map - (apply concat - (map (fn* [k] [k (EVAL (get ast k) env)]) - (keys ast)))) - - "else" ast)))) - -(def! LET (fn* [env args] - (if (> (count args) 0) - (do - (env-set env (nth args 0) (EVAL (nth args 1) env)) - (LET env (rest (rest args))))))) - -(def! EVAL (fn* [ast env] (do - ;;(do (prn "EVAL" ast "/" (keys @env)) ) - (if (not (list? ast)) - (eval-ast ast env) - - ;; apply list - (let* [a0 (first ast)] - (cond - (nil? a0) - ast - - (= 'def! a0) - (env-set env (nth ast 1) (EVAL (nth ast 2) env)) - - (= 'let* a0) - (let* [let-env (new-env env)] - (do - (LET let-env (nth ast 1)) - (EVAL (nth ast 2) let-env))) - - (= 'do a0) - (let* [el (eval-ast (rest ast) env)] - (nth el (- (count el) 1))) - - (= 'if a0) - (let* [cond (EVAL (nth ast 1) env)] - (if (or (= cond nil) (= cond false)) - (if (> (count ast) 3) - (EVAL (nth ast 3) env) - nil) - (EVAL (nth ast 2) env))) - - (= 'fn* a0) - (fn* [& args] - (EVAL (nth ast 2) (new-env env (nth ast 1) args))) - - "else" - (let* [el (eval-ast ast env) - f (first el) - args (rest el)] - (apply f args)))))))) - - -;; print -(def! PRINT (fn* [exp] (pr-str exp))) - -;; repl -(def! repl-env (new-env)) -(def! rep (fn* [strng] - (PRINT (EVAL (READ strng) repl-env)))) - -;; core.mal: defined directly using mal -(map (fn* [data] (env-set repl-env (nth data 0) (nth data 1))) core_ns) - -;; core.mal: defined using the new language itself -(rep "(def! not (fn* [a] (if a false true)))") - -;; repl loop -(def! repl-loop (fn* [] - (let* [line (readline "mal-user> ")] - (if line - (do - (if (not (= "" line)) - (try* - (println (rep line)) - (catch* exc - (println "Uncaught exception:" exc)))) - (repl-loop)))))) - -(def! -main (fn* [& args] - (repl-loop))) -(-main) diff --git a/mal/mal/step6_file.mal b/mal/mal/step6_file.mal deleted file mode 100644 index 23df09a..0000000 --- a/mal/mal/step6_file.mal +++ /dev/null @@ -1,108 +0,0 @@ -(load-file "../mal/env.mal") -(load-file "../mal/core.mal") - -;; read -(def! READ (fn* [strng] - (read-string strng))) - - -;; eval -(def! eval-ast (fn* [ast env] (do - ;;(do (prn "eval-ast" ast "/" (keys env)) ) - (cond - (symbol? ast) (env-get env ast) - - (list? ast) (map (fn* [exp] (EVAL exp env)) ast) - - (vector? ast) (apply vector (map (fn* [exp] (EVAL exp env)) ast)) - - (map? ast) (apply hash-map - (apply concat - (map (fn* [k] [k (EVAL (get ast k) env)]) - (keys ast)))) - - "else" ast)))) - -(def! LET (fn* [env args] - (if (> (count args) 0) - (do - (env-set env (nth args 0) (EVAL (nth args 1) env)) - (LET env (rest (rest args))))))) - -(def! EVAL (fn* [ast env] (do - ;;(do (prn "EVAL" ast "/" (keys @env)) ) - (if (not (list? ast)) - (eval-ast ast env) - - ;; apply list - (let* [a0 (first ast)] - (cond - (nil? a0) - ast - - (= 'def! a0) - (env-set env (nth ast 1) (EVAL (nth ast 2) env)) - - (= 'let* a0) - (let* [let-env (new-env env)] - (do - (LET let-env (nth ast 1)) - (EVAL (nth ast 2) let-env))) - - (= 'do a0) - (let* [el (eval-ast (rest ast) env)] - (nth el (- (count el) 1))) - - (= 'if a0) - (let* [cond (EVAL (nth ast 1) env)] - (if (or (= cond nil) (= cond false)) - (if (> (count ast) 3) - (EVAL (nth ast 3) env) - nil) - (EVAL (nth ast 2) env))) - - (= 'fn* a0) - (fn* [& args] - (EVAL (nth ast 2) (new-env env (nth ast 1) args))) - - "else" - (let* [el (eval-ast ast env) - f (first el) - args (rest el)] - (apply f args)))))))) - - -;; print -(def! PRINT (fn* [exp] (pr-str exp))) - -;; repl -(def! repl-env (new-env)) -(def! rep (fn* [strng] - (PRINT (EVAL (READ strng) repl-env)))) - -;; core.mal: defined directly using mal -(map (fn* [data] (env-set repl-env (nth data 0) (nth data 1))) core_ns) -(env-set repl-env 'eval (fn* [ast] (EVAL ast repl-env))) -(env-set repl-env '*ARGV* (rest *ARGV*)) - -;; core.mal: defined using the new language itself -(rep "(def! not (fn* [a] (if a false true)))") -(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") - -;; repl loop -(def! repl-loop (fn* [] - (let* [line (readline "mal-user> ")] - (if line - (do - (if (not (= "" line)) - (try* - (println (rep line)) - (catch* exc - (println "Uncaught exception:" exc)))) - (repl-loop)))))) - -(def! -main (fn* [& args] - (if (> (count args) 0) - (rep (str "(load-file \"" (first args) "\")")) - (repl-loop)))) -(apply -main *ARGV*) diff --git a/mal/mal/step7_quote.mal b/mal/mal/step7_quote.mal deleted file mode 100644 index 85a7423..0000000 --- a/mal/mal/step7_quote.mal +++ /dev/null @@ -1,136 +0,0 @@ -(load-file "../mal/env.mal") -(load-file "../mal/core.mal") - -;; read -(def! READ (fn* [strng] - (read-string strng))) - - -;; eval -(def! is-pair (fn* [x] - (if (sequential? x) - (if (> (count x) 0) - true)))) - -(def! QUASIQUOTE (fn* [ast] - (cond - (not (is-pair ast)) - (list 'quote ast) - - (= 'unquote (first ast)) - (nth ast 1) - - (if (is-pair (first ast)) - (if (= 'splice-unquote (first (first ast))) - true)) - (list 'concat (nth (first ast) 1) (QUASIQUOTE (rest ast))) - - "else" - (list 'cons (QUASIQUOTE (first ast)) (QUASIQUOTE (rest ast)))))) - -(def! eval-ast (fn* [ast env] (do - ;;(do (prn "eval-ast" ast "/" (keys env)) ) - (cond - (symbol? ast) (env-get env ast) - - (list? ast) (map (fn* [exp] (EVAL exp env)) ast) - - (vector? ast) (apply vector (map (fn* [exp] (EVAL exp env)) ast)) - - (map? ast) (apply hash-map - (apply concat - (map (fn* [k] [k (EVAL (get ast k) env)]) - (keys ast)))) - - "else" ast)))) - -(def! LET (fn* [env args] - (if (> (count args) 0) - (do - (env-set env (nth args 0) (EVAL (nth args 1) env)) - (LET env (rest (rest args))))))) - -(def! EVAL (fn* [ast env] (do - ;;(do (prn "EVAL" ast "/" (keys @env)) ) - (if (not (list? ast)) - (eval-ast ast env) - - ;; apply list - (let* [a0 (first ast)] - (cond - (nil? a0) - ast - - (= 'def! a0) - (env-set env (nth ast 1) (EVAL (nth ast 2) env)) - - (= 'let* a0) - (let* [let-env (new-env env)] - (do - (LET let-env (nth ast 1)) - (EVAL (nth ast 2) let-env))) - - (= 'quote a0) - (nth ast 1) - - (= 'quasiquote a0) - (let* [a1 (nth ast 1)] - (EVAL (QUASIQUOTE a1) env)) - - (= 'do a0) - (let* [el (eval-ast (rest ast) env)] - (nth el (- (count el) 1))) - - (= 'if a0) - (let* [cond (EVAL (nth ast 1) env)] - (if (or (= cond nil) (= cond false)) - (if (> (count ast) 3) - (EVAL (nth ast 3) env) - nil) - (EVAL (nth ast 2) env))) - - (= 'fn* a0) - (fn* [& args] - (EVAL (nth ast 2) (new-env env (nth ast 1) args))) - - "else" - (let* [el (eval-ast ast env) - f (first el) - args (rest el)] - (apply f args)))))))) - - -;; print -(def! PRINT (fn* [exp] (pr-str exp))) - -;; repl -(def! repl-env (new-env)) -(def! rep (fn* [strng] - (PRINT (EVAL (READ strng) repl-env)))) - -;; core.mal: defined directly using mal -(map (fn* [data] (env-set repl-env (nth data 0) (nth data 1))) core_ns) -(env-set repl-env 'eval (fn* [ast] (EVAL ast repl-env))) -(env-set repl-env '*ARGV* (rest *ARGV*)) - -;; core.mal: defined using the new language itself -(rep "(def! not (fn* [a] (if a false true)))") -(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") - -;; repl loop -(def! repl-loop (fn* [] - (let* [line (readline "mal-user> ")] - (if line - (do - (if (not (= "" line)) - (try* - (println (rep line)) - (catch* exc - (println "Uncaught exception:" exc)))) - (repl-loop)))))) - -(def! -main (fn* [& args] - (if (> (count args) 0) - (rep (str "(load-file \"" (first args) "\")")) - (repl-loop)))) -(apply -main *ARGV*) diff --git a/mal/mal/step8_macros.mal b/mal/mal/step8_macros.mal deleted file mode 100644 index ece64b7..0000000 --- a/mal/mal/step8_macros.mal +++ /dev/null @@ -1,170 +0,0 @@ -(load-file "../mal/env.mal") -(load-file "../mal/core.mal") - -;; read -(def! READ (fn* [strng] - (read-string strng))) - - -;; eval -(def! is-pair (fn* [x] - (if (sequential? x) - (if (> (count x) 0) - true)))) - -(def! QUASIQUOTE (fn* [ast] - (cond - (not (is-pair ast)) - (list 'quote ast) - - (= 'unquote (first ast)) - (nth ast 1) - - (if (is-pair (first ast)) - (if (= 'splice-unquote (first (first ast))) - true)) - (list 'concat (nth (first ast) 1) (QUASIQUOTE (rest ast))) - - "else" - (list 'cons (QUASIQUOTE (first ast)) (QUASIQUOTE (rest ast)))))) - -(def! is-macro-call (fn* [ast env] - (if (list? ast) - (let* [a0 (first ast)] - (if (symbol? a0) - (if (env-find env a0) - (let* [m (meta (env-get env a0))] - (if m - (if (get m "ismacro") - true))))))))) - -(def! MACROEXPAND (fn* [ast env] - (if (is-macro-call ast env) - (let* [mac (env-get env (first ast))] - (MACROEXPAND (apply mac (rest ast)) env)) - ast))) - -(def! eval-ast (fn* [ast env] (do - ;;(do (prn "eval-ast" ast "/" (keys env)) ) - (cond - (symbol? ast) (env-get env ast) - - (list? ast) (map (fn* [exp] (EVAL exp env)) ast) - - (vector? ast) (apply vector (map (fn* [exp] (EVAL exp env)) ast)) - - (map? ast) (apply hash-map - (apply concat - (map (fn* [k] [k (EVAL (get ast k) env)]) - (keys ast)))) - - "else" ast)))) - -(def! LET (fn* [env args] - (if (> (count args) 0) - (do - (env-set env (nth args 0) (EVAL (nth args 1) env)) - (LET env (rest (rest args))))))) - -(def! EVAL (fn* [ast env] (do - ;;(do (prn "EVAL" ast "/" (keys @env)) ) - (if (not (list? ast)) - (eval-ast ast env) - - ;; apply list - (let* [ast (MACROEXPAND ast env)] - (if (not (list? ast)) - (eval-ast ast env) - - (let* [a0 (first ast)] - (cond - (nil? a0) - ast - - (= 'def! a0) - (env-set env (nth ast 1) (EVAL (nth ast 2) env)) - - (= 'let* a0) - (let* [let-env (new-env env)] - (do - (LET let-env (nth ast 1)) - (EVAL (nth ast 2) let-env))) - - (= 'quote a0) - (nth ast 1) - - (= 'quasiquote a0) - (let* [a1 (nth ast 1)] - (EVAL (QUASIQUOTE a1) env)) - - (= 'defmacro! a0) - (let* [a1 (nth ast 1) - a2 (nth ast 2) - f (EVAL a2 env) - m (or (meta f) {}) - mac (with-meta f (assoc m "ismacro" true))] - (env-set env a1 mac)) - - (= 'macroexpand a0) - (let* [a1 (nth ast 1)] - (MACROEXPAND a1 env)) - - (= 'do a0) - (let* [el (eval-ast (rest ast) env)] - (nth el (- (count el) 1))) - - (= 'if a0) - (let* [cond (EVAL (nth ast 1) env)] - (if (or (= cond nil) (= cond false)) - (if (> (count ast) 3) - (EVAL (nth ast 3) env) - nil) - (EVAL (nth ast 2) env))) - - (= 'fn* a0) - (fn* [& args] - (EVAL (nth ast 2) (new-env env (nth ast 1) args))) - - "else" - (let* [el (eval-ast ast env) - f (first el) - args (rest el)] - (apply f args)))))))))) - - -;; print -(def! PRINT (fn* [exp] (pr-str exp))) - -;; repl -(def! repl-env (new-env)) -(def! rep (fn* [strng] - (PRINT (EVAL (READ strng) repl-env)))) - -;; core.mal: defined directly using mal -(map (fn* [data] (env-set repl-env (nth data 0) (nth data 1))) core_ns) -(env-set repl-env 'eval (fn* [ast] (EVAL ast repl-env))) -(env-set repl-env '*ARGV* (rest *ARGV*)) - -;; core.mal: defined using the new language itself -(rep "(def! not (fn* [a] (if a false true)))") -(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") -(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") -(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") - -;; repl loop -(def! repl-loop (fn* [] - (let* [line (readline "mal-user> ")] - (if line - (do - (if (not (= "" line)) - (try* - (println (rep line)) - (catch* exc - (println "Uncaught exception:" exc)))) - (repl-loop)))))) - -(def! -main (fn* [& args] - (if (> (count args) 0) - (rep (str "(load-file \"" (first args) "\")")) - (repl-loop)))) -(apply -main *ARGV*) diff --git a/mal/mal/step9_try.mal b/mal/mal/step9_try.mal deleted file mode 100644 index 2975a50..0000000 --- a/mal/mal/step9_try.mal +++ /dev/null @@ -1,182 +0,0 @@ -(load-file "../mal/env.mal") -(load-file "../mal/core.mal") - -;; read -(def! READ (fn* [strng] - (read-string strng))) - - -;; eval -(def! is-pair (fn* [x] - (if (sequential? x) - (if (> (count x) 0) - true)))) - -(def! QUASIQUOTE (fn* [ast] - (cond - (not (is-pair ast)) - (list 'quote ast) - - (= 'unquote (first ast)) - (nth ast 1) - - (if (is-pair (first ast)) - (if (= 'splice-unquote (first (first ast))) - true)) - (list 'concat (nth (first ast) 1) (QUASIQUOTE (rest ast))) - - "else" - (list 'cons (QUASIQUOTE (first ast)) (QUASIQUOTE (rest ast)))))) - -(def! is-macro-call (fn* [ast env] - (if (list? ast) - (let* [a0 (first ast)] - (if (symbol? a0) - (if (env-find env a0) - (let* [m (meta (env-get env a0))] - (if m - (if (get m "ismacro") - true))))))))) - -(def! MACROEXPAND (fn* [ast env] - (if (is-macro-call ast env) - (let* [mac (env-get env (first ast))] - (MACROEXPAND (apply mac (rest ast)) env)) - ast))) - -(def! eval-ast (fn* [ast env] (do - ;;(do (prn "eval-ast" ast "/" (keys env)) ) - (cond - (symbol? ast) (env-get env ast) - - (list? ast) (map (fn* [exp] (EVAL exp env)) ast) - - (vector? ast) (apply vector (map (fn* [exp] (EVAL exp env)) ast)) - - (map? ast) (apply hash-map - (apply concat - (map (fn* [k] [k (EVAL (get ast k) env)]) - (keys ast)))) - - "else" ast)))) - -(def! LET (fn* [env args] - (if (> (count args) 0) - (do - (env-set env (nth args 0) (EVAL (nth args 1) env)) - (LET env (rest (rest args))))))) - -(def! EVAL (fn* [ast env] (do - ;;(do (prn "EVAL" ast "/" (keys @env)) ) - (if (not (list? ast)) - (eval-ast ast env) - - ;; apply list - (let* [ast (MACROEXPAND ast env)] - (if (not (list? ast)) - (eval-ast ast env) - - (let* [a0 (first ast)] - (cond - (nil? a0) - ast - - (= 'def! a0) - (env-set env (nth ast 1) (EVAL (nth ast 2) env)) - - (= 'let* a0) - (let* [let-env (new-env env)] - (do - (LET let-env (nth ast 1)) - (EVAL (nth ast 2) let-env))) - - (= 'quote a0) - (nth ast 1) - - (= 'quasiquote a0) - (let* [a1 (nth ast 1)] - (EVAL (QUASIQUOTE a1) env)) - - (= 'defmacro! a0) - (let* [a1 (nth ast 1) - a2 (nth ast 2) - f (EVAL a2 env) - m (or (meta f) {}) - mac (with-meta f (assoc m "ismacro" true))] - (env-set env a1 mac)) - - (= 'macroexpand a0) - (let* [a1 (nth ast 1)] - (MACROEXPAND a1 env)) - - (= 'try* a0) - (if (or (< (count ast) 3) - (not (= 'catch* (nth (nth ast 2) 0)))) - (EVAL (nth ast 1) env) - (try* - (EVAL (nth ast 1) env) - (catch* exc - (EVAL (nth (nth ast 2) 2) - (new-env env - [(nth (nth ast 2)1)] - [exc]))))) - - (= 'do a0) - (let* [el (eval-ast (rest ast) env)] - (nth el (- (count el) 1))) - - (= 'if a0) - (let* [cond (EVAL (nth ast 1) env)] - (if (or (= cond nil) (= cond false)) - (if (> (count ast) 3) - (EVAL (nth ast 3) env) - nil) - (EVAL (nth ast 2) env))) - - (= 'fn* a0) - (fn* [& args] - (EVAL (nth ast 2) (new-env env (nth ast 1) args))) - - "else" - (let* [el (eval-ast ast env) - f (first el) - args (rest el)] - (apply f args)))))))))) - - -;; print -(def! PRINT (fn* [exp] (pr-str exp))) - -;; repl -(def! repl-env (new-env)) -(def! rep (fn* [strng] - (PRINT (EVAL (READ strng) repl-env)))) - -;; core.mal: defined directly using mal -(map (fn* [data] (env-set repl-env (nth data 0) (nth data 1))) core_ns) -(env-set repl-env 'eval (fn* [ast] (EVAL ast repl-env))) -(env-set repl-env '*ARGV* (rest *ARGV*)) - -;; core.mal: defined using the new language itself -(rep "(def! not (fn* [a] (if a false true)))") -(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") -(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") -(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") - -;; repl loop -(def! repl-loop (fn* [] - (let* [line (readline "mal-user> ")] - (if line - (do - (if (not (= "" line)) - (try* - (println (rep line)) - (catch* exc - (println "Uncaught exception:" exc)))) - (repl-loop)))))) - -(def! -main (fn* [& args] - (if (> (count args) 0) - (rep (str "(load-file \"" (first args) "\")")) - (repl-loop)))) -(apply -main *ARGV*) diff --git a/mal/mal/stepA_mal.mal b/mal/mal/stepA_mal.mal deleted file mode 100644 index 9f0af0e..0000000 --- a/mal/mal/stepA_mal.mal +++ /dev/null @@ -1,187 +0,0 @@ -(load-file "../mal/env.mal") -(load-file "../mal/core.mal") - -;; read -(def! READ (fn* [strng] - (read-string strng))) - - -;; eval -(def! is-pair (fn* [x] - (if (sequential? x) - (if (> (count x) 0) - true)))) - -(def! QUASIQUOTE (fn* [ast] - (cond - (not (is-pair ast)) - (list 'quote ast) - - (= 'unquote (first ast)) - (nth ast 1) - - (if (is-pair (first ast)) - (if (= 'splice-unquote (first (first ast))) - true)) - (list 'concat (nth (first ast) 1) (QUASIQUOTE (rest ast))) - - "else" - (list 'cons (QUASIQUOTE (first ast)) (QUASIQUOTE (rest ast)))))) - -(def! is-macro-call (fn* [ast env] - (if (list? ast) - (let* [a0 (first ast)] - (if (symbol? a0) - (if (env-find env a0) - (let* [m (meta (env-get env a0))] - (if m - (if (get m "ismacro") - true))))))))) - -(def! MACROEXPAND (fn* [ast env] - (if (is-macro-call ast env) - (let* [mac (env-get env (first ast))] - (MACROEXPAND (apply mac (rest ast)) env)) - ast))) - -(def! eval-ast (fn* [ast env] (do - ;;(do (prn "eval-ast" ast "/" (keys env)) ) - (cond - (symbol? ast) (env-get env ast) - - (list? ast) (map (fn* [exp] (EVAL exp env)) ast) - - (vector? ast) (apply vector (map (fn* [exp] (EVAL exp env)) ast)) - - (map? ast) (apply hash-map - (apply concat - (map (fn* [k] [k (EVAL (get ast k) env)]) - (keys ast)))) - - "else" ast)))) - -(def! LET (fn* [env args] - (if (> (count args) 0) - (do - (env-set env (nth args 0) (EVAL (nth args 1) env)) - (LET env (rest (rest args))))))) - -(def! EVAL (fn* [ast env] (do - ;;(do (prn "EVAL" ast "/" (keys @env)) ) - (if (not (list? ast)) - (eval-ast ast env) - - ;; apply list - (let* [ast (MACROEXPAND ast env)] - (if (not (list? ast)) - (eval-ast ast env) - - (let* [a0 (first ast)] - (cond - (nil? a0) - ast - - (= 'def! a0) - (env-set env (nth ast 1) (EVAL (nth ast 2) env)) - - (= 'let* a0) - (let* [let-env (new-env env)] - (do - (LET let-env (nth ast 1)) - (EVAL (nth ast 2) let-env))) - - (= 'quote a0) - (nth ast 1) - - (= 'quasiquote a0) - (let* [a1 (nth ast 1)] - (EVAL (QUASIQUOTE a1) env)) - - (= 'defmacro! a0) - (let* [a1 (nth ast 1) - a2 (nth ast 2) - f (EVAL a2 env) - m (or (meta f) {}) - mac (with-meta f (assoc m "ismacro" true))] - (env-set env a1 mac)) - - (= 'macroexpand a0) - (let* [a1 (nth ast 1)] - (MACROEXPAND a1 env)) - - (= 'try* a0) - (if (or (< (count ast) 3) - (not (= 'catch* (nth (nth ast 2) 0)))) - (EVAL (nth ast 1) env) - (try* - (EVAL (nth ast 1) env) - (catch* exc - (EVAL (nth (nth ast 2) 2) - (new-env env - [(nth (nth ast 2)1)] - [exc]))))) - - (= 'do a0) - (let* [el (eval-ast (rest ast) env)] - (nth el (- (count el) 1))) - - (= 'if a0) - (let* [cond (EVAL (nth ast 1) env)] - (if (or (= cond nil) (= cond false)) - (if (> (count ast) 3) - (EVAL (nth ast 3) env) - nil) - (EVAL (nth ast 2) env))) - - (= 'fn* a0) - (fn* [& args] - (EVAL (nth ast 2) (new-env env (nth ast 1) args))) - - "else" - (let* [el (eval-ast ast env) - f (first el) - args (rest el)] - (apply f args)))))))))) - - -;; print -(def! PRINT (fn* [exp] (pr-str exp))) - -;; repl -(def! repl-env (new-env)) -(def! rep (fn* [strng] - (PRINT (EVAL (READ strng) repl-env)))) - -;; core.mal: defined directly using mal -(map (fn* [data] (env-set repl-env (nth data 0) (nth data 1))) core_ns) -(env-set repl-env 'eval (fn* [ast] (EVAL ast repl-env))) -(env-set repl-env '*ARGV* (rest *ARGV*)) - -;; core.mal: defined using the new language itself -(rep (str "(def! *host-language* \"" *host-language* "-mal\")")) -(rep "(def! not (fn* [a] (if a false true)))") -(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") -(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") -(rep "(def! *gensym-counter* (atom 0))") -(rep "(def! gensym (fn* [] (symbol (str \"G__\" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))") -(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))") - -;; repl loop -(def! repl-loop (fn* [] - (let* [line (readline "mal-user> ")] - (if line - (do - (if (not (= "" line)) - (try* - (println (rep line)) - (catch* exc - (println "Uncaught exception:" exc)))) - (repl-loop)))))) - -(def! -main (fn* [& args] - (if (> (count args) 0) - (rep (str "(load-file \"" (first args) "\")")) - (do - (rep "(println (str \"Mal [\" *host-language* \"]\"))") - (repl-loop))))) -(apply -main *ARGV*) diff --git a/mal/perf.mal b/mal/perf.mal deleted file mode 100644 index 55f9409..0000000 --- a/mal/perf.mal +++ /dev/null @@ -1,27 +0,0 @@ -(defmacro! time - (fn* (exp) - `(let* (start_FIXME (time-ms) - ret_FIXME ~exp) - (do - (prn (str "Elapsed time: " (- (time-ms) start_FIXME) " msecs")) - ret_FIXME)))) - -(def! run-fn-for* - (fn* [fn max-ms acc-ms last-iters] - (let* [start (time-ms) - _ (fn) - elapsed (- (time-ms) start) - iters (+ 1 last-iters) - new-acc-ms (+ acc-ms elapsed)] - ;(do (prn "new-acc-ms:" new-acc-ms "iters:" iters)) - (if (>= new-acc-ms max-ms) - last-iters - (run-fn-for* fn max-ms new-acc-ms iters))))) - -(def! run-fn-for - (fn* [fn max-secs] - (do - ;; Warm it up first - (run-fn-for* fn 1000 0 0) - ;; Now do the test - (run-fn-for* fn (* 1000 max-secs) 0 0)))) diff --git a/mal/run_argv_test.sh b/mal/run_argv_test.sh deleted file mode 100755 index 0e5db2a..0000000 --- a/mal/run_argv_test.sh +++ /dev/null @@ -1,39 +0,0 @@ -#!/bin/bash - -# -# Usage: run_argv_test.sh -# -# Example: run_argv_test.sh python step6_file.py -# - -assert_equal() { - if [ "$1" = "$2" ] ; then - echo "OK: '$1'" - else - echo "FAIL: Expected '$1' but got '$2'" - echo - exit 1 - fi -} - -if [ -z "$1" ] ; then - echo "Usage: $0 " - exit 1 -fi - -root="$(dirname $0)" - -out="$( $@ $root/tests/print_argv.mal aaa bbb ccc | tr -d '\r' )" -assert_equal '("aaa" "bbb" "ccc")' "$out" - -# Note: The 'make' implementation cannot handle arguments with spaces in them, -# so for now we skip this test. -# -# out="$( $@ $root/tests/print_argv.mal aaa 'bbb ccc' ddd )" -# assert_equal '("aaa" "bbb ccc" "ddd")' "$out" - -out="$( $@ $root/tests/print_argv.mal | tr -d '\r' )" -assert_equal '()' "$out" - -echo 'Passed all *ARGV* tests' -echo diff --git a/mal/runtest.py b/mal/runtest.py deleted file mode 100755 index f8779c7..0000000 --- a/mal/runtest.py +++ /dev/null @@ -1,360 +0,0 @@ -#!/usr/bin/env python - -from __future__ import print_function -import os, sys, re -import argparse, time -import signal, atexit - -from subprocess import Popen, STDOUT, PIPE -from select import select - -# Pseudo-TTY and terminal manipulation -import pty, array, fcntl, termios - -IS_PY_3 = sys.version_info[0] == 3 - -debug_file = None -log_file = None - -def debug(data): - if debug_file: - debug_file.write(data) - debug_file.flush() - -def log(data, end='\n'): - if log_file: - log_file.write(data + end) - log_file.flush() - print(data, end=end) - sys.stdout.flush() - -# TODO: do we need to support '\n' too -import platform -if platform.system().find("CYGWIN_NT") >= 0: - # TODO: this is weird, is this really right on Cygwin? - sep = "\n\r\n" -else: - sep = "\r\n" -rundir = None - -parser = argparse.ArgumentParser( - description="Run a test file against a Mal implementation") -parser.add_argument('--rundir', - help="change to the directory before running tests") -parser.add_argument('--start-timeout', default=10, type=int, - help="default timeout for initial prompt") -parser.add_argument('--test-timeout', default=20, type=int, - help="default timeout for each individual test action") -parser.add_argument('--pre-eval', default=None, type=str, - help="Mal code to evaluate prior to running the test") -parser.add_argument('--no-pty', action='store_true', - help="Use direct pipes instead of pseudo-tty") -parser.add_argument('--log-file', type=str, - help="Write messages to the named file in addition the screen") -parser.add_argument('--debug-file', type=str, - help="Write all test interaction the named file") -parser.add_argument('--hard', action='store_true', - help="Turn soft tests following a ';>>> soft=True' into hard failures") - -# Control whether deferrable and optional tests are executed -parser.add_argument('--deferrable', dest='deferrable', action='store_true', - help="Enable deferrable tests that follow a ';>>> deferrable=True'") -parser.add_argument('--no-deferrable', dest='deferrable', action='store_false', - help="Disable deferrable tests that follow a ';>>> deferrable=True'") -parser.set_defaults(deferrable=True) -parser.add_argument('--optional', dest='optional', action='store_true', - help="Enable optional tests that follow a ';>>> optional=True'") -parser.add_argument('--no-optional', dest='optional', action='store_false', - help="Disable optional tests that follow a ';>>> optional=True'") -parser.set_defaults(optional=True) - -parser.add_argument('test_file', type=str, - help="a test file formatted as with mal test data") -parser.add_argument('mal_cmd', nargs="*", - help="Mal implementation command line. Use '--' to " - "specify a Mal command line with dashed options.") - -class Runner(): - def __init__(self, args, no_pty=False): - #print "args: %s" % repr(args) - self.no_pty = no_pty - - # Cleanup child process on exit - atexit.register(self.cleanup) - - self.p = None - env = os.environ - env['TERM'] = 'dumb' - env['INPUTRC'] = '/dev/null' - env['PERL_RL'] = 'false' - if no_pty: - self.p = Popen(args, bufsize=0, - stdin=PIPE, stdout=PIPE, stderr=STDOUT, - preexec_fn=os.setsid, - env=env) - self.stdin = self.p.stdin - self.stdout = self.p.stdout - else: - # provide tty to get 'interactive' readline to work - master, slave = pty.openpty() - - # Set terminal size large so that readline will not send - # ANSI/VT escape codes when the lines are long. - buf = array.array('h', [100, 200, 0, 0]) - fcntl.ioctl(master, termios.TIOCSWINSZ, buf, True) - - self.p = Popen(args, bufsize=0, - stdin=slave, stdout=slave, stderr=STDOUT, - preexec_fn=os.setsid, - env=env) - # Now close slave so that we will get an exception from - # read when the child exits early - # http://stackoverflow.com/questions/11165521 - os.close(slave) - self.stdin = os.fdopen(master, 'r+b', 0) - self.stdout = self.stdin - - #print "started" - self.buf = "" - self.last_prompt = "" - - def read_to_prompt(self, prompts, timeout): - end_time = time.time() + timeout - while time.time() < end_time: - [outs,_,_] = select([self.stdout], [], [], 1) - if self.stdout in outs: - new_data = self.stdout.read(1) - new_data = new_data.decode("utf-8") if IS_PY_3 else new_data - #print("new_data: '%s'" % new_data) - debug(new_data) - # Perform newline cleanup - if self.no_pty: - self.buf += new_data.replace("\n", "\r\n") - else: - self.buf += new_data - self.buf = self.buf.replace("\r\r", "\r") - # Remove ANSI codes generally - #ansi_escape = re.compile(r'\x1B\[[0-?]*[ -/]*[@-~]') - # Remove rustyline ANSI CSI codes: - # - [6C - CR + cursor forward - # - [6K - CR + erase in line - ansi_escape = re.compile(r'\r\x1B\[[0-9]*[CK]') - self.buf = ansi_escape.sub('', self.buf) - for prompt in prompts: - regexp = re.compile(prompt) - match = regexp.search(self.buf) - if match: - end = match.end() - buf = self.buf[0:match.start()] - self.buf = self.buf[end:] - self.last_prompt = prompt - return buf.replace("^M", "\r") - return None - - def writeline(self, str): - def _to_bytes(s): - return bytes(s, "utf-8") if IS_PY_3 else s - - self.stdin.write(_to_bytes(str.replace('\r', '\x16\r') + "\n")) - - def cleanup(self): - #print "cleaning up" - if self.p: - try: - os.killpg(self.p.pid, signal.SIGTERM) - except OSError: - pass - self.p = None - -class TestReader: - def __init__(self, test_file): - self.line_num = 0 - f = open(test_file, newline='') if IS_PY_3 else open(test_file) - self.data = f.read().split('\n') - self.soft = False - self.deferrable = False - self.optional = False - - def next(self): - self.msg = None - self.form = None - self.out = "" - self.ret = None - - while self.data: - self.line_num += 1 - line = self.data.pop(0) - if re.match(r"^\s*$", line): # blank line - continue - elif line[0:3] == ";;;": # ignore comment - continue - elif line[0:2] == ";;": # output comment - self.msg = line[3:] - return True - elif line[0:5] == ";>>> ": # settings/commands - settings = {} - exec(line[5:], {}, settings) - if 'soft' in settings: - self.soft = settings['soft'] - if 'deferrable' in settings and settings['deferrable']: - self.deferrable = "\nSkipping deferrable and optional tests" - return True - if 'optional' in settings and settings['optional']: - self.optional = "\nSkipping optional tests" - return True - continue - elif line[0:1] == ";": # unexpected comment - raise Exception("Test data error at line %d:\n%s" % (self.line_num, line)) - self.form = line # the line is a form to send - - # Now find the output and return value - while self.data: - line = self.data[0] - if line[0:3] == ";=>": - self.ret = line[3:] - self.line_num += 1 - self.data.pop(0) - break - elif line[0:2] == ";/": - self.out = self.out + line[2:] + sep - self.line_num += 1 - self.data.pop(0) - else: - self.ret = "" - break - if self.ret != None: break - - if self.out[-2:] == sep and not self.ret: - # If there is no return value, output should not end in - # separator - self.out = self.out[0:-2] - return self.form - -args = parser.parse_args(sys.argv[1:]) -# Workaround argparse issue with two '--' on command line -if sys.argv.count('--') > 0: - args.mal_cmd = sys.argv[sys.argv.index('--')+1:] - -if args.rundir: os.chdir(args.rundir) - -if args.log_file: log_file = open(args.log_file, "a") -if args.debug_file: debug_file = open(args.debug_file, "a") - -r = Runner(args.mal_cmd, no_pty=args.no_pty) -t = TestReader(args.test_file) - - -def assert_prompt(runner, prompts, timeout): - # Wait for the initial prompt - header = runner.read_to_prompt(prompts, timeout=timeout) - if not header == None: - if header: - log("Started with:\n%s" % header) - else: - log("Did not one of following prompt(s): %s" % repr(prompts)) - log(" Got : %s" % repr(r.buf)) - sys.exit(1) - - -# Wait for the initial prompt -try: - assert_prompt(r, ['[^\s()<>]+> '], args.start_timeout) -except: - _, exc, _ = sys.exc_info() - log("\nException: %s" % repr(exc)) - log("Output before exception:\n%s" % r.buf) - sys.exit(1) - -# Send the pre-eval code if any -if args.pre_eval: - sys.stdout.write("RUNNING pre-eval: %s" % args.pre_eval) - p.write(args.pre_eval) - assert_prompt(args.test_timeout) - -test_cnt = 0 -pass_cnt = 0 -fail_cnt = 0 -soft_fail_cnt = 0 -failures = [] - -while t.next(): - if args.deferrable == False and t.deferrable: - log(t.deferrable) - break - - if args.optional == False and t.optional: - log(t.optional) - break - - if t.msg != None: - log(t.msg) - continue - - if t.form == None: continue - - log("TEST: %s -> [%s,%s]" % (repr(t.form), repr(t.out), t.ret), end='') - - # The repeated form is to get around an occasional OS X issue - # where the form is repeated. - # https://github.com/kanaka/mal/issues/30 - expects = ["%s%s%s%s" % (re.escape(t.form), sep, - t.out, re.escape(t.ret)), - "%s%s%s%s%s%s" % (re.escape(t.form), sep, - re.escape(t.form), sep, - t.out, re.escape(t.ret))] - - r.writeline(t.form) - try: - test_cnt += 1 - res = r.read_to_prompt(['\r\n[^\s()<>]+> ', '\n[^\s()<>]+> '], - timeout=args.test_timeout) - #print "%s,%s,%s" % (idx, repr(p.before), repr(p.after)) - if (t.ret == "" and t.out == ""): - log(" -> SUCCESS (result ignored)") - pass_cnt += 1 - elif (re.search(expects[0], res, re.S) or - re.search(expects[1], res, re.S)): - log(" -> SUCCESS") - pass_cnt += 1 - else: - if t.soft and not args.hard: - log(" -> SOFT FAIL (line %d):" % t.line_num) - soft_fail_cnt += 1 - fail_type = "SOFT " - else: - log(" -> FAIL (line %d):" % t.line_num) - fail_cnt += 1 - fail_type = "" - log(" Expected : %s" % repr(expects[0])) - log(" Got : %s" % repr(res)) - failed_test = """%sFAILED TEST (line %d): %s -> [%s,%s]: - Expected : %s - Got : %s""" % (fail_type, t.line_num, t.form, repr(t.out), - t.ret, repr(expects[0]), repr(res)) - failures.append(failed_test) - except: - _, exc, _ = sys.exc_info() - log("\nException: %s" % repr(exc)) - log("Output before exception:\n%s" % r.buf) - sys.exit(1) - -if len(failures) > 0: - log("\nFAILURES:") - for f in failures: - log(f) - -results = """ -TEST RESULTS (for %s): - %3d: soft failing tests - %3d: failing tests - %3d: passing tests - %3d: total tests -""" % (args.test_file, soft_fail_cnt, fail_cnt, - pass_cnt, test_cnt) -log(results) - -debug("\n") # add some separate to debug log - -if fail_cnt > 0: - sys.exit(1) -sys.exit(0) diff --git a/mal/tests/docker-build.sh b/mal/tests/docker-build.sh deleted file mode 100755 index e79c149..0000000 --- a/mal/tests/docker-build.sh +++ /dev/null @@ -1,6 +0,0 @@ -#!/bin/bash - -IMAGE_NAME=${IMAGE_NAME:-mal-test-ubuntu-utopic} -GIT_TOP=$(git rev-parse --show-toplevel) - -docker build -t "${IMAGE_NAME}" "${GIT_TOP}/tests/docker" diff --git a/mal/tests/docker-run.sh b/mal/tests/docker-run.sh deleted file mode 100755 index 1666d7d..0000000 --- a/mal/tests/docker-run.sh +++ /dev/null @@ -1,9 +0,0 @@ -#!/bin/bash - -IMAGE_NAME=${IMAGE_NAME:-mal-test-ubuntu-utopic} -GIT_TOP=$(git rev-parse --show-toplevel) - -docker run -it --rm -u ${EUID} \ - --volume=${GIT_TOP}:/mal \ - ${IMAGE_NAME} \ - "${@}" diff --git a/mal/tests/docker/Dockerfile b/mal/tests/docker/Dockerfile deleted file mode 100644 index 71b7ed0..0000000 --- a/mal/tests/docker/Dockerfile +++ /dev/null @@ -1,178 +0,0 @@ -# WARNING: This file is deprecated. Each implementation now has its -# own Dockerfile. - -FROM ubuntu:utopic -MAINTAINER Joel Martin - -ENV DEBIAN_FRONTEND noninteractive - -RUN echo "deb http://dl.bintray.com/sbt/debian /" > /etc/apt/sources.list.d/sbt.list -RUN apt-get -y update - -# -# General dependencies -# -VOLUME /mal - -RUN apt-get -y install make wget curl git - -# Deps for compiled languages (C, Go, Rust, Nim, etc) -RUN apt-get -y install gcc pkg-config - -# Deps for Java-based languages (Clojure, Scala, Java) -RUN apt-get -y install openjdk-7-jdk -ENV MAVEN_OPTS -Duser.home=/mal - -# Deps for Mono-based languages (C#, VB.Net) -RUN apt-get -y install mono-runtime mono-mcs mono-vbnc - -# Deps for node.js languages (JavaScript, CoffeeScript, miniMAL, etc) -RUN apt-get -y install nodejs npm -RUN ln -sf nodejs /usr/bin/node - - -# -# Implementation specific installs -# - -# GNU awk -RUN apt-get -y install gawk - -# Bash -RUN apt-get -y install bash - -# C -RUN apt-get -y install libglib2.0 libglib2.0-dev -RUN apt-get -y install libffi-dev libreadline-dev libedit2 libedit-dev - -# C++ -RUN apt-get -y install g++-4.9 libreadline-dev - -# Clojure -ADD https://raw.githubusercontent.com/technomancy/leiningen/stable/bin/lein \ - /usr/local/bin/lein -RUN sudo chmod 0755 /usr/local/bin/lein -ENV LEIN_HOME /mal/.lein -ENV LEIN_JVM_OPTS -Duser.home=/mal - -# CoffeeScript -RUN npm install -g coffee-script -RUN touch /.coffee_history && chmod go+w /.coffee_history - -# C# -RUN apt-get -y install mono-mcs - -# Elixir -RUN wget https://packages.erlang-solutions.com/erlang-solutions_1.0_all.deb \ - && dpkg -i erlang-solutions_1.0_all.deb -RUN apt-get update -RUN apt-get -y install elixir - -# Erlang R17 (so I can use maps) -RUN apt-get -y install build-essential libncurses5-dev libssl-dev -RUN cd /tmp && wget http://www.erlang.org/download/otp_src_17.5.tar.gz \ - && tar -C /tmp -zxf /tmp/otp_src_17.5.tar.gz \ - && cd /tmp/otp_src_17.5 && ./configure && make && make install \ - && rm -rf /tmp/otp_src_17.5 /tmp/otp_src_17.5.tar.gz -# Rebar for building the Erlang implementation -RUN cd /tmp/ && git clone -q https://github.com/rebar/rebar.git \ - && cd /tmp/rebar && ./bootstrap && cp rebar /usr/local/bin \ - && rm -rf /tmp/rebar - -# Forth -RUN apt-get -y install gforth - -# Go -RUN apt-get -y install golang - -# Guile -RUN apt-get -y install libunistring-dev libgc-dev autoconf libtool flex gettext texinfo libgmp-dev -RUN git clone git://git.sv.gnu.org/guile.git /tmp/guile \ - && cd /tmp/guile && ./autogen.sh && ./configure && make && make install - -# Haskell -RUN apt-get -y install ghc haskell-platform libghc-readline-dev libghc-editline-dev - -# Java -RUN apt-get -y install maven2 - -# JavaScript -# Already satisfied above - -# Julia -RUN apt-get -y install software-properties-common -RUN apt-add-repository -y ppa:staticfloat/juliareleases -RUN apt-get -y update -RUN apt-get -y install julia - -# Lua -RUN apt-get -y install lua5.1 lua-rex-pcre luarocks -RUN luarocks install linenoise - -# Mal -# N/A: self-hosted on other language implementations - -# GNU Make -# Already satisfied as a based dependency for testing - -# miniMAL -RUN npm install -g minimal-lisp - -# Nim -RUN cd /tmp && wget http://nim-lang.org/download/nim-0.17.0.tar.xz \ - && tar xvJf /tmp/nim-0.17.0.tar.xz && cd nim-0.17.0 \ - && make && sh install.sh /usr/local/bin \ - && rm -r /tmp/nim-0.17.0 - -# OCaml -RUN apt-get -y install ocaml-batteries-included - -# perl -RUN apt-get -y install perl - -# PHP -RUN apt-get -y install php5-cli - -# PostScript/ghostscript -RUN apt-get -y install ghostscript - -# python -RUN apt-get -y install python - -# R -RUN apt-get -y install r-base-core - -# Racket -RUN apt-get -y install racket - -# Ruby -RUN apt-get -y install ruby - -# Rust -RUN curl -sf https://raw.githubusercontent.com/brson/multirust/master/blastoff.sh | sh - -# Scala -RUN apt-get -y --force-yes install sbt -RUN apt-get -y install scala -ENV SBT_OPTS -Duser.home=/mal - -# VB.Net -RUN apt-get -y install mono-vbnc - -# TODO: move up -# Factor -RUN apt-get -y install libgtkglext1 -RUN cd /usr/lib/x86_64-linux-gnu/ \ - && wget http://downloads.factorcode.org/releases/0.97/factor-linux-x86-64-0.97.tar.gz \ - && tar xvzf factor-linux-x86-64-0.97.tar.gz \ - && ln -sf /usr/lib/x86_64-linux-gnu/factor/factor /usr/bin/factor \ - && rm factor-linux-x86-64-0.97.tar.gz - -# MATLAB is proprietary/licensed. Maybe someday with Octave. -# Swift is XCode/OS X only -ENV SKIP_IMPLS matlab swift - -ENV DEBIAN_FRONTEND newt -ENV HOME / - -WORKDIR /mal diff --git a/mal/tests/inc.mal b/mal/tests/inc.mal deleted file mode 100644 index 39ebc55..0000000 --- a/mal/tests/inc.mal +++ /dev/null @@ -1,4 +0,0 @@ -(def! inc1 (fn* (a) (+ 1 a))) -(def! inc2 (fn* (a) (+ 2 a))) -(def! inc3 (fn* (a) - (+ 3 a))) diff --git a/mal/tests/incA.mal b/mal/tests/incA.mal deleted file mode 100644 index cbbea79..0000000 --- a/mal/tests/incA.mal +++ /dev/null @@ -1,3 +0,0 @@ -(def! inc4 (fn* (a) (+ 4 a))) - -(prn (inc4 5)) diff --git a/mal/tests/incB.mal b/mal/tests/incB.mal deleted file mode 100644 index 519bdf4..0000000 --- a/mal/tests/incB.mal +++ /dev/null @@ -1,10 +0,0 @@ -;; A comment in a file -(def! inc4 (fn* (a) (+ 4 a))) -(def! inc5 (fn* (a) ;; a comment after code - (+ 5 a))) - -(prn "incB.mal finished") -"incB.mal return string" - -;; ending comment - diff --git a/mal/tests/incC.mal b/mal/tests/incC.mal deleted file mode 100644 index e6f5041..0000000 --- a/mal/tests/incC.mal +++ /dev/null @@ -1,6 +0,0 @@ -(def! mymap {"a" - 1}) - -(prn "incC.mal finished") -"incC.mal return string" - diff --git a/mal/tests/perf1.mal b/mal/tests/perf1.mal deleted file mode 100644 index 73488f8..0000000 --- a/mal/tests/perf1.mal +++ /dev/null @@ -1,11 +0,0 @@ -(load-file "../core.mal") -(load-file "../perf.mal") - -;;(prn "Start: basic macros performance test") - -(time (do - (or false nil false nil false nil false nil false nil 4) - (cond false 1 nil 2 false 3 nil 4 false 5 nil 6 "else" 7) - (-> (list 1 2 3 4 5 6 7 8 9) rest rest rest rest rest rest first))) - -;;(prn "Done: basic macros performance test") diff --git a/mal/tests/perf2.mal b/mal/tests/perf2.mal deleted file mode 100644 index c525baf..0000000 --- a/mal/tests/perf2.mal +++ /dev/null @@ -1,13 +0,0 @@ -(load-file "../core.mal") -(load-file "../perf.mal") - -;;(prn "Start: basic math/recursion test") - -(def! sumdown (fn* (N) (if (> N 0) (+ N (sumdown (- N 1))) 0))) -(def! fib (fn* (N) (if (= N 0) 1 (if (= N 1) 1 (+ (fib (- N 1)) (fib (- N 2))))))) - -(time (do - (sumdown 10) - (fib 12))) - -;;(prn "Done: basic math/recursion test") diff --git a/mal/tests/perf3.mal b/mal/tests/perf3.mal deleted file mode 100644 index 1a4fbad..0000000 --- a/mal/tests/perf3.mal +++ /dev/null @@ -1,18 +0,0 @@ -(load-file "../core.mal") -(load-file "../perf.mal") - -;;(prn "Start: basic macros/atom test") - -(def! atm (atom (list 0 1 2 3 4 5 6 7 8 9))) - -(println "iters over 10 seconds:" - (run-fn-for - (fn* [] - (do - (or false nil false nil false nil false nil false nil (first @atm)) - (cond false 1 nil 2 false 3 nil 4 false 5 nil 6 "else" (first @atm)) - (-> (deref atm) rest rest rest rest rest rest first) - (swap! atm (fn* [a] (concat (rest a) (list (first a))))))) - 10)) - -;;(prn "Done: basic macros/atom test") diff --git a/mal/tests/print_argv.mal b/mal/tests/print_argv.mal deleted file mode 100644 index 7c28dfb..0000000 --- a/mal/tests/print_argv.mal +++ /dev/null @@ -1,2 +0,0 @@ -; Used by the run_argv_test.sh test harness -(prn *ARGV*) diff --git a/mal/tests/step0_repl.mal b/mal/tests/step0_repl.mal deleted file mode 100644 index 2b83a01..0000000 --- a/mal/tests/step0_repl.mal +++ /dev/null @@ -1,17 +0,0 @@ -;; Testing basic string -abcABC123 -;=>abcABC123 - -;; Testing string containing spaces -hello mal world -;=>hello mal world - -;; Testing string containing symbols -[]{}"'* ;:() -;=>[]{}"'* ;:() - - -;; Test long string -hello world abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ 0123456789 (;:() []{}"'* ;:() []{}"'* ;:() []{}"'*) -;=>hello world abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ 0123456789 (;:() []{}"'* ;:() []{}"'* ;:() []{}"'*) - diff --git a/mal/tests/step1_read_print.mal b/mal/tests/step1_read_print.mal deleted file mode 100644 index 51290a9..0000000 --- a/mal/tests/step1_read_print.mal +++ /dev/null @@ -1,165 +0,0 @@ -;; Testing read of numbers -1 -;=>1 -7 -;=>7 - 7 -;=>7 --123 -;=>-123 - - -;; Testing read of symbols -+ -;=>+ -abc -;=>abc - abc -;=>abc -abc5 -;=>abc5 -abc-def -;=>abc-def - -;; Testing non-numbers starting with a dash. -- -;=>- --abc -;=>-abc -->> -;=>->> - -;; Testing read of lists -(+ 1 2) -;=>(+ 1 2) -() -;=>() -(nil) -;=>(nil) -((3 4)) -;=>((3 4)) -(+ 1 (+ 2 3)) -;=>(+ 1 (+ 2 3)) - ( + 1 (+ 2 3 ) ) -;=>(+ 1 (+ 2 3)) -(* 1 2) -;=>(* 1 2) -(** 1 2) -;=>(** 1 2) -(* -3 6) -;=>(* -3 6) - -;; Test commas as whitespace -(1 2, 3,,,,),, -;=>(1 2 3) - - -;>>> deferrable=True - -;; -;; -------- Deferrable Functionality -------- - -;; Testing read of nil/true/false -nil -;=>nil -true -;=>true -false -;=>false - -;; Testing read of strings -"abc" -;=>"abc" - "abc" -;=>"abc" -"abc (with parens)" -;=>"abc (with parens)" -"abc\"def" -;=>"abc\"def" -;;;"abc\ndef" -;;;;=>"abc\ndef" -"" -;=>"" - -;; Testing reader errors -(1 2 -;/.*(EOF|end of input|unbalanced).* -[1 2 -;/.*(EOF|end of input|unbalanced).* - -;;; These should throw some error with no return value -"abc -;/.*(EOF|end of input|unbalanced).* -(1 "abc -;/.*(EOF|end of input|unbalanced).* -(1 "abc" -;/.*(EOF|end of input|unbalanced).* - -;; Testing read of quoting -'1 -;=>(quote 1) -'(1 2 3) -;=>(quote (1 2 3)) -`1 -;=>(quasiquote 1) -`(1 2 3) -;=>(quasiquote (1 2 3)) -~1 -;=>(unquote 1) -~(1 2 3) -;=>(unquote (1 2 3)) -`(1 ~a 3) -;=>(quasiquote (1 (unquote a) 3)) -~@(1 2 3) -;=>(splice-unquote (1 2 3)) - - -;>>> optional=True -;; -;; -------- Optional Functionality -------- - -;; Testing keywords -:kw -;=>:kw -(:kw1 :kw2 :kw3) -;=>(:kw1 :kw2 :kw3) - -;; Testing read of vectors -[+ 1 2] -;=>[+ 1 2] -[] -;=>[] -[[3 4]] -;=>[[3 4]] -[+ 1 [+ 2 3]] -;=>[+ 1 [+ 2 3]] - [ + 1 [+ 2 3 ] ] -;=>[+ 1 [+ 2 3]] - -;; Testing read of hash maps -{"abc" 1} -;=>{"abc" 1} -{"a" {"b" 2}} -;=>{"a" {"b" 2}} -{"a" {"b" {"c" 3}}} -;=>{"a" {"b" {"c" 3}}} -{ "a" {"b" { "cde" 3 } }} -;=>{"a" {"b" {"cde" 3}}} -{ :a {:b { :cde 3 } }} -;=>{:a {:b {:cde 3}}} - -;; Testing read of comments - ;; whole line comment (not an exception) -1 ; comment after expression -;=>1 -1; comment after expression -;=>1 - -;; Testing read of ^/metadata -^{"a" 1} [1 2 3] -;=>(with-meta [1 2 3] {"a" 1}) - - -;; Testing read of @/deref -@a -;=>(deref a) diff --git a/mal/tests/step2_eval.mal b/mal/tests/step2_eval.mal deleted file mode 100644 index 16a3589..0000000 --- a/mal/tests/step2_eval.mal +++ /dev/null @@ -1,44 +0,0 @@ -;; Testing evaluation of arithmetic operations -(+ 1 2) -;=>3 - -(+ 5 (* 2 3)) -;=>11 - -(- (+ 5 (* 2 3)) 3) -;=>8 - -(/ (- (+ 5 (* 2 3)) 3) 4) -;=>2 - -(/ (- (+ 515 (* 87 311)) 302) 27) -;=>1010 - -(* -3 6) -;=>-18 - -(/ (- (+ 515 (* -87 311)) 296) 27) -;=>-994 - -;;; This should throw an error with no return value -(abc 1 2 3) -;/.+ - -;; Testing empty list -() -;=>() - -;>>> deferrable=True -;>>> optional=True -;; -;; -------- Deferrable/Optional Functionality -------- - -;; Testing evaluation within collection literals -[1 2 (+ 1 2)] -;=>[1 2 3] - -{"a" (+ 7 8)} -;=>{"a" 15} - -{:a (+ 7 8)} -;=>{:a 15} diff --git a/mal/tests/step3_env.mal b/mal/tests/step3_env.mal deleted file mode 100644 index cc8270d..0000000 --- a/mal/tests/step3_env.mal +++ /dev/null @@ -1,79 +0,0 @@ -;; Testing REPL_ENV -(+ 1 2) -;=>3 -(/ (- (+ 5 (* 2 3)) 3) 4) -;=>2 - - -;; Testing def! -(def! x 3) -;=>3 -x -;=>3 -(def! x 4) -;=>4 -x -;=>4 -(def! y (+ 1 7)) -;=>8 -y -;=>8 - -;; Verifying symbols are case-sensitive -(def! mynum 111) -;=>111 -(def! MYNUM 222) -;=>222 -mynum -;=>111 -MYNUM -;=>222 - -;; Check env lookup non-fatal error -(abc 1 2 3) -;/.*\'?abc\'? not found.* -;; Check that error aborts def! -(def! w 123) -(def! w (abc)) -w -;=>123 - -;; Testing let* -(let* (z 9) z) -;=>9 -(let* (x 9) x) -;=>9 -x -;=>4 -(let* (z (+ 2 3)) (+ 1 z)) -;=>6 -(let* (p (+ 2 3) q (+ 2 p)) (+ p q)) -;=>12 -(def! y (let* (z 7) z)) -y -;=>7 - -;; Testing outer environment -(def! a 4) -;=>4 -(let* (q 9) q) -;=>9 -(let* (q 9) a) -;=>4 -(let* (z 2) (let* (q 9) a)) -;=>4 - -;>>> deferrable=True -;>>> optional=True -;; -;; -------- Deferrable/Optional Functionality -------- - -;; Testing let* with vector bindings -(let* [z 9] z) -;=>9 -(let* [p (+ 2 3) q (+ 2 p)] (+ p q)) -;=>12 - -;; Testing vector evaluation -(let* (a 5 b 6) [3 4 a [b 7] 8]) -;=>[3 4 5 [6 7] 8] diff --git a/mal/tests/step4_if_fn_do.mal b/mal/tests/step4_if_fn_do.mal deleted file mode 100644 index ba71e82..0000000 --- a/mal/tests/step4_if_fn_do.mal +++ /dev/null @@ -1,481 +0,0 @@ -;; ----------------------------------------------------- - - -;; Testing list functions -(list) -;=>() -(list? (list)) -;=>true -(empty? (list)) -;=>true -(empty? (list 1)) -;=>false -(list 1 2 3) -;=>(1 2 3) -(count (list 1 2 3)) -;=>3 -(count (list)) -;=>0 -(count nil) -;=>0 -(if (> (count (list 1 2 3)) 3) "yes" "no") -;=>"no" -(if (>= (count (list 1 2 3)) 3) "yes" "no") -;=>"yes" - - -;; Testing if form -(if true 7 8) -;=>7 -(if false 7 8) -;=>8 -(if false 7 false) -;=>false -(if true (+ 1 7) (+ 1 8)) -;=>8 -(if false (+ 1 7) (+ 1 8)) -;=>9 -(if nil 7 8) -;=>8 -(if 0 7 8) -;=>7 -(if "" 7 8) -;=>7 -(if (list) 7 8) -;=>7 -(if (list 1 2 3) 7 8) -;=>7 -(= (list) nil) -;=>false - - -;; Testing 1-way if form -(if false (+ 1 7)) -;=>nil -(if nil 8 7) -;=>7 -(if true (+ 1 7)) -;=>8 - - -;; Testing basic conditionals -(= 2 1) -;=>false -(= 1 1) -;=>true -(= 1 2) -;=>false -(= 1 (+ 1 1)) -;=>false -(= 2 (+ 1 1)) -;=>true -(= nil 1) -;=>false -(= nil nil) -;=>true - -(> 2 1) -;=>true -(> 1 1) -;=>false -(> 1 2) -;=>false - -(>= 2 1) -;=>true -(>= 1 1) -;=>true -(>= 1 2) -;=>false - -(< 2 1) -;=>false -(< 1 1) -;=>false -(< 1 2) -;=>true - -(<= 2 1) -;=>false -(<= 1 1) -;=>true -(<= 1 2) -;=>true - - -;; Testing equality -(= 1 1) -;=>true -(= 0 0) -;=>true -(= 1 0) -;=>false -(= "" "") -;=>true -(= "abc" "abc") -;=>true -(= "abc" "") -;=>false -(= "" "abc") -;=>false -(= "abc" "def") -;=>false -(= "abc" "ABC") -;=>false -(= true true) -;=>true -(= false false) -;=>true -(= nil nil) -;=>true - -(= (list) (list)) -;=>true -(= (list 1 2) (list 1 2)) -;=>true -(= (list 1) (list)) -;=>false -(= (list) (list 1)) -;=>false -(= 0 (list)) -;=>false -(= (list) 0) -;=>false -(= (list) "") -;=>false -(= "" (list)) -;=>false - - -;; Testing builtin and user defined functions -(+ 1 2) -;=>3 -( (fn* (a b) (+ b a)) 3 4) -;=>7 -( (fn* () 4) ) -;=>4 - -( (fn* (f x) (f x)) (fn* (a) (+ 1 a)) 7) -;=>8 - - -;; Testing closures -( ( (fn* (a) (fn* (b) (+ a b))) 5) 7) -;=>12 - -(def! gen-plus5 (fn* () (fn* (b) (+ 5 b)))) -(def! plus5 (gen-plus5)) -(plus5 7) -;=>12 - -(def! gen-plusX (fn* (x) (fn* (b) (+ x b)))) -(def! plus7 (gen-plusX 7)) -(plus7 8) -;=>15 - -;; Testing do form -(do (prn "prn output1")) -;/"prn output1" -;=>nil -(do (prn "prn output2") 7) -;/"prn output2" -;=>7 -(do (prn "prn output1") (prn "prn output2") (+ 1 2)) -;/"prn output1" -;/"prn output2" -;=>3 - -(do (def! a 6) 7 (+ a 8)) -;=>14 -a -;=>6 - -;; Testing special form case-sensitivity -(def! DO (fn* (a) 7)) -(DO 3) -;=>7 - -;; Testing recursive sumdown function -(def! sumdown (fn* (N) (if (> N 0) (+ N (sumdown (- N 1))) 0))) -(sumdown 1) -;=>1 -(sumdown 2) -;=>3 -(sumdown 6) -;=>21 - - -;; Testing recursive fibonacci function -(def! fib (fn* (N) (if (= N 0) 1 (if (= N 1) 1 (+ (fib (- N 1)) (fib (- N 2))))))) -(fib 1) -;=>1 -(fib 2) -;=>2 -(fib 4) -;=>5 -;;; Too slow for bash, erlang, make and miniMAL -;;;(fib 10) -;;;;=>89 - - -;>>> deferrable=True -;; -;; -------- Deferrable Functionality -------- - -;; Testing variable length arguments - -( (fn* (& more) (count more)) 1 2 3) -;=>3 -( (fn* (& more) (list? more)) 1 2 3) -;=>true -( (fn* (& more) (count more)) 1) -;=>1 -( (fn* (& more) (count more)) ) -;=>0 -( (fn* (& more) (list? more)) ) -;=>true -( (fn* (a & more) (count more)) 1 2 3) -;=>2 -( (fn* (a & more) (count more)) 1) -;=>0 -( (fn* (a & more) (list? more)) 1) -;=>true - - -;; Testing language defined not function -(not false) -;=>true -(not nil) -;=>true -(not true) -;=>false -(not "a") -;=>false -(not 0) -;=>false - - -;; ----------------------------------------------------- - -;; Testing string quoting - -"" -;=>"" - -"abc" -;=>"abc" - -"abc def" -;=>"abc def" - -"\"" -;=>"\"" - -"abc\ndef\nghi" -;=>"abc\ndef\nghi" - -"abc\\def\\ghi" -;=>"abc\\def\\ghi" - -"\\n" -;=>"\\n" - -;; Testing pr-str - -(pr-str) -;=>"" - -(pr-str "") -;=>"\"\"" - -(pr-str "abc") -;=>"\"abc\"" - -(pr-str "abc def" "ghi jkl") -;=>"\"abc def\" \"ghi jkl\"" - -(pr-str "\"") -;=>"\"\\\"\"" - -(pr-str (list 1 2 "abc" "\"") "def") -;=>"(1 2 \"abc\" \"\\\"\") \"def\"" - -(pr-str "abc\ndef\nghi") -;=>"\"abc\\ndef\\nghi\"" - -(pr-str "abc\\def\\ghi") -;=>"\"abc\\\\def\\\\ghi\"" - -(pr-str (list)) -;=>"()" - -;; Testing str - -(str) -;=>"" - -(str "") -;=>"" - -(str "abc") -;=>"abc" - -(str "\"") -;=>"\"" - -(str 1 "abc" 3) -;=>"1abc3" - -(str "abc def" "ghi jkl") -;=>"abc defghi jkl" - -(str "abc\ndef\nghi") -;=>"abc\ndef\nghi" - -(str "abc\\def\\ghi") -;=>"abc\\def\\ghi" - -(str (list 1 2 "abc" "\"") "def") -;=>"(1 2 abc \")def" - -(str (list)) -;=>"()" - -;; Testing prn -(prn) -;/ -;=>nil - -(prn "") -;/"" -;=>nil - -(prn "abc") -;/"abc" -;=>nil - -(prn "abc def" "ghi jkl") -;/"abc def" "ghi jkl" - -(prn "\"") -;/"\\"" -;=>nil - -(prn "abc\ndef\nghi") -;/"abc\\ndef\\nghi" -;=>nil - -(prn "abc\\def\\ghi") -;/"abc\\\\def\\\\ghi" -nil - -(prn (list 1 2 "abc" "\"") "def") -;/\(1 2 "abc" "\\""\) "def" -;=>nil - - -;; Testing println -(println) -;/ -;=>nil - -(println "") -;/ -;=>nil - -(println "abc") -;/abc -;=>nil - -(println "abc def" "ghi jkl") -;/abc def ghi jkl - -(println "\"") -;/" -;=>nil - -(println "abc\ndef\nghi") -;/abc -;/def -;/ghi -;=>nil - -(println "abc\\def\\ghi") -;/abc\\def\\ghi -;=>nil - -(println (list 1 2 "abc" "\"") "def") -;/\(1 2 abc "\) def -;=>nil - -;>>> optional=True -;; -;; -------- Optional Functionality -------- - -;; Testing keywords -(= :abc :abc) -;=>true -(= :abc :def) -;=>false -(= :abc ":abc") -;=>false - -;; Testing vector truthiness -(if [] 7 8) -;=>7 - -;; Testing vector printing -(pr-str [1 2 "abc" "\""] "def") -;=>"[1 2 \"abc\" \"\\\"\"] \"def\"" - -(pr-str []) -;=>"[]" - -(str [1 2 "abc" "\""] "def") -;=>"[1 2 abc \"]def" - -(str []) -;=>"[]" - - -;; Testing vector functions -(count [1 2 3]) -;=>3 -(empty? [1 2 3]) -;=>false -(empty? []) -;=>true -(list? [4 5 6]) -;=>false - -;; Testing vector equality -(= [] (list)) -;=>true -(= [7 8] [7 8]) -;=>true -(= (list 1 2) [1 2]) -;=>true -(= (list 1) []) -;=>false -(= [] [1]) -;=>false -(= 0 []) -;=>false -(= [] 0) -;=>false -(= [] "") -;=>false -(= "" []) -;=>false - -;; Testing vector parameter lists -( (fn* [] 4) ) -;=>4 -( (fn* [f x] (f x)) (fn* [a] (+ 1 a)) 7) -;=>8 - -;; Nested vector/list equality -(= [(list)] (list [])) -;=>true -(= [1 2 (list 3 4 [5 6])] (list 1 2 [3 4 (list 5 6)])) -;=>true diff --git a/mal/tests/step5_tco.mal b/mal/tests/step5_tco.mal deleted file mode 100644 index 0e87b5b..0000000 --- a/mal/tests/step5_tco.mal +++ /dev/null @@ -1,23 +0,0 @@ -;; Testing recursive tail-call function - -(def! sum2 (fn* (n acc) (if (= n 0) acc (sum2 (- n 1) (+ n acc))))) - -;; TODO: test let*, and do for TCO - -(sum2 10 0) -;=>55 - -(def! res2 nil) -;=>nil -(def! res2 (sum2 10000 0)) -res2 -;=>50005000 - - -;; Test mutually recursive tail-call functions - -(def! foo (fn* (n) (if (= n 0) 0 (bar (- n 1))))) -(def! bar (fn* (n) (if (= n 0) 0 (foo (- n 1))))) - -(foo 10000) -;=>0 diff --git a/mal/tests/step6_file.mal b/mal/tests/step6_file.mal deleted file mode 100644 index c9264da..0000000 --- a/mal/tests/step6_file.mal +++ /dev/null @@ -1,132 +0,0 @@ -;;; TODO: really a step5 test -;; -;; Testing that (do (do)) not broken by TCO -(do (do 1 2)) -;=>2 - -;; -;; Testing read-string, eval and slurp -(read-string "(1 2 (3 4) nil)") -;=>(1 2 (3 4) nil) - -(read-string "(+ 2 3)") -;=>(+ 2 3) - -(read-string "7 ;; comment") -;=>7 - -;;; Differing output, but make sure no fatal error -(read-string ";; comment") - - -(eval (read-string "(+ 2 3)")) -;=>5 - -(slurp "../tests/test.txt") -;=>"A line of text\n" - -;; Testing load-file - -(load-file "../tests/inc.mal") -(inc1 7) -;=>8 -(inc2 7) -;=>9 -(inc3 9) -;=>12 - -;; -;; Testing that *ARGV* exists and is an empty list -(list? *ARGV*) -;=>true -*ARGV* -;=>() - -;; -;; Testing atoms - -(def! inc3 (fn* (a) (+ 3 a))) - -(def! a (atom 2)) -;=>(atom 2) - -(atom? a) -;=>true - -(atom? 1) -;=>false - -(deref a) -;=>2 - -(reset! a 3) -;=>3 - -(deref a) -;=>3 - -(swap! a inc3) -;=>6 - -(deref a) -;=>6 - -(swap! a (fn* (a) a)) -;=>6 - -(swap! a (fn* (a) (* 2 a))) -;=>12 - -(swap! a (fn* (a b) (* a b)) 10) -;=>120 - -(swap! a + 3) -;=>123 - -;; Testing swap!/closure interaction -(def! inc-it (fn* (a) (+ 1 a))) -(def! atm (atom 7)) -(def! f (fn* () (swap! atm inc-it))) -(f) -;=>8 -(f) -;=>9 - -;>>> deferrable=True -;>>> optional=True -;; -;; -------- Deferrable/Optional Functionality -------- - -;; Testing comments in a file -(load-file "../tests/incB.mal") -;/"incB.mal finished" -;=>"incB.mal return string" -(inc4 7) -;=>11 -(inc5 7) -;=>12 - -;; Testing map literal across multiple lines in a file -(load-file "../tests/incC.mal") -mymap -;=>{"a" 1} - -;; Testing `@` reader macro (short for `deref`) -(def! atm (atom 9)) -@atm -;=>9 - -;;; TODO: really a step5 test -;; Testing that vector params not broken by TCO -(def! g (fn* [] 78)) -(g) -;=>78 -(def! g (fn* [a] (+ a 78))) -(g 3) -;=>81 - -;; Checking that eval does not use local environments. -(def! a 1) -;=>1 -(let* (a 2) (eval (read-string "a"))) -;=>1 diff --git a/mal/tests/step7_quote.mal b/mal/tests/step7_quote.mal deleted file mode 100644 index 4f3e356..0000000 --- a/mal/tests/step7_quote.mal +++ /dev/null @@ -1,183 +0,0 @@ -;; Testing cons function -(cons 1 (list)) -;=>(1) -(cons 1 (list 2)) -;=>(1 2) -(cons 1 (list 2 3)) -;=>(1 2 3) -(cons (list 1) (list 2 3)) -;=>((1) 2 3) - -(def! a (list 2 3)) -(cons 1 a) -;=>(1 2 3) -a -;=>(2 3) - -;; Testing concat function -(concat) -;=>() -(concat (list 1 2)) -;=>(1 2) -(concat (list 1 2) (list 3 4)) -;=>(1 2 3 4) -(concat (list 1 2) (list 3 4) (list 5 6)) -;=>(1 2 3 4 5 6) -(concat (concat)) -;=>() -(concat (list) (list)) -;=>() - -(def! a (list 1 2)) -(def! b (list 3 4)) -(concat a b (list 5 6)) -;=>(1 2 3 4 5 6) -a -;=>(1 2) -b -;=>(3 4) - -;; Testing regular quote -(quote 7) -;=>7 -(quote (1 2 3)) -;=>(1 2 3) -(quote (1 2 (3 4))) -;=>(1 2 (3 4)) - -;; Testing simple quasiquote -(quasiquote 7) -;=>7 -(quasiquote (1 2 3)) -;=>(1 2 3) -(quasiquote (1 2 (3 4))) -;=>(1 2 (3 4)) -(quasiquote (nil)) -;=>(nil) - -;; Testing unquote -(quasiquote (unquote 7)) -;=>7 -(def! a 8) -;=>8 -(quasiquote a) -;=>a -(quasiquote (unquote a)) -;=>8 -(quasiquote (1 a 3)) -;=>(1 a 3) -(quasiquote (1 (unquote a) 3)) -;=>(1 8 3) -(def! b (quote (1 "b" "d"))) -;=>(1 "b" "d") -(quasiquote (1 b 3)) -;=>(1 b 3) -(quasiquote (1 (unquote b) 3)) -;=>(1 (1 "b" "d") 3) -(quasiquote ((unquote 1) (unquote 2))) -;=>(1 2) - -;; Testing splice-unquote -(def! c (quote (1 "b" "d"))) -;=>(1 "b" "d") -(quasiquote (1 c 3)) -;=>(1 c 3) -(quasiquote (1 (splice-unquote c) 3)) -;=>(1 1 "b" "d" 3) - - -;; Testing symbol equality -(= (quote abc) (quote abc)) -;=>true -(= (quote abc) (quote abcd)) -;=>false -(= (quote abc) "abc") -;=>false -(= "abc" (quote abc)) -;=>false -(= "abc" (str (quote abc))) -;=>true -(= (quote abc) nil) -;=>false -(= nil (quote abc)) -;=>false - -;;;;; Test quine -;;; TODO: needs expect line length fix -;;;((fn* [q] (quasiquote ((unquote q) (quote (unquote q))))) (quote (fn* [q] (quasiquote ((unquote q) (quote (unquote q))))))) -;;;=>((fn* [q] (quasiquote ((unquote q) (quote (unquote q))))) (quote (fn* [q] (quasiquote ((unquote q) (quote (unquote q))))))) - -;>>> deferrable=True -;; -;; -------- Deferrable Functionality -------- - -;; Testing ' (quote) reader macro -'7 -;=>7 -'(1 2 3) -;=>(1 2 3) -'(1 2 (3 4)) -;=>(1 2 (3 4)) - -;; Testing ` (quasiquote) reader macro -`7 -;=>7 -`(1 2 3) -;=>(1 2 3) -`(1 2 (3 4)) -;=>(1 2 (3 4)) -`(nil) -;=>(nil) - -;; Testing ~ (unquote) reader macro -`~7 -;=>7 -(def! a 8) -;=>8 -`(1 ~a 3) -;=>(1 8 3) -(def! b '(1 "b" "d")) -;=>(1 "b" "d") -`(1 b 3) -;=>(1 b 3) -`(1 ~b 3) -;=>(1 (1 "b" "d") 3) - -;; Testing ~@ (splice-unquote) reader macro -(def! c '(1 "b" "d")) -;=>(1 "b" "d") -`(1 c 3) -;=>(1 c 3) -`(1 ~@c 3) -;=>(1 1 "b" "d" 3) - - -;>>> optional=True -;; -;; -------- Optional Functionality -------- - -;; Testing cons, concat, first, rest with vectors - -(cons [1] [2 3]) -;=>([1] 2 3) -(cons 1 [2 3]) -;=>(1 2 3) -(concat [1 2] (list 3 4) [5 6]) -;=>(1 2 3 4 5 6) - -;; Testing unquote with vectors -(def! a 8) -;=>8 -`[1 a 3] -;=>(1 a 3) -;;; TODO: fix this -;;;;=>[1 a 3] - -;; Testing splice-unquote with vectors -(def! c '(1 "b" "d")) -;=>(1 "b" "d") -`[1 ~@c 3] -;=>(1 1 "b" "d" 3) -;;; TODO: fix this -;;;;=>[1 1 "b" "d" 3] - diff --git a/mal/tests/step8_macros.mal b/mal/tests/step8_macros.mal deleted file mode 100644 index 8d0ac4b..0000000 --- a/mal/tests/step8_macros.mal +++ /dev/null @@ -1,169 +0,0 @@ -;; Testing trivial macros -(defmacro! one (fn* () 1)) -(one) -;=>1 -(defmacro! two (fn* () 2)) -(two) -;=>2 - -;; Testing unless macros -(defmacro! unless (fn* (pred a b) `(if ~pred ~b ~a))) -(unless false 7 8) -;=>7 -(unless true 7 8) -;=>8 -(defmacro! unless2 (fn* (pred a b) `(if (not ~pred) ~a ~b))) -(unless2 false 7 8) -;=>7 -(unless2 true 7 8) -;=>8 - -;; Testing macroexpand -(macroexpand (unless2 2 3 4)) -;=>(if (not 2) 3 4) - -;; Testing evaluation of macro result -(defmacro! identity (fn* (x) x)) -(let* (a 123) (identity a)) -;=>123 - - -;>>> deferrable=True -;; -;; -------- Deferrable Functionality -------- - -;; Testing non-macro function -(not (= 1 1)) -;=>false -;;; This should fail if it is a macro -(not (= 1 2)) -;=>true - -;; Testing nth, first and rest functions - -(nth (list 1) 0) -;=>1 -(nth (list 1 2) 1) -;=>2 -(def! x "x") -(def! x (nth (list 1 2) 2)) -x -;=>"x" - -(first (list)) -;=>nil -(first (list 6)) -;=>6 -(first (list 7 8 9)) -;=>7 - -(rest (list)) -;=>() -(rest (list 6)) -;=>() -(rest (list 7 8 9)) -;=>(8 9) - - -;; Testing or macro -(or) -;=>nil -(or 1) -;=>1 -(or 1 2 3 4) -;=>1 -(or false 2) -;=>2 -(or false nil 3) -;=>3 -(or false nil false false nil 4) -;=>4 -(or false nil 3 false nil 4) -;=>3 -(or (or false 4)) -;=>4 - -;; Testing cond macro - -(cond) -;=>nil -(cond true 7) -;=>7 -(cond true 7 true 8) -;=>7 -(cond false 7 true 8) -;=>8 -(cond false 7 false 8 "else" 9) -;=>9 -(cond false 7 (= 2 2) 8 "else" 9) -;=>8 -(cond false 7 false 8 false 9) -;=>nil - -;; Testing EVAL in let* - -(let* (x (or nil "yes")) x) -;=>"yes" - - -;>>> optional=True -;; -;; -------- Optional Functionality -------- - -;; Testing nth, first, rest with vectors - -(nth [1] 0) -;=>1 -(nth [1 2] 1) -;=>2 -(def! x "x") -(def! x (nth [1 2] 2)) -x -;=>"x" - -(first []) -;=>nil -(first nil) -;=>nil -(first [10]) -;=>10 -(first [10 11 12]) -;=>10 -(rest []) -;=>() -(rest nil) -;=>() -(rest [10]) -;=>() -(rest [10 11 12]) -;=>(11 12) - -;; Testing EVAL in vector let* - -(let* [x (or nil "yes")] x) -;=>"yes" - -;; -;; Loading core.mal -(load-file "../core.mal") - -;; Testing -> macro -(-> 7) -;=>7 -(-> (list 7 8 9) first) -;=>7 -(-> (list 7 8 9) (first)) -;=>7 -(-> (list 7 8 9) first (+ 7)) -;=>14 -(-> (list 7 8 9) rest (rest) first (+ 7)) -;=>16 - -;; Testing ->> macro -(->> "L") -;=>"L" -(->> "L" (str "A") (str "M")) -;=>"MAL" -(->> [4] (concat [3]) (concat [2]) rest (concat [1])) -;=>(1 3 4) - diff --git a/mal/tests/step9_try.mal b/mal/tests/step9_try.mal deleted file mode 100644 index 21e4132..0000000 --- a/mal/tests/step9_try.mal +++ /dev/null @@ -1,374 +0,0 @@ -;; -;; Testing throw - -(throw "err1") -;/.*([Ee][Rr][Rr][Oo][Rr]|[Ee]xception).*err1.* -(throw {:msg "err2"}) -;/.*([Ee][Rr][Rr][Oo][Rr]|[Ee]xception).*msg.*err2.* - -;; -;; Testing try*/catch* - -(try* 123 (catch* e 456)) -;=>123 - -(try* (abc 1 2) (catch* exc (prn "exc is:" exc))) -;/"exc is:" "'abc' not found" -;=>nil - -;; Make sure error from core can be caught -(try* (nth [] 1) (catch* exc (prn "exc is:" exc))) -;/"exc is:".*(length|range|[Bb]ounds|beyond).* -;=>nil - -(try* (throw "my exception") (catch* exc (do (prn "exc:" exc) 7))) -;/"exc:" "my exception" -;=>7 - -;;; Test that throw is a function: -(try* (map throw (list "my err")) (catch* exc exc)) -;=>"my err" - - -;; -;; Testing builtin functions - -(symbol? 'abc) -;=>true -(symbol? "abc") -;=>false - -(nil? nil) -;=>true -(nil? true) -;=>false - -(true? true) -;=>true -(true? false) -;=>false -(true? true?) -;=>false - -(false? false) -;=>true -(false? true) -;=>false - -;; Testing apply function with core functions -(apply + (list 2 3)) -;=>5 -(apply + 4 (list 5)) -;=>9 -(apply prn (list 1 2 "3" (list))) -;/1 2 "3" \(\) -;=>nil -(apply prn 1 2 (list "3" (list))) -;/1 2 "3" \(\) -;=>nil -(apply list (list)) -;=>() -(apply symbol? (list (quote two))) -;=>true - -;; Testing apply function with user functions -(apply (fn* (a b) (+ a b)) (list 2 3)) -;=>5 -(apply (fn* (a b) (+ a b)) 4 (list 5)) -;=>9 - -;; Testing map function -(def! nums (list 1 2 3)) -(def! double (fn* (a) (* 2 a))) -(double 3) -;=>6 -(map double nums) -;=>(2 4 6) -(map (fn* (x) (symbol? x)) (list 1 (quote two) "three")) -;=>(false true false) - -;>>> deferrable=True -;; -;; ------- Deferrable Functionality ---------- -;; ------- (Needed for self-hosting) ------- - -;; Testing symbol and keyword functions -(symbol? :abc) -;=>false -(symbol? 'abc) -;=>true -(symbol? "abc") -;=>false -(symbol? (symbol "abc")) -;=>true -(keyword? :abc) -;=>true -(keyword? 'abc) -;=>false -(keyword? "abc") -;=>false -(keyword? "") -;=>false -(keyword? (keyword "abc")) -;=>true - -(symbol "abc") -;=>abc -;;;TODO: all implementations should suppport this too -;;;(keyword :abc) -;;;;=>:abc -(keyword "abc") -;=>:abc - -;; Testing sequential? function - -(sequential? (list 1 2 3)) -;=>true -(sequential? [15]) -;=>true -(sequential? sequential?) -;=>false -(sequential? nil) -;=>false -(sequential? "abc") -;=>false - -;; Testing apply function with core functions and arguments in vector -(apply + 4 [5]) -;=>9 -(apply prn 1 2 ["3" 4]) -;/1 2 "3" 4 -;=>nil -(apply list []) -;=>() -;; Testing apply function with user functions and arguments in vector -(apply (fn* (a b) (+ a b)) [2 3]) -;=>5 -(apply (fn* (a b) (+ a b)) 4 [5]) -;=>9 - - -;; Testing map function with vectors -(map (fn* (a) (* 2 a)) [1 2 3]) -;=>(2 4 6) - -(map (fn* [& args] (list? args)) [1 2]) -;=>(true true) - -;; Testing vector functions - -(vector? [10 11]) -;=>true -(vector? '(12 13)) -;=>false -(vector 3 4 5) -;=>[3 4 5] - -(map? {}) -;=>true -(map? '()) -;=>false -(map? []) -;=>false -(map? 'abc) -;=>false -(map? :abc) -;=>false - -;; -;; Testing hash-maps -(hash-map "a" 1) -;=>{"a" 1} - -{"a" 1} -;=>{"a" 1} - -(assoc {} "a" 1) -;=>{"a" 1} - -(get (assoc (assoc {"a" 1 } "b" 2) "c" 3) "a") -;=>1 - -(def! hm1 (hash-map)) -;=>{} - -(map? hm1) -;=>true -(map? 1) -;=>false -(map? "abc") -;=>false - -(get nil "a") -;=>nil - -(get hm1 "a") -;=>nil - -(contains? hm1 "a") -;=>false - -(def! hm2 (assoc hm1 "a" 1)) -;=>{"a" 1} - -(get hm1 "a") -;=>nil - -(contains? hm1 "a") -;=>false - -(get hm2 "a") -;=>1 - -(contains? hm2 "a") -;=>true - - -;;; TODO: fix. Clojure returns nil but this breaks mal impl -(keys hm1) -;=>() - -(keys hm2) -;=>("a") - -;;; TODO: fix. Clojure returns nil but this breaks mal impl -(vals hm1) -;=>() - -(vals hm2) -;=>(1) - -(count (keys (assoc hm2 "b" 2 "c" 3))) -;=>3 - -;; Testing keywords as hash-map keys -(get {:abc 123} :abc) -;=>123 -(contains? {:abc 123} :abc) -;=>true -(contains? {:abcd 123} :abc) -;=>false -(assoc {} :bcd 234) -;=>{:bcd 234} -(keyword? (nth (keys {:abc 123 :def 456}) 0)) -;=>true -;;; TODO: support : in strings in make impl -;;;(keyword? (nth (keys {":abc" 123 ":def" 456}) 0)) -;;;;=>false -(keyword? (nth (vals {"a" :abc "b" :def}) 0)) -;=>true - -;; Testing whether assoc updates properly -(def! hm4 (assoc {:a 1 :b 2} :a 3 :c 1)) -(get hm4 :a) -;=>3 -(get hm4 :b) -;=>2 -(get hm4 :c) -;=>1 - -;; Testing nil as hash-map values -(contains? {:abc nil} :abc) -;=>true -(assoc {} :bcd nil) -;=>{:bcd nil} - -;; -;; Additional str and pr-str tests - -(str "A" {:abc "val"} "Z") -;=>"A{:abc val}Z" - -(str true "." false "." nil "." :keyw "." 'symb) -;=>"true.false.nil.:keyw.symb" - -(pr-str "A" {:abc "val"} "Z") -;=>"\"A\" {:abc \"val\"} \"Z\"" - -(pr-str true "." false "." nil "." :keyw "." 'symb) -;=>"true \".\" false \".\" nil \".\" :keyw \".\" symb" - -(def! s (str {:abc "val1" :def "val2"})) -(or (= s "{:abc val1 :def val2}") (= s "{:def val2 :abc val1}")) -;=>true - -(def! p (pr-str {:abc "val1" :def "val2"})) -(or (= p "{:abc \"val1\" :def \"val2\"}") (= p "{:def \"val2\" :abc \"val1\"}")) -;=>true - -;; -;; Test extra function arguments as Mal List (bypassing TCO with apply) -(apply (fn* (& more) (list? more)) [1 2 3]) -;=>true -(apply (fn* (& more) (list? more)) []) -;=>true -(apply (fn* (a & more) (list? more)) [1]) -;=>true - -;>>> soft=True -;>>> optional=True -;; -;; ------- Optional Functionality -------------- -;; ------- (Not needed for self-hosting) ------- - - -;;;TODO: fix so long lines don't trigger ANSI escape codes ;;;(try* -;;;(try* (throw ["data" "foo"]) (catch* exc (do (prn "exc is:" exc) 7))) ;;;; -;;;; "exc is:" ["data" "foo"] ;;;;=>7 -;;;;=>7 - -;; -;; Testing try* without catch* -(try* xyz) -;/.*\'?xyz\'? not found.* - -;; -;; Testing throwing non-strings -(try* (throw (list 1 2 3)) (catch* exc (do (prn "err:" exc) 7))) -;/"err:" \(1 2 3\) -;=>7 - -;; -;; Testing dissoc -(def! hm3 (assoc hm2 "b" 2)) -(count (keys hm3)) -;=>2 -(count (vals hm3)) -;=>2 -(dissoc hm3 "a") -;=>{"b" 2} -(dissoc hm3 "a" "b") -;=>{} -(dissoc hm3 "a" "b" "c") -;=>{} -(count (keys hm3)) -;=>2 - -(dissoc {:cde 345 :fgh 456} :cde) -;=>{:fgh 456} -(dissoc {:cde nil :fgh 456} :cde) -;=>{:fgh 456} - -;; -;; Testing equality of hash-maps -(= {} {}) -;=>true -(= {:a 11 :b 22} (hash-map :b 22 :a 11)) -;=>true -(= {:a 11 :b [22 33]} (hash-map :b [22 33] :a 11)) -;=>true -(= {:a 11 :b {:c 33}} (hash-map :b {:c 33} :a 11)) -;=>true -(= {:a 11 :b 22} (hash-map :b 23 :a 11)) -;=>false -(= {:a 11 :b 22} (hash-map :a 11)) -;=>false -(= {:a [11 22]} {:a (list 11 22)}) -;=>true -(= {:a 11 :b 22} (list :a 11 :b 22)) -;=>false -(= {} []) -;=>false -(= [] {}) -;=>false - diff --git a/mal/tests/stepA_mal.mal b/mal/tests/stepA_mal.mal deleted file mode 100644 index ac8a717..0000000 --- a/mal/tests/stepA_mal.mal +++ /dev/null @@ -1,276 +0,0 @@ -;;; -;;; See IMPL/tests/stepA_mal.mal for implementation specific -;;; interop tests. -;;; - - -;; -;; Testing readline -(readline "mal-user> ") -"hello" -;=>"\"hello\"" - -;; -;; Testing *host-language* -;;; each impl is different, but this should return false -;;; rather than throwing an exception -(= "something bogus" *host-language*) -;=>false - - -;>>> deferrable=True -;; -;; ------- Deferrable Functionality ---------- -;; ------- (Needed for self-hosting) ------- - -;; -;; Testing metadata on functions - -;; -;; Testing metadata on mal functions - -(meta (fn* (a) a)) -;=>nil - -(meta (with-meta (fn* (a) a) {"b" 1})) -;=>{"b" 1} - -(meta (with-meta (fn* (a) a) "abc")) -;=>"abc" - -(def! l-wm (with-meta (fn* (a) a) {"b" 2})) -(meta l-wm) -;=>{"b" 2} - -(meta (with-meta l-wm {"new_meta" 123})) -;=>{"new_meta" 123} -(meta l-wm) -;=>{"b" 2} - -(def! f-wm (with-meta (fn* [a] (+ 1 a)) {"abc" 1})) -(meta f-wm) -;=>{"abc" 1} - -(meta (with-meta f-wm {"new_meta" 123})) -;=>{"new_meta" 123} -(meta f-wm) -;=>{"abc" 1} - -(def! f-wm2 ^{"abc" 1} (fn* [a] (+ 1 a))) -(meta f-wm2) -;=>{"abc" 1} - -;; Meta of native functions should return nil (not fail) -(meta +) -;=>nil - - -;; -;; Make sure closures and metadata co-exist -(def! gen-plusX (fn* (x) (with-meta (fn* (b) (+ x b)) {"meta" 1}))) -(def! plus7 (gen-plusX 7)) -(def! plus8 (gen-plusX 8)) -(plus7 8) -;=>15 -(meta plus7) -;=>{"meta" 1} -(meta plus8) -;=>{"meta" 1} -(meta (with-meta plus7 {"meta" 2})) -;=>{"meta" 2} -(meta plus8) -;=>{"meta" 1} - -;; -;; Testing hash-map evaluation and atoms (i.e. an env) -(def! e (atom {"+" +})) -(swap! e assoc "-" -) -( (get @e "+") 7 8) -;=>15 -( (get @e "-") 11 8) -;=>3 -(swap! e assoc "foo" (list)) -(get @e "foo") -;=>() -(swap! e assoc "bar" '(1 2 3)) -(get @e "bar") -;=>(1 2 3) - -;; ------------------------------------------------------------------ - -;>>> soft=True -;>>> optional=True -;; -;; ------- Optional Functionality -------------- -;; ------- (Not needed for self-hosting) ------- - -;; -;; Testing string? function -(string? "") -;=>true -(string? 'abc) -;=>false -(string? "abc") -;=>true -(string? :abc) -;=>false -(string? (keyword "abc")) -;=>false -(string? 234) -;=>false -(string? nil) -;=>false - -;; Testing number? function -(number? 123) -;=>true -(number? -1) -;=>true -(number? nil) -;=>false -(number? false) -;=>false -(number? "123") -;=>false - -(def! add1 (fn* (x) (+ x 1))) - -;; Testing fn? function -(fn? +) -;=>true -(fn? add1) -;=>true -(fn? cond) -;=>false -(fn? "+") -;=>false -(fn? :+) -;=>false - -;; Testing macro? function -(macro? cond) -;=>true -(macro? +) -;=>false -(macro? add1) -;=>false -(macro? "+") -;=>false -(macro? :+) -;=>false - - -;; -;; Testing conj function -(conj (list) 1) -;=>(1) -(conj (list 1) 2) -;=>(2 1) -(conj (list 2 3) 4) -;=>(4 2 3) -(conj (list 2 3) 4 5 6) -;=>(6 5 4 2 3) -(conj (list 1) (list 2 3)) -;=>((2 3) 1) - -(conj [] 1) -;=>[1] -(conj [1] 2) -;=>[1 2] -(conj [2 3] 4) -;=>[2 3 4] -(conj [2 3] 4 5 6) -;=>[2 3 4 5 6] -(conj [1] [2 3]) -;=>[1 [2 3]] - -;; -;; Testing seq function -(seq "abc") -;=>("a" "b" "c") -(apply str (seq "this is a test")) -;=>"this is a test" -(seq '(2 3 4)) -;=>(2 3 4) -(seq [2 3 4]) -;=>(2 3 4) - -(seq "") -;=>nil -(seq '()) -;=>nil -(seq []) -;=>nil -(seq nil) -;=>nil - -;; -;; Testing metadata on collections - -(meta [1 2 3]) -;=>nil - -(with-meta [1 2 3] {"a" 1}) -;=>[1 2 3] - -(meta (with-meta [1 2 3] {"a" 1})) -;=>{"a" 1} - -(vector? (with-meta [1 2 3] {"a" 1})) -;=>true - -(meta (with-meta [1 2 3] "abc")) -;=>"abc" - -(meta (with-meta (list 1 2 3) {"a" 1})) -;=>{"a" 1} - -(list? (with-meta (list 1 2 3) {"a" 1})) -;=>true - -(meta (with-meta {"abc" 123} {"a" 1})) -;=>{"a" 1} - -(map? (with-meta {"abc" 123} {"a" 1})) -;=>true - -;;; Not actually supported by Clojure -;;;(meta (with-meta (atom 7) {"a" 1})) -;;;;=>{"a" 1} - -(def! l-wm (with-meta [4 5 6] {"b" 2})) -;=>[4 5 6] -(meta l-wm) -;=>{"b" 2} - -(meta (with-meta l-wm {"new_meta" 123})) -;=>{"new_meta" 123} -(meta l-wm) -;=>{"b" 2} - -;; -;; Testing metadata on builtin functions -(meta +) -;=>nil -(def! f-wm3 ^{"def" 2} +) -(meta f-wm3) -;=>{"def" 2} -(meta +) -;=>nil - -;; -;; Testing gensym and clean or macro -(= (gensym) (gensym)) -;=>false -(let* [or_FIXME 23] (or false (+ or_FIXME 100))) -;=>123 - -;; -;; Testing time-ms function -(def! start-time (time-ms)) -(= start-time 0) -;=>false -(let* [sumdown (fn* (N) (if (> N 0) (+ N (sumdown (- N 1))) 0))] (sumdown 10)) ; Waste some time -;=>55 -(> (time-ms) start-time) -;=>true diff --git a/mal/tests/test.txt b/mal/tests/test.txt deleted file mode 100644 index 0f24bc0..0000000 --- a/mal/tests/test.txt +++ /dev/null @@ -1 +0,0 @@ -A line of text diff --git a/malcc.c b/malcc.c deleted file mode 100644 index 7901605..0000000 --- a/malcc.c +++ /dev/null @@ -1,1066 +0,0 @@ -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#include "core.h" -#include "env.h" -#include "printer.h" -#include "reader.h" -#include "util.h" - -char program_template[] = -"#include \"env.h\"\n" -"#include \"printer.h\"\n" -"#include \"reader.h\"\n" -"#include \"tcclib.h\"\n" -"#include \"types.h\"\n" -"#include \"util.h\"\n" -"{{TOP_CODE}}\n" -"MalType* EVAL(MalEnv *env0) {\n" -" {{EVAL_CODE}}\n" -"}\n"; - -char aot_template[] = -"int main(int argc, char *argv[]) {\n" -" MalType *arg_vec = program_arguments_as_vector(argc, argv);\n" -" MalEnv *env = build_top_env();\n" -" add_core_ns_to_env(env);\n" -" env_set(env, \"*ARGV*\", mal_vector_to_list(arg_vec));\n" -" env_set(env, \"*host-language*\", mal_string(\"malcc\"));\n" -" MalType *result = trampoline(EVAL(env));\n" -" if (is_error(result)) {\n" -" printf(\"ERROR: %s\\n\", pr_str(result->error_val, 0));\n" -" }\n" -"}\n"; - -char builtin_defs[] = -"(do" -" (def! *gensym-counter* (atom 0))" -" (def! gensym (fn* [] (symbol (str \"G__\" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))" -" (defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))" -" (def! not (fn* (a) (if a false true)))" -" (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs))))))))"; - -int compile_eval(MalType *ast, MalEnv *env, int *var_num, MalType* (**EVAL)(MalEnv *env)); -int gen_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num, int quoting); -int gen_call_args_code(MalType *args_name, MalType *node, MalEnv *env, struct codegen *code, int *var_num); -int gen_call_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_closure_code(MalType *fn_name, MalEnv *env, struct codegen *code, int ret); -int gen_continuation_code(char *prefix, MalType *node, MalEnv *env, struct codegen *code, int ret, int trampoline, int *var_num); -int gen_def_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_do_code(MalType *list, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_fn_code(MalType *fn_name, MalType *node, MalEnv *env, struct codegen *code, int *var_num, int new_env); -int gen_hashmap_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_if_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_keyword_code(MalType *node, struct codegen *code, int ret); -int gen_lambda_code(MalType *node, struct codegen *code, int ret); -int gen_let_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_list_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num, int quoting); -int gen_load_file(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_number_code(MalType *node, struct codegen *code, int ret); -int gen_string_code(MalType *node, struct codegen *code, int ret); -int gen_regex_code(MalType *node, struct codegen *code, int ret); -int gen_symbol_code(MalType *node, struct codegen *code, int ret); -int gen_symbol_lookup_code(MalType *node, MalEnv *env, struct codegen *code, int ret); -int gen_try_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_vector_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -MalType* quasiquote(MalType *node); -int is_macro_call(MalType *node, MalEnv *env); -void defmacro(MalType *node, MalEnv *env); -MalType* macroexpand(MalType *ast, MalEnv *env); -void append_code(MalType *code, MalType *temp_code, int ret); -MalType* next_var_name(char *base, int *var_num); -MalType* build_env_name(MalEnv *env); - -MalType* READ(char *str) { - return read_str(str); -} - -MalType* EVAL(MalType *ast, MalEnv *repl_env) { - MalType* (*EVAL)(MalEnv *env); - int var_num = 1; - if (compile_eval(ast, repl_env, &var_num, &EVAL)) { - return trampoline(EVAL(repl_env)); - } else { - printf("There was an error compiling.\n"); - return mal_blank_line(); - } -} - -MalType* user_eval(MalEnv *repl_env, size_t argc, MalType **args) { - mal_assert(argc == 1, "Expected 1 argument to eval"); - MalType* (*EVAL)(MalEnv *env); - MalType *ast = args[0]; - int var_num = 1; - if (compile_eval(ast, repl_env, &var_num, &EVAL)) { - return trampoline(EVAL(repl_env)); - } else { - return mal_error(mal_string("There was an error compiling.")); - } -} - -char *PATH = NULL; - -TCCState* tcc_new_state() { - TCCState *s = tcc_new(); - if (!s) { - fprintf(stderr, "Could not create tcc state\n"); - return 0; - } - if (access("./tinycc/libtcc.h", F_OK) != -1) { - tcc_set_lib_path(s, "./tinycc"); - tcc_add_include_path(s, "./tinycc"); - tcc_add_include_path(s, "."); - } else if (PATH) { - tcc_set_lib_path(s, mal_sprintf("%s/tinycc", PATH)->str); - tcc_add_include_path(s, mal_sprintf("%s/tinycc", PATH)->str); - tcc_add_include_path(s, PATH); - } else { - printf("Could not determine path to tinycc and libtcc.h\n"); - exit(1); - } - return s; -} - -int compile_eval(MalType *ast, MalEnv *env, int *var_num, MalType* (**EVAL)(MalEnv *env)) { - struct codegen code = { mal_string(""), mal_string(""), mal_string("") }; - int success = gen_code(ast, env, &code, 1, var_num, 0); - - if (!success) { - return 0; - } - - MalType *generated = mal_string_replace(mal_string(program_template), "{{TOP_CODE}}", code.top->str); - - MalType *combined = code.decl; - mal_string_append_mal_string(combined, code.body); - generated = mal_string_replace(generated, "{{EVAL_CODE}}", combined->str); - - if (getenv("DEBUG")) { - printf("-----------------\n%s-----------------\n", generated->str); - } - - TCCState *s = tcc_new_state(); - tcc_set_output_type(s, TCC_OUTPUT_MEMORY); - - if (tcc_compile_string(s, string(generated->str)) == -1) { - fprintf(stderr, "Could not compile program\n"); - return 0; - } - - tcc_add_symbol(s, "build_env", build_env); - tcc_add_symbol(s, "env_get", env_get); - tcc_add_symbol(s, "env_set", env_set); - tcc_add_symbol(s, "mal_blank_line", mal_blank_line); - tcc_add_symbol(s, "mal_closure", mal_closure); - tcc_add_symbol(s, "mal_continuation", mal_continuation); - tcc_add_symbol(s, "mal_continuation_0", mal_continuation_0); - tcc_add_symbol(s, "mal_continuation_1", mal_continuation_1); - tcc_add_symbol(s, "mal_empty", mal_empty); - tcc_add_symbol(s, "mal_error", mal_error); - tcc_add_symbol(s, "mal_false", mal_false); - tcc_add_symbol(s, "mal_hashmap", mal_hashmap); - tcc_add_symbol(s, "mal_hashmap_put", mal_hashmap_put); - tcc_add_symbol(s, "mal_keyword", mal_keyword); - tcc_add_symbol(s, "mal_nil", mal_nil); - tcc_add_symbol(s, "mal_number", mal_number); - tcc_add_symbol(s, "mal_regex", mal_regex); - tcc_add_symbol(s, "mal_sprintf", mal_sprintf); - tcc_add_symbol(s, "mal_string", mal_string); - tcc_add_symbol(s, "mal_symbol", mal_symbol); - tcc_add_symbol(s, "mal_true", mal_true); - tcc_add_symbol(s, "mal_vector", mal_vector); - tcc_add_symbol(s, "mal_vector_push", mal_vector_push); - tcc_add_symbol(s, "mal_vector_to_list", mal_vector_to_list); - tcc_add_symbol(s, "pr_str", pr_str); - tcc_add_symbol(s, "trampoline", trampoline); - - int size = tcc_relocate(s, NULL); - if (size < 0) { - fprintf(stderr, "Could not determine size of program\n"); - return 0; - } - - void *mem = GC_MALLOC(size); - if (tcc_relocate(s, mem) < 0) { - fprintf(stderr, "Could not relocate program\n"); - return 0; - } - - *EVAL = tcc_get_symbol(s, "EVAL"); - tcc_delete(s); - - if (!*EVAL) { - fprintf(stderr, "Could not find symbol EVAL\n"); - return 0; - } - - return 1; -} - -int gen_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num, int quoting) { - switch (node->type) { - case MAL_CONS_TYPE: - if (quoting) { - return gen_list_code(node, env, code, ret, var_num, quoting); - } else { - return gen_call_code(node, env, code, ret, var_num); - } - case MAL_EMPTY_TYPE: - append_code(code->body, mal_string("mal_empty()"), ret); - return 1; - case MAL_FALSE_TYPE: - append_code(code->body, mal_string("mal_false()"), ret); - return 1; - case MAL_HASHMAP_TYPE: - return gen_hashmap_code(node, env, code, ret, var_num); - case MAL_KEYWORD_TYPE: - return gen_keyword_code(node, code, ret); - case MAL_LAMBDA_TYPE: - return gen_lambda_code(node, code, ret); - case MAL_NIL_TYPE: - append_code(code->body, mal_string("mal_nil()"), ret); - return 1; - case MAL_NUMBER_TYPE: - return gen_number_code(node, code, ret); - case MAL_STRING_TYPE: - return gen_string_code(node, code, ret); - case MAL_REGEX_TYPE: - return gen_regex_code(node, code, ret); - case MAL_SYMBOL_TYPE: - if (quoting) { - return gen_symbol_code(node, code, ret); - } else { - return gen_symbol_lookup_code(node, env, code, ret); - } - case MAL_TRUE_TYPE: - append_code(code->body, mal_string("mal_true()"), ret); - return 1; - case MAL_VECTOR_TYPE: - return gen_vector_code(node, env, code, ret, var_num); - case MAL_ERROR_TYPE: - printf("unhandled error during code gen: %s\n", pr_str(node->error_val, 1)); - return 0; - default: - printf("unknown node type in code gen type=%d\n", node->type); - return 0; - } -} - -int gen_call_args_code(MalType *args_name, MalType *node, MalEnv *env, struct codegen *code, int *var_num) { - if (is_empty(node)) { - append_code(code->decl, mal_sprintf("MalType **%S = NULL;", args_name), 0); - return 1; - } - assert(is_cons(node)); - size_t arg_count = mal_list_len(node), index = 0; - MalType *temp_code = mal_sprintf("MalType **%S = GC_MALLOC(sizeof(MalType*) * %z);\n ", args_name, arg_count); - struct codegen code2; - while (!is_empty(node)) { - assert(is_cons(node)); - mal_string_append_mal_string(temp_code, mal_sprintf("%S[%z] = bubble_if_error(", args_name, index)); - code2 = (struct codegen){ code->top, code->decl, temp_code }; - if (!gen_code(mal_car(node), env, &code2, 0, var_num, 0)) { - return 0; - } - mal_string_append(temp_code, ");\n "); - node = mal_cdr(node); - index++; - } - append_code(code->decl, temp_code, 0); - return 1; -} - -int gen_call_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - node = macroexpand(node, env); - if (!is_cons(node)) { - return gen_code(node, env, code, ret, var_num, 0); - } - - MalType *sym = mal_car(node), *temp_code, *fn_name; - - if (is_symbol(sym)) { - if (strcmp(sym->symbol, "def!") == 0) { - return gen_def_code(mal_cdr(node), env, code, ret, var_num); - } else if (strcmp(sym->symbol, "let*") == 0) { - return gen_let_code(mal_cdr(node), env, code, ret, var_num); - } else if (strcmp(sym->symbol, "do") == 0) { - return gen_do_code(mal_cdr(node), env, code, ret, var_num); - } else if (strcmp(sym->symbol, "if") == 0) { - return gen_if_code(mal_cdr(node), env, code, ret, var_num); - } else if (strcmp(sym->symbol, "fn*") == 0) { - fn_name = next_var_name("fn", var_num); - if (!gen_fn_code(fn_name, mal_cdr(node), env, code, var_num, 1)) { - return 0; - } - return gen_closure_code(fn_name, env, code, ret); - } else if (strcmp(sym->symbol, "quote") == 0) { - return gen_code(mal_car(mal_cdr(node)), env, code, ret, var_num, 1); - } else if (strcmp(sym->symbol, "quasiquote") == 0) { - return gen_code(quasiquote(mal_car(mal_cdr(node))), env, code, ret, var_num, 0); - } else if (strcmp(sym->symbol, "defmacro!") == 0) { - defmacro(mal_cdr(node), env); - append_code(code->body, mal_string("mal_blank_line()"), ret); - return 1; - } else if (strcmp(sym->symbol, "macroexpand") == 0) { - node = macroexpand(mal_car(mal_cdr(node)), env); - return gen_code(node, env, code, ret, var_num, 1); - } else if (strcmp(sym->symbol, "try*") == 0) { - return gen_try_code(mal_cdr(node), env, code, ret, var_num); - } else if (strcmp(sym->symbol, "load-file") == 0) { - return gen_load_file(mal_car(mal_cdr(node)), env, code, ret, var_num); - } - } else if (is_regex(sym)) { - return gen_call_code(mal_cons(mal_symbol("regex-match"), node), env, code, ret, var_num); - } - - // look up the lambda in the env - MalType *lambda_name = next_var_name("lambda", var_num); - temp_code = mal_string("MalType *"); - mal_string_append_mal_string(temp_code, lambda_name); - mal_string_append(temp_code, " = "); - struct codegen code2 = { code->top, code->decl, temp_code }; - if (!gen_code(sym, env, &code2, 0, var_num, 0)) { - return 0; - } - mal_string_append(temp_code, ";\n "); - mal_string_append_mal_string( - temp_code, - mal_sprintf( - "if (!is_lambda(%S)) { return mal_error(mal_sprintf(\"%%s is not callable\", pr_str(%S, 1))); }\n ", - lambda_name, - lambda_name - ) - ); - append_code(code->decl, temp_code, 0); - - // build the args array - MalType *args_name, *args_node = mal_cdr(node); - size_t args_count = mal_list_len(args_node); - if (args_count == 0) { - args_name = mal_string("NULL"); - } else { - args_name = mal_string_replace(lambda_name, "lambda", "args"); - if (!gen_call_args_code(args_name, args_node, env, code, var_num)) { - return 0; - } - } - - // return the functional call as a continuation - temp_code = mal_sprintf( - "mal_continuation(%S->fn, %S->env, %z, %S)", - lambda_name, - lambda_name, - args_count, - args_name - ); - - append_code( - code->body, - ret ? temp_code : mal_sprintf("trampoline(%S)", temp_code), - ret - ); - - return 1; -} - -int gen_closure_code(MalType *fn_name, MalEnv *env, struct codegen *code, int ret) { - MalType *closure_name = mal_string("closure_"); - mal_string_append_mal_string(closure_name, fn_name); - MalType *temp_code = mal_sprintf( - "MalType *%S = mal_closure(%S, %S);\n ", - closure_name, - fn_name, - build_env_name(env) - ); - append_code(code->decl, temp_code, 0); - append_code(code->body, closure_name, ret); - return 1; -} - -int gen_continuation_code(char *prefix, MalType *node, MalEnv *env, struct codegen *code, int ret, int trampoline, int *var_num) { - MalType *fn = mal_cons(mal_empty(), mal_cons(node, mal_empty())); - MalType *fn_name = next_var_name(prefix, var_num); - if (!gen_fn_code(fn_name, fn, env, code, var_num, 0)) { - return 0; - } - MalType *temp_code = mal_string(""); - append_code(temp_code, mal_sprintf("mal_continuation(%S, %S, 0, NULL)", fn_name, build_env_name(env)), 0); - append_code(code->body, trampoline ? temp_code : mal_sprintf("trampoline(%S)", temp_code), ret); - return 1; -} - -int gen_def_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *env_name = build_env_name(env); - MalType *name = mal_car(node); - assert(is_symbol(name)); - char *name_str = pr_str(mal_string(name->symbol), 1); - - int key_already_exists = !!env_get(env, name->symbol); - if (!key_already_exists) env_set(env, name->symbol, mal_true()); - struct codegen code2 = (struct codegen){ code->top, code->decl, mal_string("") }; - MalType *val_node = mal_car(mal_cdr(node)); - if (!gen_code(val_node, env, &code2, 0, var_num, 0)) { - if (!key_already_exists) env_delete(env, name->symbol); - return 0; - } - - MalType *temp_code = mal_sprintf("env_set(%S, %s, bubble_if_error(%S))", env_name, name_str, code2.body); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_do_code(MalType *list, MalEnv *env, struct codegen *code, int ret, int *var_num) { - struct list_or_vector_iter *iter; - struct codegen code2; - MalType *node, *temp_decl, *temp_code; - int is_last = 0; - for (iter = list_or_vector_iter(list); iter; iter = list_or_vector_iter_next(iter)) { - temp_decl = mal_string(""); - temp_code = mal_string(""); - node = list_or_vector_iter_get_obj(iter); - is_last = list_or_vector_iter_is_last(iter); - code2 = (struct codegen){ code->top, temp_decl, temp_code }; - if (is_last) { - if (!gen_continuation_code("do", node, env, &code2, ret, ret, var_num)) { - return 0; - } - } else { - if (!gen_code(node, env, &code2, 0, var_num, 0)) { - return 0; - } - } - if (is_last) { - append_code(code->decl, temp_decl, 0); - append_code(code->body, temp_code, 0); - } else { - mal_string_append(temp_code, ";\n "); - append_code(code->decl, temp_decl, 0); - append_code(code->decl, temp_code, 0); - } - } - return 1; -} - -int gen_fn_code(MalType *fn_name, MalType *node, MalEnv *env, struct codegen *code, int *var_num, int new_env) { - MalType *args = mal_car(node); - size_t arg_count = list_or_vector_len(args); - - // function header - MalType *temp_fn = mal_sprintf("MalType* %S(MalEnv *env, size_t argc, MalType **args) {\n ", fn_name); - - // inner env - MalEnv *inner_env; - MalType *inner_env_name; - if (new_env) { - inner_env = build_env(env); - inner_env->num = (*var_num)++; - inner_env_name = build_env_name(inner_env); - mal_string_append_mal_string(temp_fn, mal_sprintf("MalEnv *%S = build_env(env);\n ", inner_env_name)); - } else { - inner_env = env; - inner_env_name = build_env_name(env); - mal_string_append_mal_string(temp_fn, mal_sprintf("MalEnv *%S = env;\n ", inner_env_name)); - } - - // arity check - int more_pos = list_or_vector_index_of(args, mal_symbol("&")); - if (more_pos == -1) { - mal_string_append_mal_string( - temp_fn, - mal_sprintf("mal_assert(argc == %i, \"Arity mismatch.\");\n ", arg_count) - ); - } else { - mal_string_append_mal_string( - temp_fn, - mal_sprintf("mal_assert(argc >= %i, \"Arity mismatch.\");\n ", more_pos) - ); - } - - // set arguments in inner env - if (arg_count > 0) { - struct list_or_vector_iter *iter; - MalType *arg; - size_t index = 0; - int is_more = 0; - for (iter = list_or_vector_iter(args); iter; iter = list_or_vector_iter_next(iter)) { - arg = list_or_vector_iter_get_obj(iter); - assert(is_symbol(arg)); - if (strcmp("&", arg->symbol) == 0) { - is_more = 1; - continue; - } - if (is_more) { - // accumulate remaining args in a list - char *more_name = arg->symbol; - mal_string_append(temp_fn, "MalType *rest_args = mal_vector();\n "); - mal_string_append_mal_string( - temp_fn, - mal_sprintf("for(size_t arg_i=%z; arg_isymbol), 1), - index - ) - ); - env_set(inner_env, arg->symbol, mal_true()); - index++; - } - } - } - - // function body - MalType *fn_decl = mal_string(""); - MalType *fn_code = mal_string(""); - struct codegen code2 = (struct codegen){ code->top, fn_decl, fn_code }; - MalType *fn_body = mal_cdr(node); - assert(!is_empty(fn_body)); - if (!gen_code(mal_car(fn_body), inner_env, &code2, 1, var_num, 0)) { - return 0; - } - append_code(temp_fn, fn_decl, 0); - append_code(temp_fn, fn_code, 0); - - // closing brace - mal_string_append(temp_fn, "\n}\n\n"); - append_code(code->top, temp_fn, 0); - - return 1; -} - -int gen_hashmap_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - int len = mal_hashmap_size(node); - if (len == 0) { - append_code(code->body, mal_string("mal_hashmap()"), ret); - return 1; - } - - MalType *var_name = next_var_name("var", var_num); - MalType *temp_code = mal_string("MalType *"); - mal_string_append_mal_string(temp_code, var_name); - mal_string_append(temp_code, " = mal_hashmap();\n "); - - struct hashmap_iter *iter; - struct codegen code2; - char *key_str; - MalType *val; - for (iter = hashmap_iter(&node->hashmap); iter; iter = hashmap_iter_next(&node->hashmap, iter)) { - key_str = (char*)hashmap_iter_get_key(iter); - val = (MalType*)hashmap_iter_get_data(iter); - mal_string_append(temp_code, "mal_hashmap_put("); - mal_string_append_mal_string(temp_code, var_name); - mal_string_append(temp_code, ", "); - code2 = (struct codegen){ code->top, code->decl, temp_code }; - if (!gen_code(read_str(key_str), env, &code2, 0, var_num, 0)) { - return 0; - } - mal_string_append(temp_code, ", "); - code2 = (struct codegen){ code->top, code->decl, temp_code }; - if (!gen_code(val, env, &code2, 0, var_num, 0)) { - return 0; - } - mal_string_append(temp_code, ");\n "); - } - - append_code(code->decl, temp_code, 0); - append_code(code->body, var_name, ret); - return 1; -} - -int gen_if_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *cond_code = mal_string(""); - struct codegen code2 = (struct codegen){ code->top, code->decl, cond_code }; - if (!gen_code(mal_car(node), env, &code2, 0, var_num, 0)) { - return 0; - } - node = mal_cdr(node); - MalType *true_code = mal_string(""); - code2.body = true_code; - MalType *true_val = mal_car(node); - if (is_primitive(true_val)) { - if (!gen_code(true_val, env, &code2, 0, var_num, 0)) { - return 0; - } - } else { - if (!gen_continuation_code("if_true", true_val, env, &code2, 0, ret, var_num)) { - return 0; - } - } - node = mal_cdr(node); - MalType *false_code = mal_string(""); - code2.body = false_code; - MalType *false_val; - if (is_empty(node)) { - false_val = mal_nil(); - } else { - false_val = mal_car(node); - } - if (is_primitive(false_val)) { - if (!gen_code(false_val, env, &code2, 0, var_num, 0)) { - return 0; - } - } else { - if (!gen_continuation_code("if_false", false_val, env, &code2, 0, ret, var_num)) { - return 0; - } - } - append_code( - code->body, - mal_sprintf("is_truthy(%S) ? %S : %S", cond_code, true_code, false_code), - ret - ); - return 1; -} - -int gen_keyword_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_keyword(%s)", pr_str(mal_string(node->keyword), 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_lambda_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("(MalType*)%p /* %s */", node, pr_str(node, 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_let_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalEnv *inner_env = build_env(env); - inner_env->num = (*var_num)++; - MalType *outer_env_name = build_env_name(env); - MalType *inner_env_name = build_env_name(inner_env); - MalType *temp_code = mal_sprintf("MalEnv *%S = build_env(%S);\n ", inner_env_name, outer_env_name); - append_code(code->decl, temp_code, 0); - - temp_code = mal_string(""); - - struct list_or_vector_iter *iter; - struct codegen code2; - MalType *name, *val, *inner_decl, *val_code; - for (iter = list_or_vector_iter(mal_car(node)); iter; iter = list_or_vector_iter_next(iter)) { - inner_decl = mal_string(""); - name = list_or_vector_iter_get_obj(iter); - assert(is_symbol(name)); - iter = list_or_vector_iter_next(iter); - val = list_or_vector_iter_get_obj(iter); - env_set(inner_env, name->symbol, mal_true()); - code2 = (struct codegen){ code->top, inner_decl, mal_string("") }; - if (!gen_code(val, inner_env, &code2, 0, var_num, 0)) { - return 0; - } - val_code = mal_sprintf("env_set(%S, %s, %S);\n ", inner_env_name, pr_str(mal_string(name->symbol), 1), code2.body); - mal_string_append_mal_string(temp_code, inner_decl); - mal_string_append_mal_string(temp_code, val_code); - } - - append_code(code->decl, temp_code, 0); - - node = mal_cdr(node); - if (!gen_continuation_code("let", mal_car(node), inner_env, code, ret, ret, var_num)) { - return 0; - } - - return 1; -} - -int gen_list_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num, int quoting) { - MalType *list_name = next_var_name("list", var_num); - MalType *temp_decl = mal_sprintf("MalType *%S = mal_vector();\n ", list_name); - struct list_or_vector_iter *iter; - MalType *item; - struct codegen code2; - for (iter = list_or_vector_iter(node); iter; iter = list_or_vector_iter_next(iter)) { - item = list_or_vector_iter_get_obj(iter); - mal_string_append_mal_string( - temp_decl, - mal_sprintf("mal_vector_push(%S, ", list_name) - ); - code2 = (struct codegen){ code->top, code->decl, temp_decl }; - if (!gen_code(item, env, &code2, 0, var_num, quoting)) { - return 0; - } - mal_string_append(temp_decl, ");\n "); - } - append_code(code->decl, temp_decl, 0); - append_code(code->body, mal_sprintf("mal_vector_to_list(%S)", list_name), ret); - return 1; -} - -int gen_load_file(MalType *filename_node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *contents = core_slurp(env, 1, &filename_node); - MalType *ast = read_str(mal_sprintf("(do %S)", contents)->str); - return gen_code(ast, env, code, ret, var_num, 0); -} - -int gen_number_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_number(%s)", pr_str(node, 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_string_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_string(%s)", pr_str(node, 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_regex_code(MalType *node, struct codegen *code, int ret) { - MalType *str = mal_string(node->regex); - MalType *temp_code = mal_sprintf("mal_regex(%s)", pr_str(str, 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_symbol_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_symbol(%s)", pr_str(mal_string(node->symbol), 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_symbol_lookup_code(MalType *node, MalEnv *env, struct codegen *code, int ret) { - UNUSED(env); - MalType *temp_code = mal_sprintf( - "bubble_if_error(env_get(%S, %s))", - build_env_name(env), - pr_str(mal_string(node->symbol), 1) - ); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_try_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *try_expr = mal_car(node); // (A (catch* B C)) - MalType *catch_node_list = mal_cdr(node); // ((catch* B C)) - if (is_empty(catch_node_list)) { - return gen_code(try_expr, env, code, ret, var_num, 0); - } - MalType *try_as_lambda_expr = mal_cons( - mal_empty(), // fn args (none) - mal_cons(try_expr, mal_empty()) // fn body - ); - MalType *try_fn_name = next_var_name("try", var_num); - if (!gen_fn_code(try_fn_name, try_as_lambda_expr, env, code, var_num, 1)) { - return 0; - } - MalType *catch_node = mal_car(catch_node_list); // (catch* B C) - assert(is_cons(catch_node)); - MalType *catch_sym = mal_car(catch_node); // catch* - assert(is_symbol(catch_sym) && strcmp(catch_sym->symbol, "catch*") == 0); - MalType *arg_name = mal_car(mal_cdr(catch_node)); // B - assert(is_symbol(arg_name)); - MalType *catch_expr = mal_car(mal_cdr(mal_cdr(catch_node))); // C - MalType *catch_fn_name = next_var_name("catch", var_num); - MalType *catch_as_lambda_expr = mal_cons( - mal_cons(arg_name, mal_empty()), // fn arg - mal_cons(catch_expr, mal_empty()) // fn body - ); - if (!gen_fn_code(catch_fn_name, catch_as_lambda_expr, env, code, var_num, 1)) { - return 0; - } - MalType *result_name = next_var_name("try_result", var_num); - MalType *try_call_code = mal_sprintf("trampoline(mal_continuation_0(%S, %S))", try_fn_name, build_env_name(env)); - MalType *catch_call_code = mal_sprintf("mal_continuation_1(%S, %S, %S->error_val)", catch_fn_name, build_env_name(env), result_name); - if (!ret) { - catch_call_code = mal_sprintf("trampoline(%S)", catch_call_code); - } - mal_string_append_mal_string( - code->decl, - mal_sprintf("MalType *%S = %S;\n ", result_name, try_call_code) - ); - append_code( - code->body, - mal_sprintf("is_error(%S) ? %S : %S", result_name, catch_call_code, result_name), - ret - ); - return 1; -} - -int gen_vector_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *var_name = next_var_name("var", var_num); - MalType *temp_code = mal_string("MalType *"); - mal_string_append_mal_string(temp_code, var_name); - mal_string_append(temp_code, " = mal_vector();\n "); - struct codegen code2; - for(size_t i=0; itop, code->decl, temp_code }; - if (!gen_code(mal_vector_ref(node, i), env, &code2, 0, var_num, 0)) { - return 0; - } - mal_string_append(temp_code, ");\n "); - } - append_code(code->decl, temp_code, 0); - append_code(code->body, var_name, ret); - return 1; -} - -MalType* quasiquote(MalType *node) { - if (!is_pair(node)) { - return mal_cons(mal_symbol("quote"), mal_cons(node, mal_empty())); - } else if (is_symbol(mal_car2(node)) && strcmp(mal_car2(node)->symbol, "unquote") == 0) { - return mal_car2(mal_cdr2(node)); - } else if (is_pair(mal_car2(node)) && is_symbol(mal_car2(mal_car2(node))) && strcmp(mal_car2(mal_car2(node))->symbol, "splice-unquote") == 0) { - return mal_cons( - mal_symbol("concat"), - mal_cons( - mal_car2(mal_cdr2(mal_car2(node))), - mal_cons( - quasiquote(mal_cdr2(node)), - mal_empty() - ) - ) - ); - } else { - return mal_cons( - mal_symbol("cons"), - mal_cons( - quasiquote(mal_car2(node)), - mal_cons( - quasiquote(mal_cdr2(node)), - mal_empty() - ) - ) - ); - } -} - -int is_macro_call(MalType *node, MalEnv *env) { - if (!is_cons(node)) { - return 0; - } - MalType *sym = mal_car(node); - if (!is_symbol(sym)) { - return 0; - } - MalType *macro = env_get(env, sym->symbol); - if (macro && macro->is_macro) { - return 1; - } else { - return 0; - } -} - -void defmacro(MalType *node, MalEnv *env) { - int var_num = 1; - MalType* (*EVAL)(MalEnv *env); - MalType *name = mal_car(node); - assert(is_symbol(name)); - node = mal_car(mal_cdr(node)); - if (!compile_eval(node, env, &var_num, &EVAL)) { - printf("Error compiling macro.\n"); - exit(1); - } - MalType *macro = trampoline(EVAL(env)); - macro->is_macro = 1; - env_set(env, name->symbol, macro); -} - -void inspect_env(MalEnv *env) { - char *key_str, *val_str; - struct hashmap_iter *iter; - for (iter = hashmap_iter(&env->data); iter; iter = hashmap_iter_next(&env->data, iter)) { - key_str = (char*)hashmap_iter_get_key(iter); - val_str = pr_str((MalType*)hashmap_iter_get_data(iter), 1); - printf("%s=%s\n", key_str, val_str); - } -} - -MalType* macroexpand(MalType *ast, MalEnv *env) { - MalType *name, *macro, *arg_list, **args; - size_t argc; - while (is_macro_call(ast, env)) { - name = mal_car(ast); - macro = env_get(env, name->symbol); - arg_list = mal_cdr(ast); - argc = mal_list_len(arg_list); - if (argc > 0) { - args = GC_MALLOC(sizeof(MalType*) * argc); - for (size_t i=0; ifn, macro->env, argc, args)); - assert(ast != NULL); - } - return ast; -} - -void append_code(MalType *code, MalType *temp_code, int ret) { - if (ret) mal_string_append(code, "return "); - mal_string_append_mal_string(code, temp_code); - if (ret) mal_string_append(code, ";"); -} - -MalType* next_var_name(char *base, int *var_num) { - MalType *var_name = mal_string(base); - mal_string_append_long_long(var_name, (*var_num)++); - return var_name; -} - -MalType* build_env_name(MalEnv *env) { - MalType *name = mal_string("env"); - mal_string_append_long_long(name, env->num); - return name; -} - -char* PRINT(MalType *ast) { - return pr_str(ast, 2); -} - -void rep(char *str, MalEnv *repl_env, int print_result) { - MalType *ast = READ(str); - if (is_error(ast)) { - printf("%s\n", mal_sprintf("ERROR: %s", pr_str(ast->error_val, 0))->str); - } - MalType *result = EVAL(ast, repl_env); - if (is_error(result)) { - printf("%s\n", mal_sprintf("ERROR: %s", pr_str(result->error_val, 0))->str); - } else { - char *out = PRINT(result); - if (print_result) printf("%s\n", out); - } -} - -char *parent_directory(char *bin_path) { - char *path = string(bin_path); - size_t len; - while ((len = strlen(path)) > 0 && path[len - 1] != '/') { - path[len - 1] = 0; - } - if (len > 0) path[len - 1] = 0; - if (strlen(path) == 0) { - return string("."); - } else { - return path; - } -} - -void print_help() { - printf( - "Usage: malcc [options] [filename] [outfile]\n" - "\n" - " --help print this help\n" - " --compile prog.mal outfile AOT compile the given mal file\n" - "\n" - "If run with no args, malcc starts a REPL.\n" - ); -} - -void aot_compile(MalType *arg_vec) { - if (mal_vector_len(arg_vec) < 3) { - print_help(); - printf("\nYou must supply filename to compile and output binary filename.\n"); - exit(1); - } - MalEnv *env = build_top_env(); - add_core_ns_to_env(env); - rep(builtin_defs, env, 1); - MalType *filename = mal_vector_ref(arg_vec, 1); - MalType *out_filename = mal_vector_ref(arg_vec, 2); - MalType *contents = read_file(filename->str); - MalType *ast = read_str(mal_sprintf("(do %s %S)", builtin_defs, contents)->str); - struct codegen code = { mal_string(""), mal_string(""), mal_string("") }; - int var_num = 1; - if (gen_code(ast, env, &code, 1, &var_num, 0)) { - MalType *out = mal_sprintf("%s\n%s\n", program_template, aot_template); - out = mal_string_replace(out, "{{TOP_CODE}}", code.top->str); - MalType *decl_and_body = code.decl; - mal_string_append_mal_string(decl_and_body, code.body); - out = mal_string_replace(out, "{{EVAL_CODE}}", decl_and_body->str); - FILE *f = fopen(mal_sprintf("%S.c", out_filename)->str, "w"); - fprintf(f, "%s\n", out->str); - fclose(f); - MalType *cmd = mal_string( - "gcc -g -I./tinycc -I./ -o FILENAME FILENAME.c " \ - "./reader.c ./printer.c ./hashmap.c ./types.c ./util.c ./env.c ./core.c ./tinycc/libtcc.a " \ - "-ledit -lgc -lpcre -ldl" - ); - cmd = mal_string_replace_all(cmd, "./", mal_sprintf("%s/", PATH)->str); - cmd = mal_string_replace_all(cmd, "FILENAME", out_filename->str); - fprintf(stderr, "%s\n", cmd->str); - int result = system(cmd->str); - if (result != 0) { - fprintf(stderr, "There was an error compiling.\n"); - exit(1); - } - } else { - fprintf(stderr, "There was an error compiling.\n"); - exit(1); - } -} - -int main(int argc, char *argv[]) { - PATH = parent_directory(argv[0]); - - MalEnv *repl_env = build_top_env(); - - add_core_ns_to_env(repl_env); - env_set(repl_env, "*host-language*", mal_string("malcc")); - env_set(repl_env, "eval", mal_builtin_function(user_eval, "eval", repl_env)); - - MalType *arg_vec = program_arguments_as_vector(argc, argv); - if (mal_vector_len(arg_vec) >= 1) { - if (strcmp(mal_vector_ref(arg_vec, 0)->str, "--compile") == 0) { - aot_compile(arg_vec); - exit(0); - } else if (strcmp(mal_vector_ref(arg_vec, 0)->str, "--help") == 0) { - print_help(); - exit(0); - } - } - MalType *mal_args = mal_vector_len(arg_vec) == 0 ? mal_empty() : mal_cdr(mal_vector_to_list(arg_vec)); - env_set(repl_env, "*ARGV*", mal_args); - - rep(builtin_defs, repl_env, 0); - - setlocale(LC_ALL, ""); // use locale set from environment - - if (mal_vector_len(arg_vec) >= 1) { - rep(mal_sprintf("(load-file %s)", pr_str(mal_vector_ref(arg_vec, 0), 1))->str, repl_env, 0); - } else { - rep("(println (str \"Mal [\" *host-language* \"]\"))", repl_env, 0); - char *buffer; - read_history("history.txt"); - while ((buffer = readline("user> ")) != NULL) { - rep(buffer, repl_env, 1); - if (strlen(buffer) > 0) { - add_history(buffer); - } - free(buffer); - } - write_history("history.txt"); - } - - return 0; -} diff --git a/printer.c b/printer.c deleted file mode 100644 index eaf16fd..0000000 --- a/printer.c +++ /dev/null @@ -1,186 +0,0 @@ -#include -#include -#include -#include -#include -#include - -#include "hashmap.h" -#include "printer.h" -#include "types.h" -#include "util.h" - -char *BLANK_LINE = ""; - -char* pr_str(MalType *val, int print_readably) { - char *str; - switch (val->type) { - case MAL_ATOM_TYPE: - return pr_atom(val, print_readably); - case MAL_BLANK_LINE_TYPE: - if (print_readably == 2) { - return BLANK_LINE; - } else { - str = GC_MALLOC(1); - str = 0; - return str; - } - case MAL_CONS_TYPE: - return pr_list(val, print_readably); - case MAL_CONTINUATION_TYPE: - return mal_sprintf("", val)->str; - case MAL_EMPTY_TYPE: - return string("()"); - case MAL_FALSE_TYPE: - return string("false"); - case MAL_HASHMAP_TYPE: - return pr_hashmap(val, print_readably); - case MAL_KEYWORD_TYPE: - return mal_sprintf(":%s", val->keyword)->str; - case MAL_LAMBDA_TYPE: - return string(""); - case MAL_NIL_TYPE: - return string("nil"); - case MAL_NUMBER_TYPE: - return long_long_to_string(val->number); - case MAL_REGEX_TYPE: - return pr_regex(val, print_readably); - case MAL_STRING_TYPE: - return pr_string(val, print_readably); - case MAL_SYMBOL_TYPE: - return string(val->symbol); - case MAL_TRUE_TYPE: - return string("true"); - case MAL_VECTOR_TYPE: - return pr_vector(val, print_readably); - case MAL_ERROR_TYPE: - printf("This shouldn't happen; pr_str() got mal_error(%s)\n", pr_str(val->error_val, 1)); - assert(0); - default: - printf("I don't know how to print this type: %d\n", val->type); - exit(1); - } -} - -char* pr_atom(MalType *val, int print_readably) { - return mal_sprintf("(atom %s)", pr_str(val->atom_val, print_readably))->str; -} - -char* pr_list(MalType *val, int print_readably) { - if (is_empty(val)) { - return string("()"); - } - char *item_str; - MalType *str = mal_string("("); - do { - if (is_cons(val)) { - item_str = pr_str(mal_car(val), print_readably); - mal_string_append(str, item_str); - mal_string_append_char(str, ' '); - } else { - mal_string_append(str, ". "); - mal_string_append(str, pr_str(val, print_readably)); - mal_string_append_char(str, ' '); - break; - } - } while (!is_empty(val = mal_cdr(val))); - str->str[strlen(str->str) - 1] = ')'; - return str->str; -} - -char* pr_vector(MalType *val, int print_readably) { - size_t len = mal_vector_len(val); - if (len == 0) { - return string("[]"); - } - MalType *str = mal_string("["); - char *item_str; - for(size_t i=0; istr; -} - -char* pr_hashmap(MalType *val, int print_readably) { - char *key_str, *val_str; - if (mal_hashmap_size(val) == 0) { - return string("{}"); - } - MalType *str = mal_string("{"); - struct hashmap_iter *iter; - for (iter = hashmap_iter(&val->hashmap); iter; iter = hashmap_iter_next(&val->hashmap, iter)) { - key_str = (char*)hashmap_iter_get_key(iter); - val_str = pr_str((MalType*)hashmap_iter_get_data(iter), print_readably); - mal_string_append(str, key_str); - mal_string_append_char(str, ' '); - mal_string_append(str, val_str); - mal_string_append_char(str, ' '); - } - str->str[strlen(str->str) - 1] = '}'; - return str->str; -} - -char* pr_string(MalType *val, int print_readably) { - assert(strlen(val->str) == val->str_len); - if (print_readably) { - size_t len = val->str_len; - char *orig = val->str; - MalType *repr = mal_string("\""); - for (size_t i=0; istr; - } else { - size_t len = val->str_len + 1; - char *str = GC_MALLOC(len); - snprintf(str, len, "%s", val->str); - return str; - } -} - -char* pr_regex(MalType *val, int print_readably) { - assert(strlen(val->regex) == val->regex_len); - if (print_readably) { - size_t len = val->regex_len; - char *orig = val->regex; - MalType *repr = mal_string("/"); - for (size_t i=0; istr; - } else { - size_t len = val->regex_len + 1; - char *str = GC_MALLOC(len); - snprintf(str, len, "%s", val->regex); - return str; - } -} diff --git a/printer.h b/printer.h deleted file mode 100644 index 5b2674b..0000000 --- a/printer.h +++ /dev/null @@ -1,17 +0,0 @@ -#ifndef __MAL_PRINTER__ -#define __MAL_PRINTER__ - -#include "hashmap.h" -#include "types.h" - -char *BLANK_LINE; - -char* pr_atom(MalType *val, int print_readably); -char* pr_str(MalType *val, int print_readably); -char* pr_list(MalType *val, int print_readably); -char* pr_vector(MalType *val, int print_readably); -char* pr_hashmap(MalType *val, int print_readably); -char* pr_string(MalType *val, int print_readably); -char* pr_regex(MalType *val, int print_readably); - -#endif diff --git a/reader.c b/reader.c deleted file mode 100644 index a36b071..0000000 --- a/reader.c +++ /dev/null @@ -1,374 +0,0 @@ -#include -#include -#include -#include -#include -#include - -#include "printer.h" -#include "reader.h" -#include "types.h" -#include "util.h" - -char* reader_next(Reader* reader) { - if (reader->token) { - char* str = reader->token->str; - reader->token = reader->token->next; - if (reader->token && strlen(reader->token->str) == 0) { - reader->token = NULL; - } - return str; - } else { - return NULL; - } -} - -char* reader_peek(Reader* reader) { - if (reader->token) { - return reader->token->str; - } else { - return NULL; - } -} - -Token* tokenize(char* code) { - pcre *reCompiled; - pcre_extra *pcreExtra; - int pcreExecRet; - int subStrVec[30]; - const char *pcreErrorStr; - int pcreErrorOffset; - const char *psubStrMatchStr; - size_t offset = 0; - unsigned int len = strlen(code), l; - Token *firstToken = NULL, *lastToken = NULL, *token; - char* str; - - reCompiled = pcre_compile(PATTERN, 0, &pcreErrorStr, &pcreErrorOffset, NULL); - - if(reCompiled == NULL) { - printf("ERROR: Could not compile regex: %s\n", pcreErrorStr); - exit(1); - } - - pcreExtra = pcre_study(reCompiled, PCRE_EXTENDED, &pcreErrorStr); - - if(pcreErrorStr != NULL) { - printf("ERROR: Could not study regex: %s\n", pcreErrorStr); - exit(1); - } - - while (offset < len && (pcreExecRet = pcre_exec(reCompiled, pcreExtra, code, len, offset, 0, subStrVec, 30))) { - if(pcreExecRet < 0) { - fprintf(stderr, "There was an error parsing the code\n"); - exit(1); - } - - if(pcreExecRet == 0) { - printf("Too many substrings were found to fit in subStrVec!\n"); - exit(1); - } - - token = GC_MALLOC(sizeof(Token)); - pcre_get_substring(code, subStrVec, pcreExecRet, 1, &(psubStrMatchStr)); - l = strlen(psubStrMatchStr); - if (l == 0) { - break; - } - str = string((char*)psubStrMatchStr); - token->str = str; - token->next = NULL; - if (lastToken) { - lastToken->next = token; - } - lastToken = token; - if (!firstToken) { - firstToken = token; - } - - offset = subStrVec[1]; - } - - pcre_free(reCompiled); - - if(pcreExtra != NULL) { -#ifdef PCRE_CONFIG_JIT - pcre_free_study(pcreExtra); -#else - pcre_free(pcreExtra); -#endif - } - - return firstToken; -} - -MalType* read_str(char* code) { - Reader* reader = GC_MALLOC(sizeof(Reader)); - reader->token = tokenize(code); - MalType *atom = read_form(reader); - if (is_blank_line(atom)) { - return mal_nil(); - } else { - return atom; - } -} - -MalType* read_form(Reader* reader) { - char *token = reader_peek(reader); - size_t len = strlen(token); - if (!token || len == 0) { - return mal_nil(); - } else { - switch (*token) { - case ';': - reader_next(reader); - return mal_blank_line(); - case '(': - return read_list(reader); - case '[': - return read_vector(reader); - case '{': - return read_hashmap(reader); - case '"': - return read_string(reader); - case '/': - if (len == 1) { - return read_atom(reader); - } else { - return read_regex(reader); - } - case ':': - return read_keyword(reader); - case '\'': - return read_quote(reader, "quote"); - case '~': - if (strlen(token) > 1 && *(token + 1) == '@') { - return read_quote(reader, "splice-unquote"); - } else { - return read_quote(reader, "unquote"); - } - case '`': - return read_quote(reader, "quasiquote"); - case '@': - return read_quote(reader, "deref"); - case '^': - return read_with_meta(reader); - default: - return read_atom(reader); - } - } -} - -MalType* read_keyword(Reader *reader) { - char *token = reader_next(reader); - return mal_keyword(token + 1); -} - -MalType* read_quote(Reader *reader, const char *expanded) { - reader_next(reader); // consume quote - MalType *atom = read_form(reader); - MalType *c2 = mal_cons(atom, mal_empty()); - MalType *c1 = mal_cons(mal_symbol((char*)expanded), c2); - return c1; -} - -MalType* read_with_meta(Reader *reader) { - reader_next(reader); // consume '^' - MalType *metadata = read_form(reader); - MalType *value = read_form(reader); - MalType *c3 = mal_cons(metadata, mal_empty()); - MalType *c2 = mal_cons(value, c3); - MalType *c1 = mal_cons(mal_symbol("with-meta"), c2); - return c1; -} - -MalType* read_vector(Reader *reader) { - MalType *atom; - MalType *vec = mal_vector(-1); - reader_next(reader); // consume '[' - char *token = reader_peek(reader); - while (token && *token != ']') { - atom = read_form(reader); - token = reader_peek(reader); - if (is_blank_line(atom)) continue; - mal_vector_push(vec, atom); - } - if (token) { - reader_next(reader); // consume ']' - } else { - printf("EOF\n"); - } - return vec; -} - - -MalType* read_hashmap(Reader *reader) { - reader_next(reader); // consume '{' - MalType *key, *val; - MalType *map = mal_hashmap(); - char *token = reader_peek(reader); - while (token && *token != '}') { - key = read_form(reader); - token = reader_peek(reader); - if (token && *token != '}') { - val = read_form(reader); - mal_hashmap_put(map, key, val); - } else { - printf("Odd number of hashmap items!\n"); - break; - } - token = reader_peek(reader); - } - if (token) { - reader_next(reader); // consume '}' - } else { - printf("EOF\n"); - } - return map; -} - -MalType* read_string(Reader *reader) { - char *token = reader_next(reader); - size_t len = strlen(token); - char *str = GC_MALLOC(len + 1); - size_t index = 0; - int saw_quotes = 0; - char unescaped; - for (size_t i=0; istr = string("/"); - token->next = tokenize(token_string+1); // skip the first character - Token* last = token->next; - while (last->next) last = last->next; // find the last token in the newly tokenized list - last->next = reader->token; // append our existing list on the end of it - reader->token = token; // point the reader at our newly prepended list of tokens - return read_atom(reader); - } - return mal_regex(str); -} - -MalType* read_list(Reader *reader) { - MalType *atom, *last_cons = NULL, *first_cons = NULL, *cons; - reader_next(reader); // consume '(' - char *token = reader_peek(reader); - while (token && *token != ')') { - atom = read_form(reader); - token = reader_peek(reader); - if (is_blank_line(atom)) continue; - cons = mal_cons(atom, NULL); - if (!first_cons) first_cons = cons; - if (last_cons) last_cons->cdr = cons; - last_cons = cons; - } - if (token) { - reader_next(reader); // consume ')' - } else { - printf("EOF\n"); - } - if (first_cons) { - last_cons->cdr = mal_empty(); - return first_cons; - } else { - return mal_empty(); - } -} - -MalType* read_atom(Reader* reader) { - char *token = reader_next(reader); - if (isdigit(*token) || (strlen(token) > 1 && (*token == '-' || *token == '+') && isdigit(*(token + 1)))) { - return mal_number(strtoll(token, NULL, 10)); - } else if (strcmp("nil", token) == 0) { - return mal_nil(); - } else if (strcmp("true", token) == 0) { - return mal_true(); - } else if (strcmp("false", token) == 0) { - return mal_false(); - } else { - return mal_symbol(token); - } -} diff --git a/reader.h b/reader.h deleted file mode 100644 index 1e3cd52..0000000 --- a/reader.h +++ /dev/null @@ -1,37 +0,0 @@ -#ifndef __MAL_READER__ -#define __MAL_READER__ - -#include -#include "types.h" - -typedef struct Token { - char* str; - struct Token* next; -} Token; - -typedef struct Reader { - Token* token; -} Reader; - -char* reader_next(Reader* reader); - -char* reader_peek(Reader* reader); - -static const char PATTERN[] = "[\\s,]*(~@|[\\[\\]{}()'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"?|/(?:\\\\.|[^\\\\/])*/|;.*|[^\\s\\[\\]{}('\"`,;)]*)"; - -Token* tokenize(char* code); - -MalType* read_str(char* code); -MalType* read_form(Reader* reader); -MalType* read_keyword(Reader *reader); -MalType* read_quote(Reader *reader, const char *expanded); -MalType* read_with_meta(Reader *reader); -MalType* read_list(Reader* reader); -MalType* read_vector(Reader* reader); -MalType* read_hashmap(Reader *reader); -MalType* read_string(Reader *reader); -MalType* read_regex(Reader *reader); -char unescape_char(char *token, size_t *i, size_t len); -MalType* read_atom(Reader* reader); - -#endif diff --git a/self_hosted_run b/self_hosted_run deleted file mode 100755 index e6ed005..0000000 --- a/self_hosted_run +++ /dev/null @@ -1,3 +0,0 @@ -#!/bin/bash -cd $(dirname $0)/mal/mal -../../malcc ./stepA_mal.mal "${@}" diff --git a/step0_repl.c b/step0_repl.c deleted file mode 100644 index 0133a4b..0000000 --- a/step0_repl.c +++ /dev/null @@ -1,36 +0,0 @@ -#include -#include -#include -#include - -char* READ(char *str) { - return str; -} - -char* EVAL(char *str) { - return str; -} - -char* PRINT(char *str) { - return str; -} - -char* rep(char *str) { - return PRINT(EVAL(READ(str))); -} - -int main() { - char *buffer; - - read_history("history.txt"); - while ((buffer = readline("user> ")) != NULL) { - printf("%s\n", rep(buffer)); - if (strlen(buffer) > 0) { - add_history(buffer); - } - free(buffer); - } - write_history("history.txt"); - - return 0; -} diff --git a/step1_read_print.c b/step1_read_print.c deleted file mode 100644 index d674d49..0000000 --- a/step1_read_print.c +++ /dev/null @@ -1,39 +0,0 @@ -#include -#include -#include -#include - -#include "printer.h" -#include "reader.h" - -MalType* READ(char *str) { - return read_str(str); -} - -MalType* EVAL(MalType *ast) { - return ast; -} - -char* PRINT(MalType *ast) { - return pr_str(ast, 2); -} - -char* rep(char *str) { - return PRINT(EVAL(READ(str))); -} - -int main() { - char *buffer; - - read_history("history.txt"); - while ((buffer = readline("user> ")) != NULL) { - printf("%s\n", rep(buffer)); - if (strlen(buffer) > 0) { - add_history(buffer); - } - free(buffer); - } - write_history("history.txt"); - - return 0; -} diff --git a/step2_eval.c b/step2_eval.c deleted file mode 100644 index 32bd23b..0000000 --- a/step2_eval.c +++ /dev/null @@ -1,488 +0,0 @@ -#include -#include -#include -#include -#include -#include -#include -#include - -#include "printer.h" -#include "reader.h" -#include "util.h" - -char program_template[] = -"#include \n" -"#include \n" -"#include \n" -"#include \n" -"#include \n" -"MalType* env_get(MalEnv *env, char *key);\n" -"{{TOP_CODE}}\n" -"MalType* EVAL(MalEnv *env) {\n" -" {{EVAL_CODE}}\n" -"}"; - -int compile_eval(MalType *ast, MalEnv *env, int *var_num, MalType* (**EVAL)(MalEnv *env)); -int gen_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_call_args_code(MalType *args_name, MalType *node, MalEnv *env, struct codegen *code, int *var_num); -int gen_call_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_hashmap_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_keyword_code(MalType *node, struct codegen *code, int ret); -int gen_list_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_number_code(MalType *node, struct codegen *code, int ret); -int gen_string_code(MalType *node, struct codegen *code, int ret); -int gen_symbol_code(MalType *node, struct codegen *code, int ret); -int gen_symbol_lookup_code(MalType *node, MalEnv *env, struct codegen *code, int ret); -int gen_vector_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -void append_code(MalType *code, MalType *temp_code, int ret); -MalType* next_var_name(char *base, int *var_num); -MalType* env_get(MalEnv *env, char *key); - -MalType* READ(char *str) { - return read_str(str); -} - -MalType* EVAL(MalType *ast, MalEnv *repl_env) { - MalType* (*EVAL)(MalEnv *env); - int var_num = 1; - if (compile_eval(ast, repl_env, &var_num, &EVAL)) { - return EVAL(repl_env); - } else { - printf("There was an error compiling.\n"); - return mal_blank_line(); - } -} - -char *PATH = NULL; - -int compile_eval(MalType *ast, MalEnv *env, int *var_num, MalType* (**EVAL)(MalEnv *env)) { - struct codegen code = { mal_string(""), mal_string(""), mal_string("") }; - int success = gen_code(ast, env, &code, 1, var_num); - - if (!success) { - return 0; - } - - MalType *generated = mal_string_replace(mal_string(program_template), "{{TOP_CODE}}", code.top->str); - - MalType *combined = code.decl; - mal_string_append_mal_string(combined, code.body); - generated = mal_string_replace(generated, "{{EVAL_CODE}}", combined->str); - - if (getenv("DEBUG")) { - printf("-----------------\n%s-----------------\n", generated->str); - } - - TCCState *s = tcc_new(); - if (!s) { - fprintf(stderr, "Could not create tcc state\n"); - return 0; - } - - if(access("./tinycc/libtcc.h", F_OK) != -1) { - tcc_set_lib_path(s, "./tinycc"); - tcc_add_include_path(s, "./tinycc"); - tcc_add_include_path(s, "."); - } else if(PATH) { - tcc_set_lib_path(s, mal_sprintf("%s/tinycc", PATH)->str); - tcc_add_include_path(s, mal_sprintf("%s/tinycc", PATH)->str); - tcc_add_include_path(s, PATH); - } else { - printf("Could not determine path to tinycc and libtcc.h\n"); - exit(1); - } - - tcc_set_output_type(s, TCC_OUTPUT_MEMORY); - - if (tcc_compile_string(s, string(generated->str)) == -1) { - fprintf(stderr, "Could not compile program\n"); - return 0; - } - - tcc_add_symbol(s, "env_get", env_get); - tcc_add_symbol(s, "mal_empty", mal_empty); - tcc_add_symbol(s, "mal_error", mal_error); - tcc_add_symbol(s, "mal_hashmap", mal_hashmap); - tcc_add_symbol(s, "mal_hashmap_put", mal_hashmap_put); - tcc_add_symbol(s, "mal_keyword", mal_keyword); - tcc_add_symbol(s, "mal_number", mal_number); - tcc_add_symbol(s, "mal_sprintf", mal_sprintf); - tcc_add_symbol(s, "mal_string", mal_string); - tcc_add_symbol(s, "mal_vector", mal_vector); - tcc_add_symbol(s, "mal_vector_push", mal_vector_push); - tcc_add_symbol(s, "pr_str", pr_str); - - int size = tcc_relocate(s, NULL); - if (size < 0) { - fprintf(stderr, "Could not determine size of program\n"); - return 0; - } - - void *mem = GC_MALLOC(size); - if (tcc_relocate(s, mem) < 0) { - fprintf(stderr, "Could not relocate program\n"); - return 0; - } - - *EVAL = tcc_get_symbol(s, "EVAL"); - tcc_delete(s); - - if (!*EVAL) { - fprintf(stderr, "Could not find symbol EVAL\n"); - return 0; - } - - return 1; -} - -int gen_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - switch (node->type) { - case MAL_CONS_TYPE: - return gen_call_code(node, env, code, ret, var_num); - case MAL_EMPTY_TYPE: - append_code(code->body, mal_string("mal_empty()"), ret); - return 1; - case MAL_FALSE_TYPE: - append_code(code->body, mal_string("mal_false()"), ret); - return 1; - case MAL_HASHMAP_TYPE: - return gen_hashmap_code(node, env, code, ret, var_num); - case MAL_KEYWORD_TYPE: - return gen_keyword_code(node, code, ret); - case MAL_NIL_TYPE: - append_code(code->body, mal_string("mal_nil()"), ret); - return 1; - case MAL_NUMBER_TYPE: - return gen_number_code(node, code, ret); - case MAL_STRING_TYPE: - return gen_string_code(node, code, ret); - case MAL_SYMBOL_TYPE: - return gen_symbol_lookup_code(node, env, code, ret); - case MAL_TRUE_TYPE: - append_code(code->body, mal_string("mal_true()"), ret); - return 1; - case MAL_VECTOR_TYPE: - return gen_vector_code(node, env, code, ret, var_num); - default: - printf("unknown node type in code gen type=%d\n", node->type); - return 0; - } -} - -int gen_call_args_code(MalType *args_name, MalType *node, MalEnv *env, struct codegen *code, int *var_num) { - if (is_empty(node)) { - append_code(code->decl, mal_sprintf("MalType **%S = NULL;", args_name), 0); - return 1; - } - assert(is_cons(node)); - size_t arg_count = mal_list_len(node), index = 0; - MalType *temp_code = mal_sprintf("MalType **%S = GC_MALLOC(sizeof(MalType*) * %z);\n ", args_name, arg_count); - struct codegen code2; - while (!is_empty(node)) { - assert(is_cons(node)); - mal_string_append_mal_string(temp_code, mal_sprintf("%S[%z] = bubble_if_error(", args_name, index)); - code2 = (struct codegen){ code->top, code->decl, temp_code }; - if (!gen_code(mal_car(node), env, &code2, 0, var_num)) { - return 0; - } - mal_string_append(temp_code, ");\n "); - node = mal_cdr(node); - index++; - } - append_code(code->decl, temp_code, 0); - return 1; -} - -int gen_call_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *sym = mal_car(node), *temp_code; - - // look up the lambda in the env - MalType *lambda_name = next_var_name("lambda", var_num); - temp_code = mal_string("MalType *"); - mal_string_append_mal_string(temp_code, lambda_name); - mal_string_append(temp_code, " = "); - struct codegen code2 = { code->top, code->decl, temp_code }; - if (!gen_code(sym, env, &code2, 0, var_num)) { - return 0; - } - mal_string_append(temp_code, ";\n "); - mal_string_append_mal_string( - temp_code, - mal_sprintf( - "if (!is_lambda(%S)) { return mal_error(mal_sprintf(\"%%s is not callable\", pr_str(%S, 1))); }\n ", - lambda_name, - lambda_name - ) - ); - append_code(code->decl, temp_code, 0); - - // build the args array - MalType *args_name, *args_node = mal_cdr(node); - size_t args_count = mal_list_len(args_node); - if (args_count == 0) { - args_name = mal_string("NULL"); - } else { - args_name = mal_string_replace(lambda_name, "lambda", "args"); - if (!gen_call_args_code(args_name, args_node, env, code, var_num)) { - return 0; - } - } - - // write the function name or pointer - temp_code = mal_sprintf( - "%S->fn(%S->env, %z, %S)", - lambda_name, - lambda_name, - args_count, - args_name - ); - - append_code(code->body, temp_code, ret); - - return 1; -} - -int gen_hashmap_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - int len = mal_hashmap_size(node); - if (len == 0) { - append_code(code->body, mal_string("mal_hashmap()"), ret); - return 1; - } - - MalType *var_name = next_var_name("var", var_num); - MalType *temp_code = mal_string("MalType *"); - mal_string_append_mal_string(temp_code, var_name); - mal_string_append(temp_code, " = mal_hashmap();\n "); - - struct hashmap_iter *iter; - struct codegen code2; - char *key_str; - MalType *val; - for (iter = hashmap_iter(&node->hashmap); iter; iter = hashmap_iter_next(&node->hashmap, iter)) { - key_str = (char*)hashmap_iter_get_key(iter); - val = (MalType*)hashmap_iter_get_data(iter); - mal_string_append(temp_code, "mal_hashmap_put("); - mal_string_append_mal_string(temp_code, var_name); - mal_string_append(temp_code, ", "); - code2 = (struct codegen){ code->top, code->decl, temp_code }; - if (!gen_code(read_str(key_str), env, &code2, 0, var_num)) { - return 0; - } - mal_string_append(temp_code, ", "); - code2 = (struct codegen){ code->top, code->decl, temp_code }; - if (!gen_code(val, env, &code2, 0, var_num)) { - return 0; - } - mal_string_append(temp_code, ");\n "); - } - - append_code(code->decl, temp_code, 0); - append_code(code->body, var_name, ret); - return 1; -} - -int gen_keyword_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_keyword(%s)", pr_str(mal_string(node->keyword), 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_list_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *list_name = next_var_name("list", var_num); - MalType *temp_decl = mal_sprintf("MalType *%S = mal_vector();\n ", list_name); - struct list_or_vector_iter *iter; - MalType *item; - struct codegen code2; - for (iter = list_or_vector_iter(node); iter; iter = list_or_vector_iter_next(iter)) { - item = list_or_vector_iter_get_obj(iter); - mal_string_append_mal_string( - temp_decl, - mal_sprintf("mal_vector_push(%S, ", list_name) - ); - code2 = (struct codegen){ code->top, code->decl, temp_decl }; - if (!gen_code(item, env, &code2, 0, var_num)) { - return 0; - } - mal_string_append(temp_decl, ");\n "); - } - append_code(code->decl, temp_decl, 0); - append_code(code->body, mal_sprintf("mal_vector_to_list(%S)", list_name), ret); - return 1; -} - -int gen_lambda_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("(MalType*)%p /* %s */", node, pr_str(node, 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_number_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_number(%s)", pr_str(node, 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_string_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_string(%s)", pr_str(node, 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_symbol_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_symbol(%s)", pr_str(mal_string(node->symbol), 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_symbol_lookup_code(MalType *node, MalEnv *env, struct codegen *code, int ret) { - UNUSED(env); - MalType *temp_code = mal_sprintf( - "bubble_if_error(env_get(env, %s))", - pr_str(mal_string(node->symbol), 1) - ); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_vector_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *var_name = next_var_name("var", var_num); - MalType *temp_code = mal_string("MalType *"); - mal_string_append_mal_string(temp_code, var_name); - mal_string_append(temp_code, " = mal_vector();\n "); - struct codegen code2; - for(size_t i=0; itop, code->decl, temp_code }; - if (!gen_code(mal_vector_ref(node, i), env, &code2, 0, var_num)) { - return 0; - } - mal_string_append(temp_code, ");\n "); - } - append_code(code->decl, temp_code, 0); - append_code(code->body, var_name, ret); - return 1; -} - -void append_code(MalType *code, MalType *temp_code, int ret) { - if (ret) mal_string_append(code, "return "); - mal_string_append_mal_string(code, temp_code); - if (ret) mal_string_append(code, ";"); -} - -MalType* next_var_name(char *base, int *var_num) { - MalType *var_name = mal_string(base); - mal_string_append_long_long(var_name, (*var_num)++); - return var_name; -} - -MalType* env_get(MalEnv *env, char *key) { - MalType *val = hashmap_get(&env->data, key); - if (val) { - return val; - } else { - return mal_error(mal_sprintf("'%s' not found", key)); - } -} - -char* PRINT(MalType *ast) { - return pr_str(ast, 2); -} - -char* rep(char *str, MalEnv *repl_env) { - MalType *result = EVAL(READ(str), repl_env); - if (is_error(result)) { - return PRINT(mal_sprintf("ERROR: %s\n", pr_str(result->error_val, 0))); - } else { - return PRINT(result); - } -} - -MalType* core_add(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - if (argc == 0) { - return mal_number(0); - } else { - long long result = args[0]->number; - for (size_t i=1; inumber; - } - return mal_number(result); - } -} - -MalType* core_sub(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - assert(argc > 0); - long long result = args[0]->number; - for (size_t i=1; inumber; - } - return mal_number(result); -} - -MalType* core_mul(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - if (argc == 0) { - return mal_number(1); - } else { - long long result = args[0]->number; - for (size_t i=1; inumber; - } - return mal_number(result); - } -} - -MalType* core_div(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - assert(argc > 0); - long long result = args[0]->number; - for (size_t i=1; inumber; - } - return mal_number(result); -} - -char *parent_directory(char *bin_path) { - char *path = string(bin_path); - size_t len; - while ((len = strlen(path)) > 0 && path[len - 1] != '/') { - path[len - 1] = 0; - } - if (len > 0) path[len - 1] = 0; - if (strlen(path) == 0) { - return string("."); - } else { - return path; - } -} - -int main(int argc, char *argv[]) { - UNUSED(argc); - - PATH = parent_directory(argv[0]); - - MalEnv repl_env; - hashmap_init(&repl_env.data, hashmap_hash_string, hashmap_compare_string, 4); - hashmap_set_key_alloc_funcs(&repl_env.data, hashmap_alloc_key_string, NULL); - hashmap_put(&repl_env.data, "+", (void*)mal_closure(core_add, &repl_env)); - hashmap_put(&repl_env.data, "-", (void*)mal_closure(core_sub, &repl_env)); - hashmap_put(&repl_env.data, "*", (void*)mal_closure(core_mul, &repl_env)); - hashmap_put(&repl_env.data, "/", (void*)mal_closure(core_div, &repl_env)); - - char *buffer; - read_history("history.txt"); - while ((buffer = readline("user> ")) != NULL) { - printf("%s\n", rep(buffer, &repl_env)); - if (strlen(buffer) > 0) { - add_history(buffer); - } - free(buffer); - } - write_history("history.txt"); - - return 0; -} diff --git a/step3_env.c b/step3_env.c deleted file mode 100644 index 3b1dc83..0000000 --- a/step3_env.c +++ /dev/null @@ -1,556 +0,0 @@ -#include -#include -#include -#include -#include -#include -#include -#include - -#include "env.h" -#include "printer.h" -#include "reader.h" -#include "util.h" - -char program_template[] = -"#include \n" -"#include \n" -"#include \n" -"#include \n" -"#include \n" -"#include \n" -"{{TOP_CODE}}\n" -"MalType* EVAL(MalEnv *env0) {\n" -" {{EVAL_CODE}}\n" -"}"; - -int compile_eval(MalType *ast, MalEnv *env, int *var_num, MalType* (**EVAL)(MalEnv *env)); -int gen_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_call_args_code(MalType *args_name, MalType *node, MalEnv *env, struct codegen *code, int *var_num); -int gen_call_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_def_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_hashmap_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_keyword_code(MalType *node, struct codegen *code, int ret); -int gen_let_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_list_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_number_code(MalType *node, struct codegen *code, int ret); -int gen_string_code(MalType *node, struct codegen *code, int ret); -int gen_symbol_code(MalType *node, struct codegen *code, int ret); -int gen_symbol_lookup_code(MalType *node, MalEnv *env, struct codegen *code, int ret); -int gen_vector_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -void append_code(MalType *code, MalType *temp_code, int ret); -MalType* next_var_name(char *base, int *var_num); -MalType* build_env_name(MalEnv *env); - -MalType* READ(char *str) { - return read_str(str); -} - -MalType* EVAL(MalType *ast, MalEnv *repl_env) { - MalType* (*EVAL)(MalEnv *env); - int var_num = 1; - if (compile_eval(ast, repl_env, &var_num, &EVAL)) { - return EVAL(repl_env); - } else { - printf("There was an error compiling.\n"); - return mal_blank_line(); - } -} - -char *PATH = NULL; - -int compile_eval(MalType *ast, MalEnv *env, int *var_num, MalType* (**EVAL)(MalEnv *env)) { - struct codegen code = { mal_string(""), mal_string(""), mal_string("") }; - int success = gen_code(ast, env, &code, 1, var_num); - - if (!success) { - return 0; - } - - MalType *generated = mal_string_replace(mal_string(program_template), "{{TOP_CODE}}", code.top->str); - - MalType *combined = code.decl; - mal_string_append_mal_string(combined, code.body); - generated = mal_string_replace(generated, "{{EVAL_CODE}}", combined->str); - - if (getenv("DEBUG")) { - printf("-----------------\n%s-----------------\n", generated->str); - } - - TCCState *s = tcc_new(); - if (!s) { - fprintf(stderr, "Could not create tcc state\n"); - return 0; - } - - if(access("./tinycc/libtcc.h", F_OK) != -1) { - tcc_set_lib_path(s, "./tinycc"); - tcc_add_include_path(s, "./tinycc"); - tcc_add_include_path(s, "."); - } else if(PATH) { - tcc_set_lib_path(s, mal_sprintf("%s/tinycc", PATH)->str); - tcc_add_include_path(s, mal_sprintf("%s/tinycc", PATH)->str); - tcc_add_include_path(s, PATH); - } else { - printf("Could not determine path to tinycc and libtcc.h\n"); - exit(1); - } - - tcc_set_output_type(s, TCC_OUTPUT_MEMORY); - - if (tcc_compile_string(s, string(generated->str)) == -1) { - fprintf(stderr, "Could not compile program\n"); - return 0; - } - - tcc_add_symbol(s, "build_env", build_env); - tcc_add_symbol(s, "env_get", env_get); - tcc_add_symbol(s, "env_set", env_set); - tcc_add_symbol(s, "mal_empty", mal_empty); - tcc_add_symbol(s, "mal_error", mal_error); - tcc_add_symbol(s, "mal_hashmap", mal_hashmap); - tcc_add_symbol(s, "mal_hashmap_put", mal_hashmap_put); - tcc_add_symbol(s, "mal_keyword", mal_keyword); - tcc_add_symbol(s, "mal_number", mal_number); - tcc_add_symbol(s, "mal_sprintf", mal_sprintf); - tcc_add_symbol(s, "mal_string", mal_string); - tcc_add_symbol(s, "mal_vector", mal_vector); - tcc_add_symbol(s, "mal_vector_push", mal_vector_push); - tcc_add_symbol(s, "pr_str", pr_str); - - int size = tcc_relocate(s, NULL); - if (size < 0) { - fprintf(stderr, "Could not determine size of program\n"); - return 0; - } - - void *mem = GC_MALLOC(size); - if (tcc_relocate(s, mem) < 0) { - fprintf(stderr, "Could not relocate program\n"); - return 0; - } - - *EVAL = tcc_get_symbol(s, "EVAL"); - tcc_delete(s); - - if (!*EVAL) { - fprintf(stderr, "Could not find symbol EVAL\n"); - return 0; - } - - return 1; -} - -int gen_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - switch (node->type) { - case MAL_CONS_TYPE: - return gen_call_code(node, env, code, ret, var_num); - case MAL_EMPTY_TYPE: - append_code(code->body, mal_string("mal_empty()"), ret); - return 1; - case MAL_FALSE_TYPE: - append_code(code->body, mal_string("mal_false()"), ret); - return 1; - case MAL_HASHMAP_TYPE: - return gen_hashmap_code(node, env, code, ret, var_num); - case MAL_KEYWORD_TYPE: - return gen_keyword_code(node, code, ret); - case MAL_NIL_TYPE: - append_code(code->body, mal_string("mal_nil()"), ret); - return 1; - case MAL_NUMBER_TYPE: - return gen_number_code(node, code, ret); - case MAL_STRING_TYPE: - return gen_string_code(node, code, ret); - case MAL_SYMBOL_TYPE: - return gen_symbol_lookup_code(node, env, code, ret); - case MAL_TRUE_TYPE: - append_code(code->body, mal_string("mal_true()"), ret); - return 1; - case MAL_VECTOR_TYPE: - return gen_vector_code(node, env, code, ret, var_num); - default: - printf("unknown node type in code gen type=%d\n", node->type); - return 0; - } -} - -int gen_call_args_code(MalType *args_name, MalType *node, MalEnv *env, struct codegen *code, int *var_num) { - if (is_empty(node)) { - append_code(code->decl, mal_sprintf("MalType **%S = NULL;", args_name), 0); - return 1; - } - assert(is_cons(node)); - size_t arg_count = mal_list_len(node), index = 0; - MalType *temp_code = mal_sprintf("MalType **%S = GC_MALLOC(sizeof(MalType*) * %z);\n ", args_name, arg_count); - struct codegen code2; - while (!is_empty(node)) { - assert(is_cons(node)); - mal_string_append_mal_string(temp_code, mal_sprintf("%S[%z] = bubble_if_error(", args_name, index)); - code2 = (struct codegen){ code->top, code->decl, temp_code }; - if (!gen_code(mal_car(node), env, &code2, 0, var_num)) { - return 0; - } - mal_string_append(temp_code, ");\n "); - node = mal_cdr(node); - index++; - } - append_code(code->decl, temp_code, 0); - return 1; -} - -int gen_call_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *sym = mal_car(node), *temp_code; - - if (is_symbol(sym)) { - if (strcmp(sym->symbol, "def!") == 0) { - return gen_def_code(mal_cdr(node), env, code, ret, var_num); - } else if (strcmp(sym->symbol, "let*") == 0) { - return gen_let_code(mal_cdr(node), env, code, ret, var_num); - } - } - - // look up the lambda in the env - MalType *lambda_name = next_var_name("lambda", var_num); - temp_code = mal_string("MalType *"); - mal_string_append_mal_string(temp_code, lambda_name); - mal_string_append(temp_code, " = "); - struct codegen code2 = { code->top, code->decl, temp_code }; - if (!gen_code(sym, env, &code2, 0, var_num)) { - return 0; - } - mal_string_append(temp_code, ";\n "); - mal_string_append_mal_string( - temp_code, - mal_sprintf( - "if (!is_lambda(%S)) { return mal_error(mal_sprintf(\"%%s is not callable\", pr_str(%S, 1))); }\n ", - lambda_name, - lambda_name - ) - ); - append_code(code->decl, temp_code, 0); - - // build the args array - MalType *args_name, *args_node = mal_cdr(node); - size_t args_count = mal_list_len(args_node); - if (args_count == 0) { - args_name = mal_string("NULL"); - } else { - args_name = mal_string_replace(lambda_name, "lambda", "args"); - if (!gen_call_args_code(args_name, args_node, env, code, var_num)) { - return 0; - } - } - - // write the function name or pointer - temp_code = mal_sprintf( - "%S->fn(%S->env, %z, %S)", - lambda_name, - lambda_name, - args_count, - args_name - ); - - append_code(code->body, temp_code, ret); - - return 1; -} - -int gen_def_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *env_name = build_env_name(env); - MalType *name = mal_car(node); - assert(is_symbol(name)); - char *name_str = pr_str(mal_string(name->symbol), 1); - - int key_already_exists = !!env_get(env, name->symbol); - if (!key_already_exists) env_set(env, name->symbol, mal_true()); - struct codegen code2 = (struct codegen){ code->top, code->decl, mal_string("") }; - MalType *val_node = mal_car(mal_cdr(node)); - if (!gen_code(val_node, env, &code2, 0, var_num)) { - if (!key_already_exists) env_delete(env, name->symbol); - return 0; - } - - MalType *temp_code = mal_sprintf("env_set(%S, %s, bubble_if_error(%S))", env_name, name_str, code2.body); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_hashmap_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - int len = mal_hashmap_size(node); - if (len == 0) { - append_code(code->body, mal_string("mal_hashmap()"), ret); - return 1; - } - - MalType *var_name = next_var_name("var", var_num); - MalType *temp_code = mal_string("MalType *"); - mal_string_append_mal_string(temp_code, var_name); - mal_string_append(temp_code, " = mal_hashmap();\n "); - - struct hashmap_iter *iter; - struct codegen code2; - char *key_str; - MalType *val; - for (iter = hashmap_iter(&node->hashmap); iter; iter = hashmap_iter_next(&node->hashmap, iter)) { - key_str = (char*)hashmap_iter_get_key(iter); - val = (MalType*)hashmap_iter_get_data(iter); - mal_string_append(temp_code, "mal_hashmap_put("); - mal_string_append_mal_string(temp_code, var_name); - mal_string_append(temp_code, ", "); - code2 = (struct codegen){ code->top, code->decl, temp_code }; - if (!gen_code(read_str(key_str), env, &code2, 0, var_num)) { - return 0; - } - mal_string_append(temp_code, ", "); - code2 = (struct codegen){ code->top, code->decl, temp_code }; - if (!gen_code(val, env, &code2, 0, var_num)) { - return 0; - } - mal_string_append(temp_code, ");\n "); - } - - append_code(code->decl, temp_code, 0); - append_code(code->body, var_name, ret); - return 1; -} - -int gen_keyword_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_keyword(%s)", pr_str(mal_string(node->keyword), 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_let_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalEnv *inner_env = build_env(env); - inner_env->num = (*var_num)++; - MalType *outer_env_name = build_env_name(env); - MalType *inner_env_name = build_env_name(inner_env); - MalType *temp_code = mal_sprintf("MalEnv *%S = build_env(%S);\n ", inner_env_name, outer_env_name); - append_code(code->decl, temp_code, 0); - - temp_code = mal_string(""); - - struct list_or_vector_iter *iter; - struct codegen code2; - MalType *name, *val, *inner_decl, *val_code; - for (iter = list_or_vector_iter(mal_car(node)); iter; iter = list_or_vector_iter_next(iter)) { - inner_decl = mal_string(""); - name = list_or_vector_iter_get_obj(iter); - assert(is_symbol(name)); - iter = list_or_vector_iter_next(iter); - val = list_or_vector_iter_get_obj(iter); - env_set(inner_env, name->symbol, mal_true()); - code2 = (struct codegen){ code->top, inner_decl, mal_string("") }; - if (!gen_code(val, inner_env, &code2, 0, var_num)) { - return 0; - } - val_code = mal_sprintf("env_set(%S, %s, %S);\n ", inner_env_name, pr_str(mal_string(name->symbol), 1), code2.body); - mal_string_append_mal_string(temp_code, inner_decl); - mal_string_append_mal_string(temp_code, val_code); - } - - append_code(code->decl, temp_code, 0); - - node = mal_cdr(node); - if (!gen_code(mal_car(node), inner_env, code, ret, var_num)) { - return 0; - } - - return 1; -} - -int gen_list_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *list_name = next_var_name("list", var_num); - MalType *temp_decl = mal_sprintf("MalType *%S = mal_vector();\n ", list_name); - struct list_or_vector_iter *iter; - MalType *item; - struct codegen code2; - for (iter = list_or_vector_iter(node); iter; iter = list_or_vector_iter_next(iter)) { - item = list_or_vector_iter_get_obj(iter); - mal_string_append_mal_string( - temp_decl, - mal_sprintf("mal_vector_push(%S, ", list_name) - ); - code2 = (struct codegen){ code->top, code->decl, temp_decl }; - if (!gen_code(item, env, &code2, 0, var_num)) { - return 0; - } - mal_string_append(temp_decl, ");\n "); - } - append_code(code->decl, temp_decl, 0); - append_code(code->body, mal_sprintf("mal_vector_to_list(%S)", list_name), ret); - return 1; -} - -int gen_lambda_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("(MalType*)%p /* %s */", node, pr_str(node, 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_number_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_number(%s)", pr_str(node, 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_string_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_string(%s)", pr_str(node, 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_symbol_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_symbol(%s)", pr_str(mal_string(node->symbol), 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_symbol_lookup_code(MalType *node, MalEnv *env, struct codegen *code, int ret) { - UNUSED(env); - MalType *temp_code = mal_sprintf( - "bubble_if_error(env_get(%S, %s))", - build_env_name(env), - pr_str(mal_string(node->symbol), 1) - ); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_vector_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *var_name = next_var_name("var", var_num); - MalType *temp_code = mal_string("MalType *"); - mal_string_append_mal_string(temp_code, var_name); - mal_string_append(temp_code, " = mal_vector();\n "); - struct codegen code2; - for(size_t i=0; itop, code->decl, temp_code }; - if (!gen_code(mal_vector_ref(node, i), env, &code2, 0, var_num)) { - return 0; - } - mal_string_append(temp_code, ");\n "); - } - append_code(code->decl, temp_code, 0); - append_code(code->body, var_name, ret); - return 1; -} - -void append_code(MalType *code, MalType *temp_code, int ret) { - if (ret) mal_string_append(code, "return "); - mal_string_append_mal_string(code, temp_code); - if (ret) mal_string_append(code, ";"); -} - -MalType* next_var_name(char *base, int *var_num) { - MalType *var_name = mal_string(base); - mal_string_append_long_long(var_name, (*var_num)++); - return var_name; -} - -MalType* build_env_name(MalEnv *env) { - MalType *name = mal_string("env"); - mal_string_append_long_long(name, env->num); - return name; -} - -char* PRINT(MalType *ast) { - return pr_str(ast, 2); -} - -char* rep(char *str, MalEnv *repl_env) { - MalType *result = EVAL(READ(str), repl_env); - if (is_error(result)) { - return PRINT(mal_sprintf("ERROR: %s\n", pr_str(result->error_val, 0))); - } else { - return PRINT(result); - } -} - -MalType* core_add(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - if (argc == 0) { - return mal_number(0); - } else { - long long result = args[0]->number; - for (size_t i=1; inumber; - } - return mal_number(result); - } -} - -MalType* core_sub(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - assert(argc > 0); - long long result = args[0]->number; - for (size_t i=1; inumber; - } - return mal_number(result); -} - -MalType* core_mul(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - if (argc == 0) { - return mal_number(1); - } else { - long long result = args[0]->number; - for (size_t i=1; inumber; - } - return mal_number(result); - } -} - -MalType* core_div(MalEnv *env, size_t argc, MalType **args) { - UNUSED(env); - assert(argc > 0); - long long result = args[0]->number; - for (size_t i=1; inumber; - } - return mal_number(result); -} - -char *parent_directory(char *bin_path) { - char *path = string(bin_path); - size_t len; - while ((len = strlen(path)) > 0 && path[len - 1] != '/') { - path[len - 1] = 0; - } - if (len > 0) path[len - 1] = 0; - if (strlen(path) == 0) { - return string("."); - } else { - return path; - } -} - -int main(int argc, char *argv[]) { - UNUSED(argc); - - PATH = parent_directory(argv[0]); - - MalEnv *repl_env = build_top_env(); - env_set(repl_env, "+", mal_builtin_function(core_add, "core_add", repl_env)); - env_set(repl_env, "-", mal_builtin_function(core_sub, "core_sub", repl_env)); - env_set(repl_env, "*", mal_builtin_function(core_mul, "core_mul", repl_env)); - env_set(repl_env, "/", mal_builtin_function(core_div, "core_div", repl_env)); - - char *buffer; - read_history("history.txt"); - while ((buffer = readline("user> ")) != NULL) { - printf("%s\n", rep(buffer, repl_env)); - if (strlen(buffer) > 0) { - add_history(buffer); - } - free(buffer); - } - write_history("history.txt"); - - return 0; -} diff --git a/step4_if_fn_do.c b/step4_if_fn_do.c deleted file mode 100644 index 777937c..0000000 --- a/step4_if_fn_do.c +++ /dev/null @@ -1,733 +0,0 @@ -#include -#include -#include -#include -#include -#include -#include -#include - -#include "core.h" -#include "env.h" -#include "printer.h" -#include "reader.h" -#include "util.h" - -char program_template[] = -"#include \n" -"#include \n" -"#include \n" -"#include \n" -"#include \n" -"#include \n" -"{{TOP_CODE}}\n" -"MalType* EVAL(MalEnv *env0) {\n" -" {{EVAL_CODE}}\n" -"}"; - -int compile_eval(MalType *ast, MalEnv *env, int *var_num, MalType* (**EVAL)(MalEnv *env)); -int gen_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_call_args_code(MalType *args_name, MalType *node, MalEnv *env, struct codegen *code, int *var_num); -int gen_call_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_closure_code(MalType *fn_name, MalEnv *env, struct codegen *code, int ret); -int gen_def_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_do_code(MalType *list, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_hashmap_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_if_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_fn_code(MalType *fn_name, MalType *node, MalEnv *env, struct codegen *code, int *var_num, int new_env); -int gen_keyword_code(MalType *node, struct codegen *code, int ret); -int gen_let_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_list_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_number_code(MalType *node, struct codegen *code, int ret); -int gen_string_code(MalType *node, struct codegen *code, int ret); -int gen_symbol_code(MalType *node, struct codegen *code, int ret); -int gen_symbol_lookup_code(MalType *node, MalEnv *env, struct codegen *code, int ret); -int gen_vector_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -void append_code(MalType *code, MalType *temp_code, int ret); -MalType* next_var_name(char *base, int *var_num); -MalType* build_env_name(MalEnv *env); - -MalType* READ(char *str) { - return read_str(str); -} - -MalType* EVAL(MalType *ast, MalEnv *repl_env) { - MalType* (*EVAL)(MalEnv *env); - int var_num = 1; - if (compile_eval(ast, repl_env, &var_num, &EVAL)) { - return EVAL(repl_env); - } else { - printf("There was an error compiling.\n"); - return mal_blank_line(); - } -} - -char *PATH = NULL; - -int compile_eval(MalType *ast, MalEnv *env, int *var_num, MalType* (**EVAL)(MalEnv *env)) { - struct codegen code = { mal_string(""), mal_string(""), mal_string("") }; - int success = gen_code(ast, env, &code, 1, var_num); - - if (!success) { - return 0; - } - - MalType *generated = mal_string_replace(mal_string(program_template), "{{TOP_CODE}}", code.top->str); - - MalType *combined = code.decl; - mal_string_append_mal_string(combined, code.body); - generated = mal_string_replace(generated, "{{EVAL_CODE}}", combined->str); - - if (getenv("DEBUG")) { - printf("-----------------\n%s-----------------\n", generated->str); - } - - TCCState *s = tcc_new(); - if (!s) { - fprintf(stderr, "Could not create tcc state\n"); - return 0; - } - - if(access("./tinycc/libtcc.h", F_OK) != -1) { - tcc_set_lib_path(s, "./tinycc"); - tcc_add_include_path(s, "./tinycc"); - tcc_add_include_path(s, "."); - } else if(PATH) { - tcc_set_lib_path(s, mal_sprintf("%s/tinycc", PATH)->str); - tcc_add_include_path(s, mal_sprintf("%s/tinycc", PATH)->str); - tcc_add_include_path(s, PATH); - } else { - printf("Could not determine path to tinycc and libtcc.h\n"); - exit(1); - } - - tcc_set_output_type(s, TCC_OUTPUT_MEMORY); - - if (tcc_compile_string(s, string(generated->str)) == -1) { - fprintf(stderr, "Could not compile program\n"); - return 0; - } - - tcc_add_symbol(s, "build_env", build_env); - tcc_add_symbol(s, "env_get", env_get); - tcc_add_symbol(s, "env_set", env_set); - tcc_add_symbol(s, "mal_closure", mal_closure); - tcc_add_symbol(s, "mal_empty", mal_empty); - tcc_add_symbol(s, "mal_error", mal_error); - tcc_add_symbol(s, "mal_false", mal_false); - tcc_add_symbol(s, "mal_hashmap", mal_hashmap); - tcc_add_symbol(s, "mal_hashmap_put", mal_hashmap_put); - tcc_add_symbol(s, "mal_keyword", mal_keyword); - tcc_add_symbol(s, "mal_nil", mal_nil); - tcc_add_symbol(s, "mal_number", mal_number); - tcc_add_symbol(s, "mal_sprintf", mal_sprintf); - tcc_add_symbol(s, "mal_string", mal_string); - tcc_add_symbol(s, "mal_true", mal_true); - tcc_add_symbol(s, "mal_vector", mal_vector); - tcc_add_symbol(s, "mal_vector_push", mal_vector_push); - tcc_add_symbol(s, "mal_vector_to_list", mal_vector_to_list); - tcc_add_symbol(s, "pr_str", pr_str); - - int size = tcc_relocate(s, NULL); - if (size < 0) { - fprintf(stderr, "Could not determine size of program\n"); - return 0; - } - - void *mem = GC_MALLOC(size); - if (tcc_relocate(s, mem) < 0) { - fprintf(stderr, "Could not relocate program\n"); - return 0; - } - - *EVAL = tcc_get_symbol(s, "EVAL"); - tcc_delete(s); - - if (!*EVAL) { - fprintf(stderr, "Could not find symbol EVAL\n"); - return 0; - } - - return 1; -} - -int gen_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - switch (node->type) { - case MAL_CONS_TYPE: - return gen_call_code(node, env, code, ret, var_num); - case MAL_EMPTY_TYPE: - append_code(code->body, mal_string("mal_empty()"), ret); - return 1; - case MAL_FALSE_TYPE: - append_code(code->body, mal_string("mal_false()"), ret); - return 1; - case MAL_HASHMAP_TYPE: - return gen_hashmap_code(node, env, code, ret, var_num); - case MAL_KEYWORD_TYPE: - return gen_keyword_code(node, code, ret); - case MAL_NIL_TYPE: - append_code(code->body, mal_string("mal_nil()"), ret); - return 1; - case MAL_NUMBER_TYPE: - return gen_number_code(node, code, ret); - case MAL_STRING_TYPE: - return gen_string_code(node, code, ret); - case MAL_SYMBOL_TYPE: - return gen_symbol_lookup_code(node, env, code, ret); - case MAL_TRUE_TYPE: - append_code(code->body, mal_string("mal_true()"), ret); - return 1; - case MAL_VECTOR_TYPE: - return gen_vector_code(node, env, code, ret, var_num); - default: - printf("unknown node type in code gen type=%d\n", node->type); - return 0; - } -} - -int gen_call_args_code(MalType *args_name, MalType *node, MalEnv *env, struct codegen *code, int *var_num) { - if (is_empty(node)) { - append_code(code->decl, mal_sprintf("MalType **%S = NULL;", args_name), 0); - return 1; - } - assert(is_cons(node)); - size_t arg_count = mal_list_len(node), index = 0; - MalType *temp_code = mal_sprintf("MalType **%S = GC_MALLOC(sizeof(MalType*) * %z);\n ", args_name, arg_count); - struct codegen code2; - while (!is_empty(node)) { - assert(is_cons(node)); - mal_string_append_mal_string(temp_code, mal_sprintf("%S[%z] = bubble_if_error(", args_name, index)); - code2 = (struct codegen){ code->top, code->decl, temp_code }; - if (!gen_code(mal_car(node), env, &code2, 0, var_num)) { - return 0; - } - mal_string_append(temp_code, ");\n "); - node = mal_cdr(node); - index++; - } - append_code(code->decl, temp_code, 0); - return 1; -} - -int gen_call_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *sym = mal_car(node), *temp_code, *fn_name; - - if (is_symbol(sym)) { - if (strcmp(sym->symbol, "def!") == 0) { - return gen_def_code(mal_cdr(node), env, code, ret, var_num); - } else if (strcmp(sym->symbol, "let*") == 0) { - return gen_let_code(mal_cdr(node), env, code, ret, var_num); - } else if (strcmp(sym->symbol, "do") == 0) { - return gen_do_code(mal_cdr(node), env, code, ret, var_num); - } else if (strcmp(sym->symbol, "if") == 0) { - return gen_if_code(mal_cdr(node), env, code, ret, var_num); - } else if (strcmp(sym->symbol, "fn*") == 0) { - fn_name = next_var_name("fn", var_num); - if (!gen_fn_code(fn_name, mal_cdr(node), env, code, var_num, 1)) { - return 0; - } - return gen_closure_code(fn_name, env, code, ret); - } - } - - // look up the lambda in the env - MalType *lambda_name = next_var_name("lambda", var_num); - temp_code = mal_string("MalType *"); - mal_string_append_mal_string(temp_code, lambda_name); - mal_string_append(temp_code, " = "); - struct codegen code2 = { code->top, code->decl, temp_code }; - if (!gen_code(sym, env, &code2, 0, var_num)) { - return 0; - } - mal_string_append(temp_code, ";\n "); - mal_string_append_mal_string( - temp_code, - mal_sprintf( - "if (!is_lambda(%S)) { return mal_error(mal_sprintf(\"%%s is not callable\", pr_str(%S, 1))); }\n ", - lambda_name, - lambda_name - ) - ); - append_code(code->decl, temp_code, 0); - - // build the args array - MalType *args_name, *args_node = mal_cdr(node); - size_t args_count = mal_list_len(args_node); - if (args_count == 0) { - args_name = mal_string("NULL"); - } else { - args_name = mal_string_replace(lambda_name, "lambda", "args"); - if (!gen_call_args_code(args_name, args_node, env, code, var_num)) { - return 0; - } - } - - // write the function name or pointer - temp_code = mal_sprintf( - "%S->fn(%S->env, %z, %S)", - lambda_name, - lambda_name, - args_count, - args_name - ); - - append_code(code->body, temp_code, ret); - - return 1; -} - -int gen_closure_code(MalType *fn_name, MalEnv *env, struct codegen *code, int ret) { - MalType *closure_name = mal_string("closure_"); - mal_string_append_mal_string(closure_name, fn_name); - MalType *temp_code = mal_sprintf( - "MalType *%S = mal_closure(%S, %S);\n ", - closure_name, - fn_name, - build_env_name(env) - ); - append_code(code->decl, temp_code, 0); - append_code(code->body, closure_name, ret); - return 1; -} - -int gen_def_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *env_name = build_env_name(env); - MalType *name = mal_car(node); - assert(is_symbol(name)); - char *name_str = pr_str(mal_string(name->symbol), 1); - - int key_already_exists = !!env_get(env, name->symbol); - if (!key_already_exists) env_set(env, name->symbol, mal_true()); - struct codegen code2 = (struct codegen){ code->top, code->decl, mal_string("") }; - MalType *val_node = mal_car(mal_cdr(node)); - if (!gen_code(val_node, env, &code2, 0, var_num)) { - if (!key_already_exists) env_delete(env, name->symbol); - return 0; - } - - MalType *temp_code = mal_sprintf("env_set(%S, %s, bubble_if_error(%S))", env_name, name_str, code2.body); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_do_code(MalType *list, MalEnv *env, struct codegen *code, int ret, int *var_num) { - struct list_or_vector_iter *iter; - struct codegen code2; - MalType *node, *temp_decl, *temp_code; - int is_last = 0; - for (iter = list_or_vector_iter(list); iter; iter = list_or_vector_iter_next(iter)) { - temp_decl = mal_string(""); - temp_code = mal_string(""); - node = list_or_vector_iter_get_obj(iter); - is_last = list_or_vector_iter_is_last(iter); - code2 = (struct codegen){ code->top, temp_decl, temp_code }; - if (!gen_code(node, env, &code2, ret && is_last, var_num)) { - return 0; - } - if (is_last) { - append_code(code->decl, temp_decl, 0); - append_code(code->body, temp_code, 0); - } else { - mal_string_append(temp_code, ";\n "); - append_code(code->decl, temp_decl, 0); - append_code(code->decl, temp_code, 0); - } - } - return 1; -} - -int gen_hashmap_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - int len = mal_hashmap_size(node); - if (len == 0) { - append_code(code->body, mal_string("mal_hashmap()"), ret); - return 1; - } - - MalType *var_name = next_var_name("var", var_num); - MalType *temp_code = mal_string("MalType *"); - mal_string_append_mal_string(temp_code, var_name); - mal_string_append(temp_code, " = mal_hashmap();\n "); - - struct hashmap_iter *iter; - struct codegen code2; - char *key_str; - MalType *val; - for (iter = hashmap_iter(&node->hashmap); iter; iter = hashmap_iter_next(&node->hashmap, iter)) { - key_str = (char*)hashmap_iter_get_key(iter); - val = (MalType*)hashmap_iter_get_data(iter); - mal_string_append(temp_code, "mal_hashmap_put("); - mal_string_append_mal_string(temp_code, var_name); - mal_string_append(temp_code, ", "); - code2 = (struct codegen){ code->top, code->decl, temp_code }; - if (!gen_code(read_str(key_str), env, &code2, 0, var_num)) { - return 0; - } - mal_string_append(temp_code, ", "); - code2 = (struct codegen){ code->top, code->decl, temp_code }; - if (!gen_code(val, env, &code2, 0, var_num)) { - return 0; - } - mal_string_append(temp_code, ");\n "); - } - - append_code(code->decl, temp_code, 0); - append_code(code->body, var_name, ret); - return 1; -} - -int gen_if_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *cond_code = mal_string(""); - struct codegen code2 = (struct codegen){ code->top, code->decl, cond_code }; - if (!gen_code(mal_car(node), env, &code2, 0, var_num)) { - return 0; - } - node = mal_cdr(node); - MalType *true_code = mal_string(""); - code2.body = true_code; - MalType *true_val = mal_car(node); - if (is_primitive(true_val)) { - if (!gen_code(true_val, env, &code2, 0, var_num)) { - return 0; - } - } else { - MalType *fn_name = next_var_name("if_true", var_num); - if (!gen_fn_code(fn_name, mal_cons(mal_empty(), mal_cons(true_val, mal_empty())), env, &code2, var_num, 1)) { - return 0; - } - mal_string_append_mal_string(true_code, mal_sprintf("%S(%S, 0, NULL)", fn_name, build_env_name(env))); - } - node = mal_cdr(node); - MalType *false_code = mal_string(""); - code2.body = false_code; - MalType *false_val; - if (is_empty(node)) { - false_val = mal_nil(); - } else { - false_val = mal_car(node); - } - if (is_primitive(false_val)) { - if (!gen_code(false_val, env, &code2, 0, var_num)) { - return 0; - } - } else { - MalType *fn_name = next_var_name("if_false", var_num); - if (!gen_fn_code(fn_name, mal_cons(mal_empty(), mal_cons(false_val, mal_empty())), env, &code2, var_num, 1)) { - return 0; - } - mal_string_append_mal_string(false_code, mal_sprintf("%S(%S, 0, NULL)", fn_name, build_env_name(env))); - } - append_code( - code->body, - mal_sprintf("is_truthy(%S) ? %S : %S", cond_code, true_code, false_code), - ret - ); - return 1; -} - -int gen_fn_code(MalType *fn_name, MalType *node, MalEnv *env, struct codegen *code, int *var_num, int new_env) { - MalType *args = mal_car(node); - size_t arg_count = list_or_vector_len(args); - - // function header - MalType *temp_fn = mal_sprintf("MalType* %S(MalEnv *env, size_t argc, MalType **args) {\n ", fn_name); - - // inner env - MalEnv *inner_env; - MalType *inner_env_name; - if (new_env) { - inner_env = build_env(env); - inner_env->num = (*var_num)++; - inner_env_name = build_env_name(inner_env); - mal_string_append_mal_string(temp_fn, mal_sprintf("MalEnv *%S = build_env(env);\n ", inner_env_name)); - } else { - inner_env = env; - inner_env_name = build_env_name(env); - mal_string_append_mal_string(temp_fn, mal_sprintf("MalEnv *%S = env;\n ", inner_env_name)); - } - - // arity check - int more_pos = list_or_vector_index_of(args, mal_symbol("&")); - if (more_pos == -1) { - mal_string_append_mal_string( - temp_fn, - mal_sprintf("mal_assert(argc == %i, \"Arity mismatch.\");\n ", arg_count) - ); - } else { - mal_string_append_mal_string( - temp_fn, - mal_sprintf("mal_assert(argc >= %i, \"Arity mismatch.\");\n ", more_pos) - ); - } - - // set arguments in inner env - if (arg_count > 0) { - struct list_or_vector_iter *iter; - MalType *arg; - size_t index = 0; - int is_more = 0; - for (iter = list_or_vector_iter(args); iter; iter = list_or_vector_iter_next(iter)) { - arg = list_or_vector_iter_get_obj(iter); - assert(is_symbol(arg)); - if (strcmp("&", arg->symbol) == 0) { - is_more = 1; - continue; - } - if (is_more) { - // accumulate remaining args in a list - char *more_name = arg->symbol; - mal_string_append(temp_fn, "MalType *rest_args = mal_vector();\n "); - mal_string_append_mal_string( - temp_fn, - mal_sprintf("for(size_t arg_i=%z; arg_isymbol), 1), - index - ) - ); - env_set(inner_env, arg->symbol, mal_true()); - index++; - } - } - } - - // function body - MalType *fn_decl = mal_string(""); - MalType *fn_code = mal_string(""); - struct codegen code2 = (struct codegen){ code->top, fn_decl, fn_code }; - MalType *fn_body = mal_cdr(node); - assert(!is_empty(fn_body)); - if (!gen_code(mal_car(fn_body), inner_env, &code2, 1, var_num)) { - return 0; - } - append_code(temp_fn, fn_decl, 0); - append_code(temp_fn, fn_code, 0); - - // closing brace - mal_string_append(temp_fn, "\n}\n\n"); - append_code(code->top, temp_fn, 0); - - return 1; -} - -int gen_keyword_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_keyword(%s)", pr_str(mal_string(node->keyword), 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_let_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalEnv *inner_env = build_env(env); - inner_env->num = (*var_num)++; - MalType *outer_env_name = build_env_name(env); - MalType *inner_env_name = build_env_name(inner_env); - MalType *temp_code = mal_sprintf("MalEnv *%S = build_env(%S);\n ", inner_env_name, outer_env_name); - append_code(code->decl, temp_code, 0); - - temp_code = mal_string(""); - - struct list_or_vector_iter *iter; - struct codegen code2; - MalType *name, *val, *inner_decl, *val_code; - for (iter = list_or_vector_iter(mal_car(node)); iter; iter = list_or_vector_iter_next(iter)) { - inner_decl = mal_string(""); - name = list_or_vector_iter_get_obj(iter); - assert(is_symbol(name)); - iter = list_or_vector_iter_next(iter); - val = list_or_vector_iter_get_obj(iter); - env_set(inner_env, name->symbol, mal_true()); - code2 = (struct codegen){ code->top, inner_decl, mal_string("") }; - if (!gen_code(val, inner_env, &code2, 0, var_num)) { - return 0; - } - val_code = mal_sprintf("env_set(%S, %s, %S);\n ", inner_env_name, pr_str(mal_string(name->symbol), 1), code2.body); - mal_string_append_mal_string(temp_code, inner_decl); - mal_string_append_mal_string(temp_code, val_code); - } - - append_code(code->decl, temp_code, 0); - - node = mal_cdr(node); - if (!gen_code(mal_car(node), inner_env, code, ret, var_num)) { - return 0; - } - - return 1; -} - -int gen_list_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *list_name = next_var_name("list", var_num); - MalType *temp_decl = mal_sprintf("MalType *%S = mal_vector();\n ", list_name); - struct list_or_vector_iter *iter; - MalType *item; - struct codegen code2; - for (iter = list_or_vector_iter(node); iter; iter = list_or_vector_iter_next(iter)) { - item = list_or_vector_iter_get_obj(iter); - mal_string_append_mal_string( - temp_decl, - mal_sprintf("mal_vector_push(%S, ", list_name) - ); - code2 = (struct codegen){ code->top, code->decl, temp_decl }; - if (!gen_code(item, env, &code2, 0, var_num)) { - return 0; - } - mal_string_append(temp_decl, ");\n "); - } - append_code(code->decl, temp_decl, 0); - append_code(code->body, mal_sprintf("mal_vector_to_list(%S)", list_name), ret); - return 1; -} - -int gen_lambda_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("(MalType*)%p /* %s */", node, pr_str(node, 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_number_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_number(%s)", pr_str(node, 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_string_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_string(%s)", pr_str(node, 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_symbol_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_symbol(%s)", pr_str(mal_string(node->symbol), 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_symbol_lookup_code(MalType *node, MalEnv *env, struct codegen *code, int ret) { - UNUSED(env); - MalType *temp_code = mal_sprintf( - "bubble_if_error(env_get(%S, %s))", - build_env_name(env), - pr_str(mal_string(node->symbol), 1) - ); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_vector_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *var_name = next_var_name("var", var_num); - MalType *temp_code = mal_string("MalType *"); - mal_string_append_mal_string(temp_code, var_name); - mal_string_append(temp_code, " = mal_vector();\n "); - struct codegen code2; - for(size_t i=0; itop, code->decl, temp_code }; - if (!gen_code(mal_vector_ref(node, i), env, &code2, 0, var_num)) { - return 0; - } - mal_string_append(temp_code, ");\n "); - } - append_code(code->decl, temp_code, 0); - append_code(code->body, var_name, ret); - return 1; -} - -void append_code(MalType *code, MalType *temp_code, int ret) { - if (ret) mal_string_append(code, "return "); - mal_string_append_mal_string(code, temp_code); - if (ret) mal_string_append(code, ";"); -} - -MalType* next_var_name(char *base, int *var_num) { - MalType *var_name = mal_string(base); - mal_string_append_long_long(var_name, (*var_num)++); - return var_name; -} - -MalType* build_env_name(MalEnv *env) { - MalType *name = mal_string("env"); - mal_string_append_long_long(name, env->num); - return name; -} - -char* PRINT(MalType *ast) { - return pr_str(ast, 2); -} - -char* rep(char *str, MalEnv *repl_env) { - MalType *result = EVAL(READ(str), repl_env); - if (is_error(result)) { - return PRINT(mal_sprintf("ERROR: %s\n", pr_str(result->error_val, 0))); - } else { - return PRINT(result); - } -} - -char *parent_directory(char *bin_path) { - char *path = string(bin_path); - size_t len; - while ((len = strlen(path)) > 0 && path[len - 1] != '/') { - path[len - 1] = 0; - } - if (len > 0) path[len - 1] = 0; - if (strlen(path) == 0) { - return string("."); - } else { - return path; - } -} - -int main(int argc, char *argv[]) { - UNUSED(argc); - - PATH = parent_directory(argv[0]); - - MalEnv *repl_env = build_top_env(); - - struct hashmap *ns = core_ns(); - struct hashmap_iter *core_iter; - char *name; - MalType* (*fn)(MalEnv*, size_t, MalType**); - for (core_iter = hashmap_iter(ns); core_iter; core_iter = hashmap_iter_next(ns, core_iter)) { - name = (char*)hashmap_iter_get_key(core_iter); - fn = hashmap_iter_get_data(core_iter); - env_set(repl_env, name, mal_builtin_function(fn, name, repl_env)); - } - - rep("(def! not (fn* (a) (if a false true)))", repl_env); - - char *buffer; - read_history("history.txt"); - while ((buffer = readline("user> ")) != NULL) { - printf("%s\n", rep(buffer, repl_env)); - if (strlen(buffer) > 0) { - add_history(buffer); - } - free(buffer); - } - write_history("history.txt"); - - return 0; -} diff --git a/step5_tco.c b/step5_tco.c deleted file mode 100644 index 55493d9..0000000 --- a/step5_tco.c +++ /dev/null @@ -1,754 +0,0 @@ -#include -#include -#include -#include -#include -#include -#include -#include - -#include "core.h" -#include "env.h" -#include "printer.h" -#include "reader.h" -#include "util.h" - -char program_template[] = -"#include \n" -"#include \n" -"#include \n" -"#include \n" -"#include \n" -"#include \n" -"{{TOP_CODE}}\n" -"MalType* EVAL(MalEnv *env0) {\n" -" {{EVAL_CODE}}\n" -"}"; - -int compile_eval(MalType *ast, MalEnv *env, int *var_num, MalType* (**EVAL)(MalEnv *env)); -int gen_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_call_args_code(MalType *args_name, MalType *node, MalEnv *env, struct codegen *code, int *var_num); -int gen_call_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_closure_code(MalType *fn_name, MalEnv *env, struct codegen *code, int ret); -int gen_continuation_code(char *prefix, MalType *node, MalEnv *env, struct codegen *code, int ret, int trampoline, int *var_num); -int gen_def_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_do_code(MalType *list, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_fn_code(MalType *fn_name, MalType *node, MalEnv *env, struct codegen *code, int *var_num, int new_env); -int gen_hashmap_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_if_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_keyword_code(MalType *node, struct codegen *code, int ret); -int gen_let_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_list_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_number_code(MalType *node, struct codegen *code, int ret); -int gen_string_code(MalType *node, struct codegen *code, int ret); -int gen_symbol_code(MalType *node, struct codegen *code, int ret); -int gen_symbol_lookup_code(MalType *node, MalEnv *env, struct codegen *code, int ret); -int gen_vector_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -void append_code(MalType *code, MalType *temp_code, int ret); -MalType* next_var_name(char *base, int *var_num); -MalType* build_env_name(MalEnv *env); - -MalType* READ(char *str) { - return read_str(str); -} - -MalType* EVAL(MalType *ast, MalEnv *repl_env) { - MalType* (*EVAL)(MalEnv *env); - int var_num = 1; - if (compile_eval(ast, repl_env, &var_num, &EVAL)) { - return trampoline(EVAL(repl_env)); - } else { - printf("There was an error compiling.\n"); - return mal_blank_line(); - } -} - -char *PATH = NULL; - -int compile_eval(MalType *ast, MalEnv *env, int *var_num, MalType* (**EVAL)(MalEnv *env)) { - struct codegen code = { mal_string(""), mal_string(""), mal_string("") }; - int success = gen_code(ast, env, &code, 1, var_num); - - if (!success) { - return 0; - } - - MalType *generated = mal_string_replace(mal_string(program_template), "{{TOP_CODE}}", code.top->str); - - MalType *combined = code.decl; - mal_string_append_mal_string(combined, code.body); - generated = mal_string_replace(generated, "{{EVAL_CODE}}", combined->str); - - if (getenv("DEBUG")) { - printf("-----------------\n%s-----------------\n", generated->str); - } - - TCCState *s = tcc_new(); - if (!s) { - fprintf(stderr, "Could not create tcc state\n"); - return 0; - } - - if(access("./tinycc/libtcc.h", F_OK) != -1) { - tcc_set_lib_path(s, "./tinycc"); - tcc_add_include_path(s, "./tinycc"); - tcc_add_include_path(s, "."); - } else if(PATH) { - tcc_set_lib_path(s, mal_sprintf("%s/tinycc", PATH)->str); - tcc_add_include_path(s, mal_sprintf("%s/tinycc", PATH)->str); - tcc_add_include_path(s, PATH); - } else { - printf("Could not determine path to tinycc and libtcc.h\n"); - exit(1); - } - - tcc_set_output_type(s, TCC_OUTPUT_MEMORY); - - if (tcc_compile_string(s, string(generated->str)) == -1) { - fprintf(stderr, "Could not compile program\n"); - return 0; - } - - tcc_add_symbol(s, "build_env", build_env); - tcc_add_symbol(s, "env_get", env_get); - tcc_add_symbol(s, "env_set", env_set); - tcc_add_symbol(s, "mal_closure", mal_closure); - tcc_add_symbol(s, "mal_continuation", mal_continuation); - tcc_add_symbol(s, "mal_empty", mal_empty); - tcc_add_symbol(s, "mal_error", mal_error); - tcc_add_symbol(s, "mal_false", mal_false); - tcc_add_symbol(s, "mal_hashmap", mal_hashmap); - tcc_add_symbol(s, "mal_hashmap_put", mal_hashmap_put); - tcc_add_symbol(s, "mal_keyword", mal_keyword); - tcc_add_symbol(s, "mal_nil", mal_nil); - tcc_add_symbol(s, "mal_number", mal_number); - tcc_add_symbol(s, "mal_sprintf", mal_sprintf); - tcc_add_symbol(s, "mal_string", mal_string); - tcc_add_symbol(s, "mal_true", mal_true); - tcc_add_symbol(s, "mal_vector", mal_vector); - tcc_add_symbol(s, "mal_vector_push", mal_vector_push); - tcc_add_symbol(s, "mal_vector_to_list", mal_vector_to_list); - tcc_add_symbol(s, "pr_str", pr_str); - tcc_add_symbol(s, "trampoline", trampoline); - - int size = tcc_relocate(s, NULL); - if (size < 0) { - fprintf(stderr, "Could not determine size of program\n"); - return 0; - } - - void *mem = GC_MALLOC(size); - if (tcc_relocate(s, mem) < 0) { - fprintf(stderr, "Could not relocate program\n"); - return 0; - } - - *EVAL = tcc_get_symbol(s, "EVAL"); - tcc_delete(s); - - if (!*EVAL) { - fprintf(stderr, "Could not find symbol EVAL\n"); - return 0; - } - - return 1; -} - -int gen_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - switch (node->type) { - case MAL_CONS_TYPE: - return gen_call_code(node, env, code, ret, var_num); - case MAL_EMPTY_TYPE: - append_code(code->body, mal_string("mal_empty()"), ret); - return 1; - case MAL_FALSE_TYPE: - append_code(code->body, mal_string("mal_false()"), ret); - return 1; - case MAL_HASHMAP_TYPE: - return gen_hashmap_code(node, env, code, ret, var_num); - case MAL_KEYWORD_TYPE: - return gen_keyword_code(node, code, ret); - case MAL_NIL_TYPE: - append_code(code->body, mal_string("mal_nil()"), ret); - return 1; - case MAL_NUMBER_TYPE: - return gen_number_code(node, code, ret); - case MAL_STRING_TYPE: - return gen_string_code(node, code, ret); - case MAL_SYMBOL_TYPE: - return gen_symbol_lookup_code(node, env, code, ret); - case MAL_TRUE_TYPE: - append_code(code->body, mal_string("mal_true()"), ret); - return 1; - case MAL_VECTOR_TYPE: - return gen_vector_code(node, env, code, ret, var_num); - default: - printf("unknown node type in code gen type=%d\n", node->type); - return 0; - } -} - -int gen_call_args_code(MalType *args_name, MalType *node, MalEnv *env, struct codegen *code, int *var_num) { - if (is_empty(node)) { - append_code(code->decl, mal_sprintf("MalType **%S = NULL;", args_name), 0); - return 1; - } - assert(is_cons(node)); - size_t arg_count = mal_list_len(node), index = 0; - MalType *temp_code = mal_sprintf("MalType **%S = GC_MALLOC(sizeof(MalType*) * %z);\n ", args_name, arg_count); - struct codegen code2; - while (!is_empty(node)) { - assert(is_cons(node)); - mal_string_append_mal_string(temp_code, mal_sprintf("%S[%z] = bubble_if_error(", args_name, index)); - code2 = (struct codegen){ code->top, code->decl, temp_code }; - if (!gen_code(mal_car(node), env, &code2, 0, var_num)) { - return 0; - } - mal_string_append(temp_code, ");\n "); - node = mal_cdr(node); - index++; - } - append_code(code->decl, temp_code, 0); - return 1; -} - -int gen_call_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *sym = mal_car(node), *temp_code, *fn_name; - - if (is_symbol(sym)) { - if (strcmp(sym->symbol, "def!") == 0) { - return gen_def_code(mal_cdr(node), env, code, ret, var_num); - } else if (strcmp(sym->symbol, "let*") == 0) { - return gen_let_code(mal_cdr(node), env, code, ret, var_num); - } else if (strcmp(sym->symbol, "do") == 0) { - return gen_do_code(mal_cdr(node), env, code, ret, var_num); - } else if (strcmp(sym->symbol, "if") == 0) { - return gen_if_code(mal_cdr(node), env, code, ret, var_num); - } else if (strcmp(sym->symbol, "fn*") == 0) { - fn_name = next_var_name("fn", var_num); - if (!gen_fn_code(fn_name, mal_cdr(node), env, code, var_num, 1)) { - return 0; - } - return gen_closure_code(fn_name, env, code, ret); - } - } - - // look up the lambda in the env - MalType *lambda_name = next_var_name("lambda", var_num); - temp_code = mal_string("MalType *"); - mal_string_append_mal_string(temp_code, lambda_name); - mal_string_append(temp_code, " = "); - struct codegen code2 = { code->top, code->decl, temp_code }; - if (!gen_code(sym, env, &code2, 0, var_num)) { - return 0; - } - mal_string_append(temp_code, ";\n "); - mal_string_append_mal_string( - temp_code, - mal_sprintf( - "if (!is_lambda(%S)) { return mal_error(mal_sprintf(\"%%s is not callable\", pr_str(%S, 1))); }\n ", - lambda_name, - lambda_name - ) - ); - append_code(code->decl, temp_code, 0); - - // build the args array - MalType *args_name, *args_node = mal_cdr(node); - size_t args_count = mal_list_len(args_node); - if (args_count == 0) { - args_name = mal_string("NULL"); - } else { - args_name = mal_string_replace(lambda_name, "lambda", "args"); - if (!gen_call_args_code(args_name, args_node, env, code, var_num)) { - return 0; - } - } - - // return the functional call as a continuation - temp_code = mal_sprintf( - "mal_continuation(%S->fn, %S->env, %z, %S)", - lambda_name, - lambda_name, - args_count, - args_name - ); - - append_code( - code->body, - ret ? temp_code : mal_sprintf("trampoline(%S)", temp_code), - ret - ); - - return 1; -} - -int gen_closure_code(MalType *fn_name, MalEnv *env, struct codegen *code, int ret) { - MalType *closure_name = mal_string("closure_"); - mal_string_append_mal_string(closure_name, fn_name); - MalType *temp_code = mal_sprintf( - "MalType *%S = mal_closure(%S, %S);\n ", - closure_name, - fn_name, - build_env_name(env) - ); - append_code(code->decl, temp_code, 0); - append_code(code->body, closure_name, ret); - return 1; -} - -int gen_continuation_code(char *prefix, MalType *node, MalEnv *env, struct codegen *code, int ret, int trampoline, int *var_num) { - MalType *fn = mal_cons(mal_empty(), mal_cons(node, mal_empty())); - MalType *fn_name = next_var_name(prefix, var_num); - if (!gen_fn_code(fn_name, fn, env, code, var_num, 0)) { - return 0; - } - MalType *temp_code = mal_string(""); - append_code(temp_code, mal_sprintf("mal_continuation(%S, %S, 0, NULL)", fn_name, build_env_name(env)), 0); - append_code(code->body, trampoline ? temp_code : mal_sprintf("trampoline(%S)", temp_code), ret); - return 1; -} - -int gen_def_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *env_name = build_env_name(env); - MalType *name = mal_car(node); - assert(is_symbol(name)); - char *name_str = pr_str(mal_string(name->symbol), 1); - - int key_already_exists = !!env_get(env, name->symbol); - if (!key_already_exists) env_set(env, name->symbol, mal_true()); - struct codegen code2 = (struct codegen){ code->top, code->decl, mal_string("") }; - MalType *val_node = mal_car(mal_cdr(node)); - if (!gen_code(val_node, env, &code2, 0, var_num)) { - if (!key_already_exists) env_delete(env, name->symbol); - return 0; - } - - MalType *temp_code = mal_sprintf("env_set(%S, %s, bubble_if_error(%S))", env_name, name_str, code2.body); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_do_code(MalType *list, MalEnv *env, struct codegen *code, int ret, int *var_num) { - struct list_or_vector_iter *iter; - struct codegen code2; - MalType *node, *temp_decl, *temp_code; - int is_last = 0; - for (iter = list_or_vector_iter(list); iter; iter = list_or_vector_iter_next(iter)) { - temp_decl = mal_string(""); - temp_code = mal_string(""); - node = list_or_vector_iter_get_obj(iter); - is_last = list_or_vector_iter_is_last(iter); - code2 = (struct codegen){ code->top, temp_decl, temp_code }; - if (is_last) { - if (!gen_continuation_code("do", node, env, &code2, ret, ret, var_num)) { - return 0; - } - } else { - if (!gen_code(node, env, &code2, 0, var_num)) { - return 0; - } - } - if (is_last) { - append_code(code->decl, temp_decl, 0); - append_code(code->body, temp_code, 0); - } else { - mal_string_append(temp_code, ";\n "); - append_code(code->decl, temp_decl, 0); - append_code(code->decl, temp_code, 0); - } - } - return 1; -} - -int gen_fn_code(MalType *fn_name, MalType *node, MalEnv *env, struct codegen *code, int *var_num, int new_env) { - MalType *args = mal_car(node); - size_t arg_count = list_or_vector_len(args); - - // function header - MalType *temp_fn = mal_sprintf("MalType* %S(MalEnv *env, size_t argc, MalType **args) {\n ", fn_name); - - // inner env - MalEnv *inner_env; - MalType *inner_env_name; - if (new_env) { - inner_env = build_env(env); - inner_env->num = (*var_num)++; - inner_env_name = build_env_name(inner_env); - mal_string_append_mal_string(temp_fn, mal_sprintf("MalEnv *%S = build_env(env);\n ", inner_env_name)); - } else { - inner_env = env; - inner_env_name = build_env_name(env); - mal_string_append_mal_string(temp_fn, mal_sprintf("MalEnv *%S = env;\n ", inner_env_name)); - } - - // arity check - int more_pos = list_or_vector_index_of(args, mal_symbol("&")); - if (more_pos == -1) { - mal_string_append_mal_string( - temp_fn, - mal_sprintf("mal_assert(argc == %i, \"Arity mismatch.\");\n ", arg_count) - ); - } else { - mal_string_append_mal_string( - temp_fn, - mal_sprintf("mal_assert(argc >= %i, \"Arity mismatch.\");\n ", more_pos) - ); - } - - // set arguments in inner env - if (arg_count > 0) { - struct list_or_vector_iter *iter; - MalType *arg; - size_t index = 0; - int is_more = 0; - for (iter = list_or_vector_iter(args); iter; iter = list_or_vector_iter_next(iter)) { - arg = list_or_vector_iter_get_obj(iter); - assert(is_symbol(arg)); - if (strcmp("&", arg->symbol) == 0) { - is_more = 1; - continue; - } - if (is_more) { - // accumulate remaining args in a list - char *more_name = arg->symbol; - mal_string_append(temp_fn, "MalType *rest_args = mal_vector();\n "); - mal_string_append_mal_string( - temp_fn, - mal_sprintf("for(size_t arg_i=%z; arg_isymbol), 1), - index - ) - ); - env_set(inner_env, arg->symbol, mal_true()); - index++; - } - } - } - - // function body - MalType *fn_decl = mal_string(""); - MalType *fn_code = mal_string(""); - struct codegen code2 = (struct codegen){ code->top, fn_decl, fn_code }; - MalType *fn_body = mal_cdr(node); - assert(!is_empty(fn_body)); - if (!gen_code(mal_car(fn_body), inner_env, &code2, 1, var_num)) { - return 0; - } - append_code(temp_fn, fn_decl, 0); - append_code(temp_fn, fn_code, 0); - - // closing brace - mal_string_append(temp_fn, "\n}\n\n"); - append_code(code->top, temp_fn, 0); - - return 1; -} - -int gen_hashmap_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - int len = mal_hashmap_size(node); - if (len == 0) { - append_code(code->body, mal_string("mal_hashmap()"), ret); - return 1; - } - - MalType *var_name = next_var_name("var", var_num); - MalType *temp_code = mal_string("MalType *"); - mal_string_append_mal_string(temp_code, var_name); - mal_string_append(temp_code, " = mal_hashmap();\n "); - - struct hashmap_iter *iter; - struct codegen code2; - char *key_str; - MalType *val; - for (iter = hashmap_iter(&node->hashmap); iter; iter = hashmap_iter_next(&node->hashmap, iter)) { - key_str = (char*)hashmap_iter_get_key(iter); - val = (MalType*)hashmap_iter_get_data(iter); - mal_string_append(temp_code, "mal_hashmap_put("); - mal_string_append_mal_string(temp_code, var_name); - mal_string_append(temp_code, ", "); - code2 = (struct codegen){ code->top, code->decl, temp_code }; - if (!gen_code(read_str(key_str), env, &code2, 0, var_num)) { - return 0; - } - mal_string_append(temp_code, ", "); - code2 = (struct codegen){ code->top, code->decl, temp_code }; - if (!gen_code(val, env, &code2, 0, var_num)) { - return 0; - } - mal_string_append(temp_code, ");\n "); - } - - append_code(code->decl, temp_code, 0); - append_code(code->body, var_name, ret); - return 1; -} - -int gen_if_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *cond_code = mal_string(""); - struct codegen code2 = (struct codegen){ code->top, code->decl, cond_code }; - if (!gen_code(mal_car(node), env, &code2, 0, var_num)) { - return 0; - } - node = mal_cdr(node); - MalType *true_code = mal_string(""); - code2.body = true_code; - MalType *true_val = mal_car(node); - if (is_primitive(true_val)) { - if (!gen_code(true_val, env, &code2, 0, var_num)) { - return 0; - } - } else { - if (!gen_continuation_code("if_true", true_val, env, &code2, 0, ret, var_num)) { - return 0; - } - } - node = mal_cdr(node); - MalType *false_code = mal_string(""); - code2.body = false_code; - MalType *false_val; - if (is_empty(node)) { - false_val = mal_nil(); - } else { - false_val = mal_car(node); - } - if (is_primitive(false_val)) { - if (!gen_code(false_val, env, &code2, 0, var_num)) { - return 0; - } - } else { - if (!gen_continuation_code("if_false", false_val, env, &code2, 0, ret, var_num)) { - return 0; - } - } - append_code( - code->body, - mal_sprintf("is_truthy(%S) ? %S : %S", cond_code, true_code, false_code), - ret - ); - return 1; -} - -int gen_keyword_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_keyword(%s)", pr_str(mal_string(node->keyword), 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_let_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalEnv *inner_env = build_env(env); - inner_env->num = (*var_num)++; - MalType *outer_env_name = build_env_name(env); - MalType *inner_env_name = build_env_name(inner_env); - MalType *temp_code = mal_sprintf("MalEnv *%S = build_env(%S);\n ", inner_env_name, outer_env_name); - append_code(code->decl, temp_code, 0); - - temp_code = mal_string(""); - - struct list_or_vector_iter *iter; - struct codegen code2; - MalType *name, *val, *inner_decl, *val_code; - for (iter = list_or_vector_iter(mal_car(node)); iter; iter = list_or_vector_iter_next(iter)) { - inner_decl = mal_string(""); - name = list_or_vector_iter_get_obj(iter); - assert(is_symbol(name)); - iter = list_or_vector_iter_next(iter); - val = list_or_vector_iter_get_obj(iter); - env_set(inner_env, name->symbol, mal_true()); - code2 = (struct codegen){ code->top, inner_decl, mal_string("") }; - if (!gen_code(val, inner_env, &code2, 0, var_num)) { - return 0; - } - val_code = mal_sprintf("env_set(%S, %s, %S);\n ", inner_env_name, pr_str(mal_string(name->symbol), 1), code2.body); - mal_string_append_mal_string(temp_code, inner_decl); - mal_string_append_mal_string(temp_code, val_code); - } - - append_code(code->decl, temp_code, 0); - - node = mal_cdr(node); - if (!gen_continuation_code("let", mal_car(node), inner_env, code, ret, ret, var_num)) { - return 0; - } - - return 1; -} - -int gen_list_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *list_name = next_var_name("list", var_num); - MalType *temp_decl = mal_sprintf("MalType *%S = mal_vector();\n ", list_name); - struct list_or_vector_iter *iter; - MalType *item; - struct codegen code2; - for (iter = list_or_vector_iter(node); iter; iter = list_or_vector_iter_next(iter)) { - item = list_or_vector_iter_get_obj(iter); - mal_string_append_mal_string( - temp_decl, - mal_sprintf("mal_vector_push(%S, ", list_name) - ); - code2 = (struct codegen){ code->top, code->decl, temp_decl }; - if (!gen_code(item, env, &code2, 0, var_num)) { - return 0; - } - mal_string_append(temp_decl, ");\n "); - } - append_code(code->decl, temp_decl, 0); - append_code(code->body, mal_sprintf("mal_vector_to_list(%S)", list_name), ret); - return 1; -} - -int gen_lambda_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("(MalType*)%p /* %s */", node, pr_str(node, 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_number_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_number(%s)", pr_str(node, 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_string_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_string(%s)", pr_str(node, 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_symbol_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_symbol(%s)", pr_str(mal_string(node->symbol), 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_symbol_lookup_code(MalType *node, MalEnv *env, struct codegen *code, int ret) { - UNUSED(env); - MalType *temp_code = mal_sprintf( - "bubble_if_error(env_get(%S, %s))", - build_env_name(env), - pr_str(mal_string(node->symbol), 1) - ); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_vector_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *var_name = next_var_name("var", var_num); - MalType *temp_code = mal_string("MalType *"); - mal_string_append_mal_string(temp_code, var_name); - mal_string_append(temp_code, " = mal_vector();\n "); - struct codegen code2; - for(size_t i=0; itop, code->decl, temp_code }; - if (!gen_code(mal_vector_ref(node, i), env, &code2, 0, var_num)) { - return 0; - } - mal_string_append(temp_code, ");\n "); - } - append_code(code->decl, temp_code, 0); - append_code(code->body, var_name, ret); - return 1; -} - -void append_code(MalType *code, MalType *temp_code, int ret) { - if (ret) mal_string_append(code, "return "); - mal_string_append_mal_string(code, temp_code); - if (ret) mal_string_append(code, ";"); -} - -MalType* next_var_name(char *base, int *var_num) { - MalType *var_name = mal_string(base); - mal_string_append_long_long(var_name, (*var_num)++); - return var_name; -} - -MalType* build_env_name(MalEnv *env) { - MalType *name = mal_string("env"); - mal_string_append_long_long(name, env->num); - return name; -} - -char* PRINT(MalType *ast) { - return pr_str(ast, 2); -} - -char* rep(char *str, MalEnv *repl_env) { - MalType *result = EVAL(READ(str), repl_env); - if (is_error(result)) { - return PRINT(mal_sprintf("ERROR: %s\n", pr_str(result->error_val, 0))); - } else { - return PRINT(result); - } -} - -char *parent_directory(char *bin_path) { - char *path = string(bin_path); - size_t len; - while ((len = strlen(path)) > 0 && path[len - 1] != '/') { - path[len - 1] = 0; - } - if (len > 0) path[len - 1] = 0; - if (strlen(path) == 0) { - return string("."); - } else { - return path; - } -} - -int main(int argc, char *argv[]) { - UNUSED(argc); - - PATH = parent_directory(argv[0]); - - MalEnv *repl_env = build_top_env(); - - struct hashmap *ns = core_ns(); - struct hashmap_iter *core_iter; - char *name; - MalType* (*fn)(MalEnv*, size_t, MalType**); - for (core_iter = hashmap_iter(ns); core_iter; core_iter = hashmap_iter_next(ns, core_iter)) { - name = (char*)hashmap_iter_get_key(core_iter); - fn = hashmap_iter_get_data(core_iter); - env_set(repl_env, name, mal_builtin_function(fn, name, repl_env)); - } - - rep("(def! not (fn* (a) (if a false true)))", repl_env); - - char *buffer; - read_history("history.txt"); - while ((buffer = readline("user> ")) != NULL) { - printf("%s\n", rep(buffer, repl_env)); - if (strlen(buffer) > 0) { - add_history(buffer); - } - free(buffer); - } - write_history("history.txt"); - - return 0; -} diff --git a/step6_file.c b/step6_file.c deleted file mode 100644 index 8b501b0..0000000 --- a/step6_file.c +++ /dev/null @@ -1,784 +0,0 @@ -#include -#include -#include -#include -#include -#include -#include -#include - -#include "core.h" -#include "env.h" -#include "printer.h" -#include "reader.h" -#include "util.h" - -char program_template[] = -"#include \n" -"#include \n" -"#include \n" -"#include \n" -"#include \n" -"#include \n" -"{{TOP_CODE}}\n" -"MalType* EVAL(MalEnv *env0) {\n" -" {{EVAL_CODE}}\n" -"}"; - -int compile_eval(MalType *ast, MalEnv *env, int *var_num, MalType* (**EVAL)(MalEnv *env)); -int gen_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_call_args_code(MalType *args_name, MalType *node, MalEnv *env, struct codegen *code, int *var_num); -int gen_call_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_closure_code(MalType *fn_name, MalEnv *env, struct codegen *code, int ret); -int gen_continuation_code(char *prefix, MalType *node, MalEnv *env, struct codegen *code, int ret, int trampoline, int *var_num); -int gen_def_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_do_code(MalType *list, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_fn_code(MalType *fn_name, MalType *node, MalEnv *env, struct codegen *code, int *var_num, int new_env); -int gen_hashmap_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_if_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_keyword_code(MalType *node, struct codegen *code, int ret); -int gen_let_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_list_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_number_code(MalType *node, struct codegen *code, int ret); -int gen_string_code(MalType *node, struct codegen *code, int ret); -int gen_symbol_code(MalType *node, struct codegen *code, int ret); -int gen_symbol_lookup_code(MalType *node, MalEnv *env, struct codegen *code, int ret); -int gen_vector_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -void append_code(MalType *code, MalType *temp_code, int ret); -MalType* next_var_name(char *base, int *var_num); -MalType* build_env_name(MalEnv *env); -MalType* trampoline(MalType *result); - -MalType* READ(char *str) { - return read_str(str); -} - -MalType* EVAL(MalType *ast, MalEnv *repl_env) { - MalType* (*EVAL)(MalEnv *env); - int var_num = 1; - if (compile_eval(ast, repl_env, &var_num, &EVAL)) { - return trampoline(EVAL(repl_env)); - } else { - printf("There was an error compiling.\n"); - return mal_blank_line(); - } -} - -MalType* user_eval(MalEnv *repl_env, size_t argc, MalType **args) { - UNUSED(repl_env); - mal_assert(argc == 1, "Expected 1 argument to eval"); - MalType* (*EVAL)(MalEnv *env); - MalType *ast = args[0]; - int var_num = 1; - if (compile_eval(ast, repl_env, &var_num, &EVAL)) { - return trampoline(EVAL(repl_env)); - } else { - return mal_error(mal_string("There was an error compiling.")); - } -} - -char *PATH = NULL; - -int compile_eval(MalType *ast, MalEnv *env, int *var_num, MalType* (**EVAL)(MalEnv *env)) { - struct codegen code = { mal_string(""), mal_string(""), mal_string("") }; - int success = gen_code(ast, env, &code, 1, var_num); - - if (!success) { - return 0; - } - - MalType *generated = mal_string_replace(mal_string(program_template), "{{TOP_CODE}}", code.top->str); - - MalType *combined = code.decl; - mal_string_append_mal_string(combined, code.body); - generated = mal_string_replace(generated, "{{EVAL_CODE}}", combined->str); - - if (getenv("DEBUG")) { - printf("-----------------\n%s-----------------\n", generated->str); - } - - TCCState *s = tcc_new(); - if (!s) { - fprintf(stderr, "Could not create tcc state\n"); - return 0; - } - - if(access("./tinycc/libtcc.h", F_OK) != -1) { - tcc_set_lib_path(s, "./tinycc"); - tcc_add_include_path(s, "./tinycc"); - tcc_add_include_path(s, "."); - } else if(PATH) { - tcc_set_lib_path(s, mal_sprintf("%s/tinycc", PATH)->str); - tcc_add_include_path(s, mal_sprintf("%s/tinycc", PATH)->str); - tcc_add_include_path(s, PATH); - } else { - printf("Could not determine path to tinycc and libtcc.h\n"); - exit(1); - } - - tcc_set_output_type(s, TCC_OUTPUT_MEMORY); - - if (tcc_compile_string(s, string(generated->str)) == -1) { - fprintf(stderr, "Could not compile program\n"); - return 0; - } - - tcc_add_symbol(s, "build_env", build_env); - tcc_add_symbol(s, "env_get", env_get); - tcc_add_symbol(s, "env_set", env_set); - tcc_add_symbol(s, "mal_closure", mal_closure); - tcc_add_symbol(s, "mal_continuation", mal_continuation); - tcc_add_symbol(s, "mal_empty", mal_empty); - tcc_add_symbol(s, "mal_error", mal_error); - tcc_add_symbol(s, "mal_false", mal_false); - tcc_add_symbol(s, "mal_hashmap", mal_hashmap); - tcc_add_symbol(s, "mal_hashmap_put", mal_hashmap_put); - tcc_add_symbol(s, "mal_keyword", mal_keyword); - tcc_add_symbol(s, "mal_nil", mal_nil); - tcc_add_symbol(s, "mal_number", mal_number); - tcc_add_symbol(s, "mal_sprintf", mal_sprintf); - tcc_add_symbol(s, "mal_string", mal_string); - tcc_add_symbol(s, "mal_true", mal_true); - tcc_add_symbol(s, "mal_vector", mal_vector); - tcc_add_symbol(s, "mal_vector_push", mal_vector_push); - tcc_add_symbol(s, "mal_vector_to_list", mal_vector_to_list); - tcc_add_symbol(s, "pr_str", pr_str); - tcc_add_symbol(s, "trampoline", trampoline); - - int size = tcc_relocate(s, NULL); - if (size < 0) { - fprintf(stderr, "Could not determine size of program\n"); - return 0; - } - - void *mem = GC_MALLOC(size); - if (tcc_relocate(s, mem) < 0) { - fprintf(stderr, "Could not relocate program\n"); - return 0; - } - - *EVAL = tcc_get_symbol(s, "EVAL"); - tcc_delete(s); - - if (!*EVAL) { - fprintf(stderr, "Could not find symbol EVAL\n"); - return 0; - } - - return 1; -} - -int gen_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - switch (node->type) { - case MAL_CONS_TYPE: - return gen_call_code(node, env, code, ret, var_num); - case MAL_EMPTY_TYPE: - append_code(code->body, mal_string("mal_empty()"), ret); - return 1; - case MAL_FALSE_TYPE: - append_code(code->body, mal_string("mal_false()"), ret); - return 1; - case MAL_HASHMAP_TYPE: - return gen_hashmap_code(node, env, code, ret, var_num); - case MAL_KEYWORD_TYPE: - return gen_keyword_code(node, code, ret); - case MAL_NIL_TYPE: - append_code(code->body, mal_string("mal_nil()"), ret); - return 1; - case MAL_NUMBER_TYPE: - return gen_number_code(node, code, ret); - case MAL_STRING_TYPE: - return gen_string_code(node, code, ret); - case MAL_SYMBOL_TYPE: - return gen_symbol_lookup_code(node, env, code, ret); - case MAL_TRUE_TYPE: - append_code(code->body, mal_string("mal_true()"), ret); - return 1; - case MAL_VECTOR_TYPE: - return gen_vector_code(node, env, code, ret, var_num); - default: - printf("unknown node type in code gen type=%d\n", node->type); - return 0; - } -} - -int gen_call_args_code(MalType *args_name, MalType *node, MalEnv *env, struct codegen *code, int *var_num) { - if (is_empty(node)) { - append_code(code->decl, mal_sprintf("MalType **%S = NULL;", args_name), 0); - return 1; - } - assert(is_cons(node)); - size_t arg_count = mal_list_len(node), index = 0; - MalType *temp_code = mal_sprintf("MalType **%S = GC_MALLOC(sizeof(MalType*) * %z);\n ", args_name, arg_count); - struct codegen code2; - while (!is_empty(node)) { - assert(is_cons(node)); - mal_string_append_mal_string(temp_code, mal_sprintf("%S[%z] = bubble_if_error(", args_name, index)); - code2 = (struct codegen){ code->top, code->decl, temp_code }; - if (!gen_code(mal_car(node), env, &code2, 0, var_num)) { - return 0; - } - mal_string_append(temp_code, ");\n "); - node = mal_cdr(node); - index++; - } - append_code(code->decl, temp_code, 0); - return 1; -} - -int gen_call_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *sym = mal_car(node), *temp_code, *fn_name; - - if (is_symbol(sym)) { - if (strcmp(sym->symbol, "def!") == 0) { - return gen_def_code(mal_cdr(node), env, code, ret, var_num); - } else if (strcmp(sym->symbol, "let*") == 0) { - return gen_let_code(mal_cdr(node), env, code, ret, var_num); - } else if (strcmp(sym->symbol, "do") == 0) { - return gen_do_code(mal_cdr(node), env, code, ret, var_num); - } else if (strcmp(sym->symbol, "if") == 0) { - return gen_if_code(mal_cdr(node), env, code, ret, var_num); - } else if (strcmp(sym->symbol, "fn*") == 0) { - fn_name = next_var_name("fn", var_num); - if (!gen_fn_code(fn_name, mal_cdr(node), env, code, var_num, 1)) { - return 0; - } - return gen_closure_code(fn_name, env, code, ret); - } - } - - // look up the lambda in the env - MalType *lambda_name = next_var_name("lambda", var_num); - temp_code = mal_string("MalType *"); - mal_string_append_mal_string(temp_code, lambda_name); - mal_string_append(temp_code, " = "); - struct codegen code2 = { code->top, code->decl, temp_code }; - if (!gen_code(sym, env, &code2, 0, var_num)) { - return 0; - } - mal_string_append(temp_code, ";\n "); - mal_string_append_mal_string( - temp_code, - mal_sprintf( - "if (!is_lambda(%S)) { return mal_error(mal_sprintf(\"%%s is not callable\", pr_str(%S, 1))); }\n ", - lambda_name, - lambda_name - ) - ); - append_code(code->decl, temp_code, 0); - - // build the args array - MalType *args_name, *args_node = mal_cdr(node); - size_t args_count = mal_list_len(args_node); - if (args_count == 0) { - args_name = mal_string("NULL"); - } else { - args_name = mal_string_replace(lambda_name, "lambda", "args"); - if (!gen_call_args_code(args_name, args_node, env, code, var_num)) { - return 0; - } - } - - // return the functional call as a continuation - temp_code = mal_sprintf( - "mal_continuation(%S->fn, %S->env, %z, %S)", - lambda_name, - lambda_name, - args_count, - args_name - ); - - append_code( - code->body, - ret ? temp_code : mal_sprintf("trampoline(%S)", temp_code), - ret - ); - - return 1; -} - -int gen_closure_code(MalType *fn_name, MalEnv *env, struct codegen *code, int ret) { - MalType *closure_name = mal_string("closure_"); - mal_string_append_mal_string(closure_name, fn_name); - MalType *temp_code = mal_sprintf( - "MalType *%S = mal_closure(%S, %S);\n ", - closure_name, - fn_name, - build_env_name(env) - ); - append_code(code->decl, temp_code, 0); - append_code(code->body, closure_name, ret); - return 1; -} - -int gen_continuation_code(char *prefix, MalType *node, MalEnv *env, struct codegen *code, int ret, int trampoline, int *var_num) { - MalType *fn = mal_cons(mal_empty(), mal_cons(node, mal_empty())); - MalType *fn_name = next_var_name(prefix, var_num); - if (!gen_fn_code(fn_name, fn, env, code, var_num, 0)) { - return 0; - } - MalType *temp_code = mal_string(""); - append_code(temp_code, mal_sprintf("mal_continuation(%S, %S, 0, NULL)", fn_name, build_env_name(env)), 0); - append_code(code->body, trampoline ? temp_code : mal_sprintf("trampoline(%S)", temp_code), ret); - return 1; -} - -int gen_def_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *env_name = build_env_name(env); - MalType *name = mal_car(node); - assert(is_symbol(name)); - char *name_str = pr_str(mal_string(name->symbol), 1); - - int key_already_exists = !!env_get(env, name->symbol); - if (!key_already_exists) env_set(env, name->symbol, mal_true()); - struct codegen code2 = (struct codegen){ code->top, code->decl, mal_string("") }; - MalType *val_node = mal_car(mal_cdr(node)); - if (!gen_code(val_node, env, &code2, 0, var_num)) { - if (!key_already_exists) env_delete(env, name->symbol); - return 0; - } - - MalType *temp_code = mal_sprintf("env_set(%S, %s, bubble_if_error(%S))", env_name, name_str, code2.body); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_do_code(MalType *list, MalEnv *env, struct codegen *code, int ret, int *var_num) { - struct list_or_vector_iter *iter; - struct codegen code2; - MalType *node, *temp_decl, *temp_code; - int is_last = 0; - for (iter = list_or_vector_iter(list); iter; iter = list_or_vector_iter_next(iter)) { - temp_decl = mal_string(""); - temp_code = mal_string(""); - node = list_or_vector_iter_get_obj(iter); - is_last = list_or_vector_iter_is_last(iter); - code2 = (struct codegen){ code->top, temp_decl, temp_code }; - if (is_last) { - if (!gen_continuation_code("do", node, env, &code2, ret, ret, var_num)) { - return 0; - } - } else { - if (!gen_code(node, env, &code2, 0, var_num)) { - return 0; - } - } - if (is_last) { - append_code(code->decl, temp_decl, 0); - append_code(code->body, temp_code, 0); - } else { - mal_string_append(temp_code, ";\n "); - append_code(code->decl, temp_decl, 0); - append_code(code->decl, temp_code, 0); - } - } - return 1; -} - -int gen_fn_code(MalType *fn_name, MalType *node, MalEnv *env, struct codegen *code, int *var_num, int new_env) { - MalType *args = mal_car(node); - size_t arg_count = list_or_vector_len(args); - - // function header - MalType *temp_fn = mal_sprintf("MalType* %S(MalEnv *env, size_t argc, MalType **args) {\n ", fn_name); - - // inner env - MalEnv *inner_env; - MalType *inner_env_name; - if (new_env) { - inner_env = build_env(env); - inner_env->num = (*var_num)++; - inner_env_name = build_env_name(inner_env); - mal_string_append_mal_string(temp_fn, mal_sprintf("MalEnv *%S = build_env(env);\n ", inner_env_name)); - } else { - inner_env = env; - inner_env_name = build_env_name(env); - mal_string_append_mal_string(temp_fn, mal_sprintf("MalEnv *%S = env;\n ", inner_env_name)); - } - - // arity check - int more_pos = list_or_vector_index_of(args, mal_symbol("&")); - if (more_pos == -1) { - mal_string_append_mal_string( - temp_fn, - mal_sprintf("mal_assert(argc == %i, \"Arity mismatch.\");\n ", arg_count) - ); - } else { - mal_string_append_mal_string( - temp_fn, - mal_sprintf("mal_assert(argc >= %i, \"Arity mismatch.\");\n ", more_pos) - ); - } - - // set arguments in inner env - if (arg_count > 0) { - struct list_or_vector_iter *iter; - MalType *arg; - size_t index = 0; - int is_more = 0; - for (iter = list_or_vector_iter(args); iter; iter = list_or_vector_iter_next(iter)) { - arg = list_or_vector_iter_get_obj(iter); - assert(is_symbol(arg)); - if (strcmp("&", arg->symbol) == 0) { - is_more = 1; - continue; - } - if (is_more) { - // accumulate remaining args in a list - char *more_name = arg->symbol; - mal_string_append(temp_fn, "MalType *rest_args = mal_vector();\n "); - mal_string_append_mal_string( - temp_fn, - mal_sprintf("for(size_t arg_i=%z; arg_isymbol), 1), - index - ) - ); - env_set(inner_env, arg->symbol, mal_true()); - index++; - } - } - } - - // function body - MalType *fn_decl = mal_string(""); - MalType *fn_code = mal_string(""); - struct codegen code2 = (struct codegen){ code->top, fn_decl, fn_code }; - MalType *fn_body = mal_cdr(node); - assert(!is_empty(fn_body)); - if (!gen_code(mal_car(fn_body), inner_env, &code2, 1, var_num)) { - return 0; - } - append_code(temp_fn, fn_decl, 0); - append_code(temp_fn, fn_code, 0); - - // closing brace - mal_string_append(temp_fn, "\n}\n\n"); - append_code(code->top, temp_fn, 0); - - return 1; -} - -int gen_hashmap_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - int len = mal_hashmap_size(node); - if (len == 0) { - append_code(code->body, mal_string("mal_hashmap()"), ret); - return 1; - } - - MalType *var_name = next_var_name("var", var_num); - MalType *temp_code = mal_string("MalType *"); - mal_string_append_mal_string(temp_code, var_name); - mal_string_append(temp_code, " = mal_hashmap();\n "); - - struct hashmap_iter *iter; - struct codegen code2; - char *key_str; - MalType *val; - for (iter = hashmap_iter(&node->hashmap); iter; iter = hashmap_iter_next(&node->hashmap, iter)) { - key_str = (char*)hashmap_iter_get_key(iter); - val = (MalType*)hashmap_iter_get_data(iter); - mal_string_append(temp_code, "mal_hashmap_put("); - mal_string_append_mal_string(temp_code, var_name); - mal_string_append(temp_code, ", "); - code2 = (struct codegen){ code->top, code->decl, temp_code }; - if (!gen_code(read_str(key_str), env, &code2, 0, var_num)) { - return 0; - } - mal_string_append(temp_code, ", "); - code2 = (struct codegen){ code->top, code->decl, temp_code }; - if (!gen_code(val, env, &code2, 0, var_num)) { - return 0; - } - mal_string_append(temp_code, ");\n "); - } - - append_code(code->decl, temp_code, 0); - append_code(code->body, var_name, ret); - return 1; -} - -int gen_if_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *cond_code = mal_string(""); - struct codegen code2 = (struct codegen){ code->top, code->decl, cond_code }; - if (!gen_code(mal_car(node), env, &code2, 0, var_num)) { - return 0; - } - node = mal_cdr(node); - MalType *true_code = mal_string(""); - code2.body = true_code; - MalType *true_val = mal_car(node); - if (is_primitive(true_val)) { - if (!gen_code(true_val, env, &code2, 0, var_num)) { - return 0; - } - } else { - if (!gen_continuation_code("if_true", true_val, env, &code2, 0, ret, var_num)) { - return 0; - } - } - node = mal_cdr(node); - MalType *false_code = mal_string(""); - code2.body = false_code; - MalType *false_val; - if (is_empty(node)) { - false_val = mal_nil(); - } else { - false_val = mal_car(node); - } - if (is_primitive(false_val)) { - if (!gen_code(false_val, env, &code2, 0, var_num)) { - return 0; - } - } else { - if (!gen_continuation_code("if_false", false_val, env, &code2, 0, ret, var_num)) { - return 0; - } - } - append_code( - code->body, - mal_sprintf("is_truthy(%S) ? %S : %S", cond_code, true_code, false_code), - ret - ); - return 1; -} - -int gen_keyword_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_keyword(%s)", pr_str(mal_string(node->keyword), 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_let_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalEnv *inner_env = build_env(env); - inner_env->num = (*var_num)++; - MalType *outer_env_name = build_env_name(env); - MalType *inner_env_name = build_env_name(inner_env); - MalType *temp_code = mal_sprintf("MalEnv *%S = build_env(%S);\n ", inner_env_name, outer_env_name); - append_code(code->decl, temp_code, 0); - - temp_code = mal_string(""); - - struct list_or_vector_iter *iter; - struct codegen code2; - MalType *name, *val, *inner_decl, *val_code; - for (iter = list_or_vector_iter(mal_car(node)); iter; iter = list_or_vector_iter_next(iter)) { - inner_decl = mal_string(""); - name = list_or_vector_iter_get_obj(iter); - assert(is_symbol(name)); - iter = list_or_vector_iter_next(iter); - val = list_or_vector_iter_get_obj(iter); - env_set(inner_env, name->symbol, mal_true()); - code2 = (struct codegen){ code->top, inner_decl, mal_string("") }; - if (!gen_code(val, inner_env, &code2, 0, var_num)) { - return 0; - } - val_code = mal_sprintf("env_set(%S, %s, %S);\n ", inner_env_name, pr_str(mal_string(name->symbol), 1), code2.body); - mal_string_append_mal_string(temp_code, inner_decl); - mal_string_append_mal_string(temp_code, val_code); - } - - append_code(code->decl, temp_code, 0); - - node = mal_cdr(node); - if (!gen_continuation_code("let", mal_car(node), inner_env, code, ret, ret, var_num)) { - return 0; - } - - return 1; -} - -int gen_list_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *list_name = next_var_name("list", var_num); - MalType *temp_decl = mal_sprintf("MalType *%S = mal_vector();\n ", list_name); - struct list_or_vector_iter *iter; - MalType *item; - struct codegen code2; - for (iter = list_or_vector_iter(node); iter; iter = list_or_vector_iter_next(iter)) { - item = list_or_vector_iter_get_obj(iter); - mal_string_append_mal_string( - temp_decl, - mal_sprintf("mal_vector_push(%S, ", list_name) - ); - code2 = (struct codegen){ code->top, code->decl, temp_decl }; - if (!gen_code(item, env, &code2, 0, var_num)) { - return 0; - } - mal_string_append(temp_decl, ");\n "); - } - append_code(code->decl, temp_decl, 0); - append_code(code->body, mal_sprintf("mal_vector_to_list(%S)", list_name), ret); - return 1; -} - -int gen_lambda_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("(MalType*)%p /* %s */", node, pr_str(node, 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_number_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_number(%s)", pr_str(node, 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_string_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_string(%s)", pr_str(node, 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_symbol_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_symbol(%s)", pr_str(mal_string(node->symbol), 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_symbol_lookup_code(MalType *node, MalEnv *env, struct codegen *code, int ret) { - UNUSED(env); - MalType *temp_code = mal_sprintf( - "bubble_if_error(env_get(%S, %s))", - build_env_name(env), - pr_str(mal_string(node->symbol), 1) - ); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_vector_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *var_name = next_var_name("var", var_num); - MalType *temp_code = mal_string("MalType *"); - mal_string_append_mal_string(temp_code, var_name); - mal_string_append(temp_code, " = mal_vector();\n "); - struct codegen code2; - for(size_t i=0; itop, code->decl, temp_code }; - if (!gen_code(mal_vector_ref(node, i), env, &code2, 0, var_num)) { - return 0; - } - mal_string_append(temp_code, ");\n "); - } - append_code(code->decl, temp_code, 0); - append_code(code->body, var_name, ret); - return 1; -} - -void append_code(MalType *code, MalType *temp_code, int ret) { - if (ret) mal_string_append(code, "return "); - mal_string_append_mal_string(code, temp_code); - if (ret) mal_string_append(code, ";"); -} - -MalType* next_var_name(char *base, int *var_num) { - MalType *var_name = mal_string(base); - mal_string_append_long_long(var_name, (*var_num)++); - return var_name; -} - -MalType* build_env_name(MalEnv *env) { - MalType *name = mal_string("env"); - mal_string_append_long_long(name, env->num); - return name; -} - -char* PRINT(MalType *ast) { - return pr_str(ast, 2); -} - -char* rep(char *str, MalEnv *repl_env) { - MalType *result = EVAL(READ(str), repl_env); - if (is_error(result)) { - return PRINT(mal_sprintf("ERROR: %s\n", pr_str(result->error_val, 0))); - } else { - return PRINT(result); - } -} - -char *parent_directory(char *bin_path) { - char *path = string(bin_path); - size_t len; - while ((len = strlen(path)) > 0 && path[len - 1] != '/') { - path[len - 1] = 0; - } - if (len > 0) path[len - 1] = 0; - if (strlen(path) == 0) { - return string("."); - } else { - return path; - } -} - -int main(int argc, char *argv[]) { - PATH = parent_directory(argv[0]); - - MalEnv *repl_env = build_top_env(); - - struct hashmap *ns = core_ns(); - struct hashmap_iter *core_iter; - char *name; - MalType* (*fn)(MalEnv*, size_t, MalType**); - for (core_iter = hashmap_iter(ns); core_iter; core_iter = hashmap_iter_next(ns, core_iter)) { - name = (char*)hashmap_iter_get_key(core_iter); - fn = hashmap_iter_get_data(core_iter); - env_set(repl_env, name, mal_builtin_function(fn, name, repl_env)); - } - env_set(repl_env, "eval", mal_builtin_function(user_eval, "eval", repl_env)); - - MalType *arg_list = mal_vector(); - for (int i=2; istr, - repl_env - ); - - if (argc > 1) { - rep(mal_sprintf("(load-file %s)", pr_str(mal_string(argv[1]), 1))->str, repl_env); - } else { - char *buffer; - read_history("history.txt"); - while ((buffer = readline("user> ")) != NULL) { - printf("%s\n", rep(buffer, repl_env)); - if (strlen(buffer) > 0) { - add_history(buffer); - } - free(buffer); - } - write_history("history.txt"); - } - - return 0; -} diff --git a/step7_quote.c b/step7_quote.c deleted file mode 100644 index 3400301..0000000 --- a/step7_quote.c +++ /dev/null @@ -1,828 +0,0 @@ -#include -#include -#include -#include -#include -#include -#include -#include - -#include "core.h" -#include "env.h" -#include "printer.h" -#include "reader.h" -#include "util.h" - -char program_template[] = -"#include \n" -"#include \n" -"#include \n" -"#include \n" -"#include \n" -"#include \n" -"{{TOP_CODE}}\n" -"MalType* EVAL(MalEnv *env0) {\n" -" {{EVAL_CODE}}\n" -"}"; - -int compile_eval(MalType *ast, MalEnv *env, int *var_num, MalType* (**EVAL)(MalEnv *env)); -int gen_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num, int quoting); -int gen_call_args_code(MalType *args_name, MalType *node, MalEnv *env, struct codegen *code, int *var_num); -int gen_call_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_closure_code(MalType *fn_name, MalEnv *env, struct codegen *code, int ret); -int gen_continuation_code(char *prefix, MalType *node, MalEnv *env, struct codegen *code, int ret, int trampoline, int *var_num); -int gen_def_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_do_code(MalType *list, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_fn_code(MalType *fn_name, MalType *node, MalEnv *env, struct codegen *code, int *var_num, int new_env); -int gen_hashmap_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_if_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_keyword_code(MalType *node, struct codegen *code, int ret); -int gen_let_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_list_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num, int quoting); -int gen_number_code(MalType *node, struct codegen *code, int ret); -int gen_string_code(MalType *node, struct codegen *code, int ret); -int gen_symbol_code(MalType *node, struct codegen *code, int ret); -int gen_symbol_lookup_code(MalType *node, MalEnv *env, struct codegen *code, int ret); -int gen_vector_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -MalType* quasiquote(MalType *node); -void append_code(MalType *code, MalType *temp_code, int ret); -MalType* next_var_name(char *base, int *var_num); -MalType* build_env_name(MalEnv *env); -MalType* trampoline(MalType *result); - -MalType* READ(char *str) { - return read_str(str); -} - -MalType* EVAL(MalType *ast, MalEnv *repl_env) { - MalType* (*EVAL)(MalEnv *env); - int var_num = 1; - if (compile_eval(ast, repl_env, &var_num, &EVAL)) { - return trampoline(EVAL(repl_env)); - } else { - printf("There was an error compiling.\n"); - return mal_blank_line(); - } -} - -MalType* user_eval(MalEnv *repl_env, size_t argc, MalType **args) { - UNUSED(repl_env); - mal_assert(argc == 1, "Expected 1 argument to eval"); - MalType* (*EVAL)(MalEnv *env); - MalType *ast = args[0]; - int var_num = 1; - if (compile_eval(ast, repl_env, &var_num, &EVAL)) { - return trampoline(EVAL(repl_env)); - } else { - return mal_error(mal_string("There was an error compiling.")); - } -} - -char *PATH = NULL; - -int compile_eval(MalType *ast, MalEnv *env, int *var_num, MalType* (**EVAL)(MalEnv *env)) { - struct codegen code = { mal_string(""), mal_string(""), mal_string("") }; - int success = gen_code(ast, env, &code, 1, var_num, 0); - - if (!success) { - return 0; - } - - MalType *generated = mal_string_replace(mal_string(program_template), "{{TOP_CODE}}", code.top->str); - - MalType *combined = code.decl; - mal_string_append_mal_string(combined, code.body); - generated = mal_string_replace(generated, "{{EVAL_CODE}}", combined->str); - - if (getenv("DEBUG")) { - printf("-----------------\n%s-----------------\n", generated->str); - } - - TCCState *s = tcc_new(); - if (!s) { - fprintf(stderr, "Could not create tcc state\n"); - return 0; - } - - if(access("./tinycc/libtcc.h", F_OK) != -1) { - tcc_set_lib_path(s, "./tinycc"); - tcc_add_include_path(s, "./tinycc"); - tcc_add_include_path(s, "."); - } else if(PATH) { - tcc_set_lib_path(s, mal_sprintf("%s/tinycc", PATH)->str); - tcc_add_include_path(s, mal_sprintf("%s/tinycc", PATH)->str); - tcc_add_include_path(s, PATH); - } else { - printf("Could not determine path to tinycc and libtcc.h\n"); - exit(1); - } - - tcc_set_output_type(s, TCC_OUTPUT_MEMORY); - - if (tcc_compile_string(s, string(generated->str)) == -1) { - fprintf(stderr, "Could not compile program\n"); - return 0; - } - - tcc_add_symbol(s, "build_env", build_env); - tcc_add_symbol(s, "env_get", env_get); - tcc_add_symbol(s, "env_set", env_set); - tcc_add_symbol(s, "mal_closure", mal_closure); - tcc_add_symbol(s, "mal_continuation", mal_continuation); - tcc_add_symbol(s, "mal_empty", mal_empty); - tcc_add_symbol(s, "mal_error", mal_error); - tcc_add_symbol(s, "mal_false", mal_false); - tcc_add_symbol(s, "mal_hashmap", mal_hashmap); - tcc_add_symbol(s, "mal_hashmap_put", mal_hashmap_put); - tcc_add_symbol(s, "mal_keyword", mal_keyword); - tcc_add_symbol(s, "mal_nil", mal_nil); - tcc_add_symbol(s, "mal_number", mal_number); - tcc_add_symbol(s, "mal_sprintf", mal_sprintf); - tcc_add_symbol(s, "mal_string", mal_string); - tcc_add_symbol(s, "mal_symbol", mal_symbol); - tcc_add_symbol(s, "mal_true", mal_true); - tcc_add_symbol(s, "mal_vector", mal_vector); - tcc_add_symbol(s, "mal_vector_push", mal_vector_push); - tcc_add_symbol(s, "mal_vector_to_list", mal_vector_to_list); - tcc_add_symbol(s, "pr_str", pr_str); - tcc_add_symbol(s, "trampoline", trampoline); - - int size = tcc_relocate(s, NULL); - if (size < 0) { - fprintf(stderr, "Could not determine size of program\n"); - return 0; - } - - void *mem = GC_MALLOC(size); - if (tcc_relocate(s, mem) < 0) { - fprintf(stderr, "Could not relocate program\n"); - return 0; - } - - *EVAL = tcc_get_symbol(s, "EVAL"); - tcc_delete(s); - - if (!*EVAL) { - fprintf(stderr, "Could not find symbol EVAL\n"); - return 0; - } - - return 1; -} - -int gen_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num, int quoting) { - switch (node->type) { - case MAL_CONS_TYPE: - if (quoting) { - return gen_list_code(node, env, code, ret, var_num, quoting); - } else { - return gen_call_code(node, env, code, ret, var_num); - } - case MAL_EMPTY_TYPE: - append_code(code->body, mal_string("mal_empty()"), ret); - return 1; - case MAL_FALSE_TYPE: - append_code(code->body, mal_string("mal_false()"), ret); - return 1; - case MAL_HASHMAP_TYPE: - return gen_hashmap_code(node, env, code, ret, var_num); - case MAL_KEYWORD_TYPE: - return gen_keyword_code(node, code, ret); - case MAL_NIL_TYPE: - append_code(code->body, mal_string("mal_nil()"), ret); - return 1; - case MAL_NUMBER_TYPE: - return gen_number_code(node, code, ret); - case MAL_STRING_TYPE: - return gen_string_code(node, code, ret); - case MAL_SYMBOL_TYPE: - if (quoting) { - return gen_symbol_code(node, code, ret); - } else { - return gen_symbol_lookup_code(node, env, code, ret); - } - case MAL_TRUE_TYPE: - append_code(code->body, mal_string("mal_true()"), ret); - return 1; - case MAL_VECTOR_TYPE: - return gen_vector_code(node, env, code, ret, var_num); - default: - printf("unknown node type in code gen type=%d\n", node->type); - return 0; - } -} - -int gen_call_args_code(MalType *args_name, MalType *node, MalEnv *env, struct codegen *code, int *var_num) { - if (is_empty(node)) { - append_code(code->decl, mal_sprintf("MalType **%S = NULL;", args_name), 0); - return 1; - } - assert(is_cons(node)); - size_t arg_count = mal_list_len(node), index = 0; - MalType *temp_code = mal_sprintf("MalType **%S = GC_MALLOC(sizeof(MalType*) * %z);\n ", args_name, arg_count); - struct codegen code2; - while (!is_empty(node)) { - assert(is_cons(node)); - mal_string_append_mal_string(temp_code, mal_sprintf("%S[%z] = bubble_if_error(", args_name, index)); - code2 = (struct codegen){ code->top, code->decl, temp_code }; - if (!gen_code(mal_car(node), env, &code2, 0, var_num, 0)) { - return 0; - } - mal_string_append(temp_code, ");\n "); - node = mal_cdr(node); - index++; - } - append_code(code->decl, temp_code, 0); - return 1; -} - -int gen_call_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *sym = mal_car(node), *temp_code, *fn_name; - - if (is_symbol(sym)) { - if (strcmp(sym->symbol, "def!") == 0) { - return gen_def_code(mal_cdr(node), env, code, ret, var_num); - } else if (strcmp(sym->symbol, "let*") == 0) { - return gen_let_code(mal_cdr(node), env, code, ret, var_num); - } else if (strcmp(sym->symbol, "do") == 0) { - return gen_do_code(mal_cdr(node), env, code, ret, var_num); - } else if (strcmp(sym->symbol, "if") == 0) { - return gen_if_code(mal_cdr(node), env, code, ret, var_num); - } else if (strcmp(sym->symbol, "fn*") == 0) { - fn_name = next_var_name("fn", var_num); - if (!gen_fn_code(fn_name, mal_cdr(node), env, code, var_num, 1)) { - return 0; - } - return gen_closure_code(fn_name, env, code, ret); - } else if (strcmp(sym->symbol, "quote") == 0) { - return gen_code(mal_car(mal_cdr(node)), env, code, ret, var_num, 1); - } else if (strcmp(sym->symbol, "quasiquote") == 0) { - return gen_code(quasiquote(mal_car(mal_cdr(node))), env, code, ret, var_num, 0); - } - } - - // look up the lambda in the env - MalType *lambda_name = next_var_name("lambda", var_num); - temp_code = mal_string("MalType *"); - mal_string_append_mal_string(temp_code, lambda_name); - mal_string_append(temp_code, " = "); - struct codegen code2 = { code->top, code->decl, temp_code }; - if (!gen_code(sym, env, &code2, 0, var_num, 0)) { - return 0; - } - mal_string_append(temp_code, ";\n "); - mal_string_append_mal_string( - temp_code, - mal_sprintf( - "if (!is_lambda(%S)) { return mal_error(mal_sprintf(\"%%s is not callable\", pr_str(%S, 1))); }\n ", - lambda_name, - lambda_name - ) - ); - append_code(code->decl, temp_code, 0); - - // build the args array - MalType *args_name, *args_node = mal_cdr(node); - size_t args_count = mal_list_len(args_node); - if (args_count == 0) { - args_name = mal_string("NULL"); - } else { - args_name = mal_string_replace(lambda_name, "lambda", "args"); - if (!gen_call_args_code(args_name, args_node, env, code, var_num)) { - return 0; - } - } - - // return the functional call as a continuation - temp_code = mal_sprintf( - "mal_continuation(%S->fn, %S->env, %z, %S)", - lambda_name, - lambda_name, - args_count, - args_name - ); - - append_code( - code->body, - ret ? temp_code : mal_sprintf("trampoline(%S)", temp_code), - ret - ); - - return 1; -} - -int gen_closure_code(MalType *fn_name, MalEnv *env, struct codegen *code, int ret) { - MalType *closure_name = mal_string("closure_"); - mal_string_append_mal_string(closure_name, fn_name); - MalType *temp_code = mal_sprintf( - "MalType *%S = mal_closure(%S, %S);\n ", - closure_name, - fn_name, - build_env_name(env) - ); - append_code(code->decl, temp_code, 0); - append_code(code->body, closure_name, ret); - return 1; -} - -int gen_continuation_code(char *prefix, MalType *node, MalEnv *env, struct codegen *code, int ret, int trampoline, int *var_num) { - MalType *fn = mal_cons(mal_empty(), mal_cons(node, mal_empty())); - MalType *fn_name = next_var_name(prefix, var_num); - if (!gen_fn_code(fn_name, fn, env, code, var_num, 0)) { - return 0; - } - MalType *temp_code = mal_string(""); - append_code(temp_code, mal_sprintf("mal_continuation(%S, %S, 0, NULL)", fn_name, build_env_name(env)), 0); - append_code(code->body, trampoline ? temp_code : mal_sprintf("trampoline(%S)", temp_code), ret); - return 1; -} - -int gen_def_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *env_name = build_env_name(env); - MalType *name = mal_car(node); - assert(is_symbol(name)); - char *name_str = pr_str(mal_string(name->symbol), 1); - - int key_already_exists = !!env_get(env, name->symbol); - if (!key_already_exists) env_set(env, name->symbol, mal_true()); - struct codegen code2 = (struct codegen){ code->top, code->decl, mal_string("") }; - MalType *val_node = mal_car(mal_cdr(node)); - if (!gen_code(val_node, env, &code2, 0, var_num, 0)) { - if (!key_already_exists) env_delete(env, name->symbol); - return 0; - } - - MalType *temp_code = mal_sprintf("env_set(%S, %s, bubble_if_error(%S))", env_name, name_str, code2.body); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_do_code(MalType *list, MalEnv *env, struct codegen *code, int ret, int *var_num) { - struct list_or_vector_iter *iter; - struct codegen code2; - MalType *node, *temp_decl, *temp_code; - int is_last = 0; - for (iter = list_or_vector_iter(list); iter; iter = list_or_vector_iter_next(iter)) { - temp_decl = mal_string(""); - temp_code = mal_string(""); - node = list_or_vector_iter_get_obj(iter); - is_last = list_or_vector_iter_is_last(iter); - code2 = (struct codegen){ code->top, temp_decl, temp_code }; - if (is_last) { - if (!gen_continuation_code("do", node, env, &code2, ret, ret, var_num)) { - return 0; - } - } else { - if (!gen_code(node, env, &code2, 0, var_num, 0)) { - return 0; - } - } - if (is_last) { - append_code(code->decl, temp_decl, 0); - append_code(code->body, temp_code, 0); - } else { - mal_string_append(temp_code, ";\n "); - append_code(code->decl, temp_decl, 0); - append_code(code->decl, temp_code, 0); - } - } - return 1; -} - -int gen_fn_code(MalType *fn_name, MalType *node, MalEnv *env, struct codegen *code, int *var_num, int new_env) { - MalType *args = mal_car(node); - size_t arg_count = list_or_vector_len(args); - - // function header - MalType *temp_fn = mal_sprintf("MalType* %S(MalEnv *env, size_t argc, MalType **args) {\n ", fn_name); - - // inner env - MalEnv *inner_env; - MalType *inner_env_name; - if (new_env) { - inner_env = build_env(env); - inner_env->num = (*var_num)++; - inner_env_name = build_env_name(inner_env); - mal_string_append_mal_string(temp_fn, mal_sprintf("MalEnv *%S = build_env(env);\n ", inner_env_name)); - } else { - inner_env = env; - inner_env_name = build_env_name(env); - mal_string_append_mal_string(temp_fn, mal_sprintf("MalEnv *%S = env;\n ", inner_env_name)); - } - - // arity check - int more_pos = list_or_vector_index_of(args, mal_symbol("&")); - if (more_pos == -1) { - mal_string_append_mal_string( - temp_fn, - mal_sprintf("mal_assert(argc == %i, \"Arity mismatch.\");\n ", arg_count) - ); - } else { - mal_string_append_mal_string( - temp_fn, - mal_sprintf("mal_assert(argc >= %i, \"Arity mismatch.\");\n ", more_pos) - ); - } - - // set arguments in inner env - if (arg_count > 0) { - struct list_or_vector_iter *iter; - MalType *arg; - size_t index = 0; - int is_more = 0; - for (iter = list_or_vector_iter(args); iter; iter = list_or_vector_iter_next(iter)) { - arg = list_or_vector_iter_get_obj(iter); - assert(is_symbol(arg)); - if (strcmp("&", arg->symbol) == 0) { - is_more = 1; - continue; - } - if (is_more) { - // accumulate remaining args in a list - char *more_name = arg->symbol; - mal_string_append(temp_fn, "MalType *rest_args = mal_vector();\n "); - mal_string_append_mal_string( - temp_fn, - mal_sprintf("for(size_t arg_i=%z; arg_isymbol), 1), - index - ) - ); - env_set(inner_env, arg->symbol, mal_true()); - index++; - } - } - } - - // function body - MalType *fn_decl = mal_string(""); - MalType *fn_code = mal_string(""); - struct codegen code2 = (struct codegen){ code->top, fn_decl, fn_code }; - MalType *fn_body = mal_cdr(node); - assert(!is_empty(fn_body)); - if (!gen_code(mal_car(fn_body), inner_env, &code2, 1, var_num, 0)) { - return 0; - } - append_code(temp_fn, fn_decl, 0); - append_code(temp_fn, fn_code, 0); - - // closing brace - mal_string_append(temp_fn, "\n}\n\n"); - append_code(code->top, temp_fn, 0); - - return 1; -} - -int gen_hashmap_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - int len = mal_hashmap_size(node); - if (len == 0) { - append_code(code->body, mal_string("mal_hashmap()"), ret); - return 1; - } - - MalType *var_name = next_var_name("var", var_num); - MalType *temp_code = mal_string("MalType *"); - mal_string_append_mal_string(temp_code, var_name); - mal_string_append(temp_code, " = mal_hashmap();\n "); - - struct hashmap_iter *iter; - struct codegen code2; - char *key_str; - MalType *val; - for (iter = hashmap_iter(&node->hashmap); iter; iter = hashmap_iter_next(&node->hashmap, iter)) { - key_str = (char*)hashmap_iter_get_key(iter); - val = (MalType*)hashmap_iter_get_data(iter); - mal_string_append(temp_code, "mal_hashmap_put("); - mal_string_append_mal_string(temp_code, var_name); - mal_string_append(temp_code, ", "); - code2 = (struct codegen){ code->top, code->decl, temp_code }; - if (!gen_code(read_str(key_str), env, &code2, 0, var_num, 0)) { - return 0; - } - mal_string_append(temp_code, ", "); - code2 = (struct codegen){ code->top, code->decl, temp_code }; - if (!gen_code(val, env, &code2, 0, var_num, 0)) { - return 0; - } - mal_string_append(temp_code, ");\n "); - } - - append_code(code->decl, temp_code, 0); - append_code(code->body, var_name, ret); - return 1; -} - -int gen_if_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *cond_code = mal_string(""); - struct codegen code2 = (struct codegen){ code->top, code->decl, cond_code }; - if (!gen_code(mal_car(node), env, &code2, 0, var_num, 0)) { - return 0; - } - node = mal_cdr(node); - MalType *true_code = mal_string(""); - code2.body = true_code; - MalType *true_val = mal_car(node); - if (is_primitive(true_val)) { - if (!gen_code(true_val, env, &code2, 0, var_num, 0)) { - return 0; - } - } else { - if (!gen_continuation_code("if_true", true_val, env, &code2, 0, ret, var_num)) { - return 0; - } - } - node = mal_cdr(node); - MalType *false_code = mal_string(""); - code2.body = false_code; - MalType *false_val; - if (is_empty(node)) { - false_val = mal_nil(); - } else { - false_val = mal_car(node); - } - if (is_primitive(false_val)) { - if (!gen_code(false_val, env, &code2, 0, var_num, 0)) { - return 0; - } - } else { - if (!gen_continuation_code("if_false", false_val, env, &code2, 0, ret, var_num)) { - return 0; - } - } - append_code( - code->body, - mal_sprintf("is_truthy(%S) ? %S : %S", cond_code, true_code, false_code), - ret - ); - return 1; -} - -int gen_keyword_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_keyword(%s)", pr_str(mal_string(node->keyword), 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_let_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalEnv *inner_env = build_env(env); - inner_env->num = (*var_num)++; - MalType *outer_env_name = build_env_name(env); - MalType *inner_env_name = build_env_name(inner_env); - MalType *temp_code = mal_sprintf("MalEnv *%S = build_env(%S);\n ", inner_env_name, outer_env_name); - append_code(code->decl, temp_code, 0); - - temp_code = mal_string(""); - - struct list_or_vector_iter *iter; - struct codegen code2; - MalType *name, *val, *inner_decl, *val_code; - for (iter = list_or_vector_iter(mal_car(node)); iter; iter = list_or_vector_iter_next(iter)) { - inner_decl = mal_string(""); - name = list_or_vector_iter_get_obj(iter); - assert(is_symbol(name)); - iter = list_or_vector_iter_next(iter); - val = list_or_vector_iter_get_obj(iter); - env_set(inner_env, name->symbol, mal_true()); - code2 = (struct codegen){ code->top, inner_decl, mal_string("") }; - if (!gen_code(val, inner_env, &code2, 0, var_num, 0)) { - return 0; - } - val_code = mal_sprintf("env_set(%S, %s, %S);\n ", inner_env_name, pr_str(mal_string(name->symbol), 1), code2.body); - mal_string_append_mal_string(temp_code, inner_decl); - mal_string_append_mal_string(temp_code, val_code); - } - - append_code(code->decl, temp_code, 0); - - node = mal_cdr(node); - if (!gen_continuation_code("let", mal_car(node), inner_env, code, ret, ret, var_num)) { - return 0; - } - - return 1; -} - -int gen_list_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num, int quoting) { - MalType *list_name = next_var_name("list", var_num); - MalType *temp_decl = mal_sprintf("MalType *%S = mal_vector();\n ", list_name); - struct list_or_vector_iter *iter; - MalType *item; - struct codegen code2; - for (iter = list_or_vector_iter(node); iter; iter = list_or_vector_iter_next(iter)) { - item = list_or_vector_iter_get_obj(iter); - mal_string_append_mal_string( - temp_decl, - mal_sprintf("mal_vector_push(%S, ", list_name) - ); - code2 = (struct codegen){ code->top, code->decl, temp_decl }; - if (!gen_code(item, env, &code2, 0, var_num, quoting)) { - return 0; - } - mal_string_append(temp_decl, ");\n "); - } - append_code(code->decl, temp_decl, 0); - append_code(code->body, mal_sprintf("mal_vector_to_list(%S)", list_name), ret); - return 1; -} - -int gen_lambda_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("(MalType*)%p /* %s */", node, pr_str(node, 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_number_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_number(%s)", pr_str(node, 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_string_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_string(%s)", pr_str(node, 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_symbol_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_symbol(%s)", pr_str(mal_string(node->symbol), 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_symbol_lookup_code(MalType *node, MalEnv *env, struct codegen *code, int ret) { - UNUSED(env); - MalType *temp_code = mal_sprintf( - "bubble_if_error(env_get(%S, %s))", - build_env_name(env), - pr_str(mal_string(node->symbol), 1) - ); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_vector_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *var_name = next_var_name("var", var_num); - MalType *temp_code = mal_string("MalType *"); - mal_string_append_mal_string(temp_code, var_name); - mal_string_append(temp_code, " = mal_vector();\n "); - struct codegen code2; - for(size_t i=0; itop, code->decl, temp_code }; - if (!gen_code(mal_vector_ref(node, i), env, &code2, 0, var_num, 0)) { - return 0; - } - mal_string_append(temp_code, ");\n "); - } - append_code(code->decl, temp_code, 0); - append_code(code->body, var_name, ret); - return 1; -} - -MalType* quasiquote(MalType *node) { - if (!is_pair(node)) { - return mal_cons(mal_symbol("quote"), mal_cons(node, mal_empty())); - } else if (is_symbol(mal_car2(node)) && strcmp(mal_car2(node)->symbol, "unquote") == 0) { - return mal_car2(mal_cdr2(node)); - } else if (is_pair(mal_car2(node)) && is_symbol(mal_car2(mal_car2(node))) && strcmp(mal_car2(mal_car2(node))->symbol, "splice-unquote") == 0) { - return mal_cons( - mal_symbol("concat"), - mal_cons( - mal_car2(mal_cdr2(mal_car2(node))), - mal_cons( - quasiquote(mal_cdr2(node)), - mal_empty() - ) - ) - ); - } else { - return mal_cons( - mal_symbol("cons"), - mal_cons( - quasiquote(mal_car2(node)), - mal_cons( - quasiquote(mal_cdr2(node)), - mal_empty() - ) - ) - ); - } -} - -void append_code(MalType *code, MalType *temp_code, int ret) { - if (ret) mal_string_append(code, "return "); - mal_string_append_mal_string(code, temp_code); - if (ret) mal_string_append(code, ";"); -} - -MalType* next_var_name(char *base, int *var_num) { - MalType *var_name = mal_string(base); - mal_string_append_long_long(var_name, (*var_num)++); - return var_name; -} - -MalType* build_env_name(MalEnv *env) { - MalType *name = mal_string("env"); - mal_string_append_long_long(name, env->num); - return name; -} - -char* PRINT(MalType *ast) { - return pr_str(ast, 2); -} - -char* rep(char *str, MalEnv *repl_env) { - MalType *result = EVAL(READ(str), repl_env); - if (is_error(result)) { - return PRINT(mal_sprintf("ERROR: %s\n", pr_str(result->error_val, 0))); - } else { - return PRINT(result); - } -} - -char *parent_directory(char *bin_path) { - char *path = string(bin_path); - size_t len; - while ((len = strlen(path)) > 0 && path[len - 1] != '/') { - path[len - 1] = 0; - } - if (len > 0) path[len - 1] = 0; - if (strlen(path) == 0) { - return string("."); - } else { - return path; - } -} - -int main(int argc, char *argv[]) { - PATH = parent_directory(argv[0]); - - MalEnv *repl_env = build_top_env(); - - struct hashmap *ns = core_ns(); - struct hashmap_iter *core_iter; - char *name; - MalType* (*fn)(MalEnv*, size_t, MalType**); - for (core_iter = hashmap_iter(ns); core_iter; core_iter = hashmap_iter_next(ns, core_iter)) { - name = (char*)hashmap_iter_get_key(core_iter); - fn = hashmap_iter_get_data(core_iter); - env_set(repl_env, name, mal_builtin_function(fn, name, repl_env)); - } - env_set(repl_env, "eval", mal_builtin_function(user_eval, "eval", repl_env)); - - MalType *arg_list = mal_vector(); - for (int i=2; istr, - repl_env - ); - - if (argc > 1) { - rep(mal_sprintf("(load-file %s)", pr_str(mal_string(argv[1]), 1))->str, repl_env); - } else { - char *buffer; - read_history("history.txt"); - while ((buffer = readline("user> ")) != NULL) { - printf("%s\n", rep(buffer, repl_env)); - if (strlen(buffer) > 0) { - add_history(buffer); - } - free(buffer); - } - write_history("history.txt"); - } - - return 0; -} diff --git a/step8_macros.c b/step8_macros.c deleted file mode 100644 index d9e926b..0000000 --- a/step8_macros.c +++ /dev/null @@ -1,913 +0,0 @@ -#include -#include -#include -#include -#include -#include -#include -#include - -#include "core.h" -#include "env.h" -#include "printer.h" -#include "reader.h" -#include "util.h" - -char program_template[] = -"#include \n" -"#include \n" -"#include \n" -"#include \n" -"#include \n" -"#include \n" -"{{TOP_CODE}}\n" -"MalType* EVAL(MalEnv *env0) {\n" -" {{EVAL_CODE}}\n" -"}"; - -int compile_eval(MalType *ast, MalEnv *env, int *var_num, MalType* (**EVAL)(MalEnv *env)); -int gen_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num, int quoting); -int gen_call_args_code(MalType *args_name, MalType *node, MalEnv *env, struct codegen *code, int *var_num); -int gen_call_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_closure_code(MalType *fn_name, MalEnv *env, struct codegen *code, int ret); -int gen_continuation_code(char *prefix, MalType *node, MalEnv *env, struct codegen *code, int ret, int trampoline, int *var_num); -int gen_def_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_do_code(MalType *list, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_fn_code(MalType *fn_name, MalType *node, MalEnv *env, struct codegen *code, int *var_num, int new_env); -int gen_hashmap_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_if_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_keyword_code(MalType *node, struct codegen *code, int ret); -int gen_lambda_code(MalType *node, struct codegen *code, int ret); -int gen_let_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_list_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num, int quoting); -int gen_load_file(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_number_code(MalType *node, struct codegen *code, int ret); -int gen_string_code(MalType *node, struct codegen *code, int ret); -int gen_symbol_code(MalType *node, struct codegen *code, int ret); -int gen_symbol_lookup_code(MalType *node, MalEnv *env, struct codegen *code, int ret); -int gen_vector_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -MalType* quasiquote(MalType *node); -int is_macro_call(MalType *node, MalEnv *env); -void defmacro(MalType *node, MalEnv *env); -MalType* macroexpand(MalType *ast, MalEnv *env); -void append_code(MalType *code, MalType *temp_code, int ret); -MalType* next_var_name(char *base, int *var_num); -MalType* build_env_name(MalEnv *env); -MalType* trampoline(MalType *result); - -MalType* READ(char *str) { - return read_str(str); -} - -MalType* EVAL(MalType *ast, MalEnv *repl_env) { - MalType* (*EVAL)(MalEnv *env); - int var_num = 1; - if (compile_eval(ast, repl_env, &var_num, &EVAL)) { - return trampoline(EVAL(repl_env)); - } else { - printf("There was an error compiling.\n"); - return mal_blank_line(); - } -} - -MalType* user_eval(MalEnv *repl_env, size_t argc, MalType **args) { - UNUSED(repl_env); - mal_assert(argc == 1, "Expected 1 argument to eval"); - MalType* (*EVAL)(MalEnv *env); - MalType *ast = args[0]; - int var_num = 1; - if (compile_eval(ast, repl_env, &var_num, &EVAL)) { - return trampoline(EVAL(repl_env)); - } else { - return mal_error(mal_string("There was an error compiling.")); - } -} - -char *PATH = NULL; - -int compile_eval(MalType *ast, MalEnv *env, int *var_num, MalType* (**EVAL)(MalEnv *env)) { - struct codegen code = { mal_string(""), mal_string(""), mal_string("") }; - int success = gen_code(ast, env, &code, 1, var_num, 0); - - if (!success) { - return 0; - } - - MalType *generated = mal_string_replace(mal_string(program_template), "{{TOP_CODE}}", code.top->str); - - MalType *combined = code.decl; - mal_string_append_mal_string(combined, code.body); - generated = mal_string_replace(generated, "{{EVAL_CODE}}", combined->str); - - if (getenv("DEBUG")) { - printf("-----------------\n%s-----------------\n", generated->str); - } - - TCCState *s = tcc_new(); - if (!s) { - fprintf(stderr, "Could not create tcc state\n"); - return 0; - } - - if(access("./tinycc/libtcc.h", F_OK) != -1) { - tcc_set_lib_path(s, "./tinycc"); - tcc_add_include_path(s, "./tinycc"); - tcc_add_include_path(s, "."); - } else if(PATH) { - tcc_set_lib_path(s, mal_sprintf("%s/tinycc", PATH)->str); - tcc_add_include_path(s, mal_sprintf("%s/tinycc", PATH)->str); - tcc_add_include_path(s, PATH); - } else { - printf("Could not determine path to tinycc and libtcc.h\n"); - exit(1); - } - - tcc_set_output_type(s, TCC_OUTPUT_MEMORY); - - if (tcc_compile_string(s, string(generated->str)) == -1) { - fprintf(stderr, "Could not compile program\n"); - return 0; - } - - tcc_add_symbol(s, "build_env", build_env); - tcc_add_symbol(s, "env_get", env_get); - tcc_add_symbol(s, "env_set", env_set); - tcc_add_symbol(s, "mal_blank_line", mal_blank_line); - tcc_add_symbol(s, "mal_closure", mal_closure); - tcc_add_symbol(s, "mal_continuation", mal_continuation); - tcc_add_symbol(s, "mal_continuation_0", mal_continuation_0); - tcc_add_symbol(s, "mal_continuation_1", mal_continuation_1); - tcc_add_symbol(s, "mal_empty", mal_empty); - tcc_add_symbol(s, "mal_error", mal_error); - tcc_add_symbol(s, "mal_false", mal_false); - tcc_add_symbol(s, "mal_hashmap", mal_hashmap); - tcc_add_symbol(s, "mal_hashmap_put", mal_hashmap_put); - tcc_add_symbol(s, "mal_keyword", mal_keyword); - tcc_add_symbol(s, "mal_nil", mal_nil); - tcc_add_symbol(s, "mal_number", mal_number); - tcc_add_symbol(s, "mal_sprintf", mal_sprintf); - tcc_add_symbol(s, "mal_string", mal_string); - tcc_add_symbol(s, "mal_symbol", mal_symbol); - tcc_add_symbol(s, "mal_true", mal_true); - tcc_add_symbol(s, "mal_vector", mal_vector); - tcc_add_symbol(s, "mal_vector_push", mal_vector_push); - tcc_add_symbol(s, "mal_vector_to_list", mal_vector_to_list); - tcc_add_symbol(s, "pr_str", pr_str); - tcc_add_symbol(s, "trampoline", trampoline); - - int size = tcc_relocate(s, NULL); - if (size < 0) { - fprintf(stderr, "Could not determine size of program\n"); - return 0; - } - - void *mem = GC_MALLOC(size); - if (tcc_relocate(s, mem) < 0) { - fprintf(stderr, "Could not relocate program\n"); - return 0; - } - - *EVAL = tcc_get_symbol(s, "EVAL"); - tcc_delete(s); - - if (!*EVAL) { - fprintf(stderr, "Could not find symbol EVAL\n"); - return 0; - } - - return 1; -} - -int gen_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num, int quoting) { - switch (node->type) { - case MAL_CONS_TYPE: - if (quoting) { - return gen_list_code(node, env, code, ret, var_num, quoting); - } else { - return gen_call_code(node, env, code, ret, var_num); - } - case MAL_EMPTY_TYPE: - append_code(code->body, mal_string("mal_empty()"), ret); - return 1; - case MAL_FALSE_TYPE: - append_code(code->body, mal_string("mal_false()"), ret); - return 1; - case MAL_HASHMAP_TYPE: - return gen_hashmap_code(node, env, code, ret, var_num); - case MAL_KEYWORD_TYPE: - return gen_keyword_code(node, code, ret); - case MAL_LAMBDA_TYPE: - return gen_lambda_code(node, code, ret); - case MAL_NIL_TYPE: - append_code(code->body, mal_string("mal_nil()"), ret); - return 1; - case MAL_NUMBER_TYPE: - return gen_number_code(node, code, ret); - case MAL_STRING_TYPE: - return gen_string_code(node, code, ret); - case MAL_SYMBOL_TYPE: - if (quoting) { - return gen_symbol_code(node, code, ret); - } else { - return gen_symbol_lookup_code(node, env, code, ret); - } - case MAL_TRUE_TYPE: - append_code(code->body, mal_string("mal_true()"), ret); - return 1; - case MAL_VECTOR_TYPE: - return gen_vector_code(node, env, code, ret, var_num); - default: - printf("unknown node type in code gen type=%d\n", node->type); - return 0; - } -} - -int gen_call_args_code(MalType *args_name, MalType *node, MalEnv *env, struct codegen *code, int *var_num) { - if (is_empty(node)) { - append_code(code->decl, mal_sprintf("MalType **%S = NULL;", args_name), 0); - return 1; - } - assert(is_cons(node)); - size_t arg_count = mal_list_len(node), index = 0; - MalType *temp_code = mal_sprintf("MalType **%S = GC_MALLOC(sizeof(MalType*) * %z);\n ", args_name, arg_count); - struct codegen code2; - while (!is_empty(node)) { - assert(is_cons(node)); - mal_string_append_mal_string(temp_code, mal_sprintf("%S[%z] = bubble_if_error(", args_name, index)); - code2 = (struct codegen){ code->top, code->decl, temp_code }; - if (!gen_code(mal_car(node), env, &code2, 0, var_num, 0)) { - return 0; - } - mal_string_append(temp_code, ");\n "); - node = mal_cdr(node); - index++; - } - append_code(code->decl, temp_code, 0); - return 1; -} - -int gen_call_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - node = macroexpand(node, env); - if (!is_cons(node)) { - return gen_code(node, env, code, ret, var_num, 0); - } - - MalType *sym = mal_car(node), *temp_code, *fn_name; - - if (is_symbol(sym)) { - if (strcmp(sym->symbol, "def!") == 0) { - return gen_def_code(mal_cdr(node), env, code, ret, var_num); - } else if (strcmp(sym->symbol, "let*") == 0) { - return gen_let_code(mal_cdr(node), env, code, ret, var_num); - } else if (strcmp(sym->symbol, "do") == 0) { - return gen_do_code(mal_cdr(node), env, code, ret, var_num); - } else if (strcmp(sym->symbol, "if") == 0) { - return gen_if_code(mal_cdr(node), env, code, ret, var_num); - } else if (strcmp(sym->symbol, "fn*") == 0) { - fn_name = next_var_name("fn", var_num); - if (!gen_fn_code(fn_name, mal_cdr(node), env, code, var_num, 1)) { - return 0; - } - return gen_closure_code(fn_name, env, code, ret); - } else if (strcmp(sym->symbol, "quote") == 0) { - return gen_code(mal_car(mal_cdr(node)), env, code, ret, var_num, 1); - } else if (strcmp(sym->symbol, "quasiquote") == 0) { - return gen_code(quasiquote(mal_car(mal_cdr(node))), env, code, ret, var_num, 0); - } else if (strcmp(sym->symbol, "defmacro!") == 0) { - defmacro(mal_cdr(node), env); - append_code(code->body, mal_string("mal_blank_line()"), ret); - return 1; - } else if (strcmp(sym->symbol, "macroexpand") == 0) { - node = macroexpand(mal_car(mal_cdr(node)), env); - return gen_code(node, env, code, ret, var_num, 1); - } else if (strcmp(sym->symbol, "load-file") == 0) { - return gen_load_file(mal_car(mal_cdr(node)), env, code, ret, var_num); - } - } - - // look up the lambda in the env - MalType *lambda_name = next_var_name("lambda", var_num); - temp_code = mal_string("MalType *"); - mal_string_append_mal_string(temp_code, lambda_name); - mal_string_append(temp_code, " = "); - struct codegen code2 = { code->top, code->decl, temp_code }; - if (!gen_code(sym, env, &code2, 0, var_num, 0)) { - return 0; - } - mal_string_append(temp_code, ";\n "); - mal_string_append_mal_string( - temp_code, - mal_sprintf( - "if (!is_lambda(%S)) { return mal_error(mal_sprintf(\"%%s is not callable\", pr_str(%S, 1))); }\n ", - lambda_name, - lambda_name - ) - ); - append_code(code->decl, temp_code, 0); - - // build the args array - MalType *args_name, *args_node = mal_cdr(node); - size_t args_count = mal_list_len(args_node); - if (args_count == 0) { - args_name = mal_string("NULL"); - } else { - args_name = mal_string_replace(lambda_name, "lambda", "args"); - if (!gen_call_args_code(args_name, args_node, env, code, var_num)) { - return 0; - } - } - - // return the functional call as a continuation - temp_code = mal_sprintf( - "mal_continuation(%S->fn, %S->env, %z, %S)", - lambda_name, - lambda_name, - args_count, - args_name - ); - - append_code( - code->body, - ret ? temp_code : mal_sprintf("trampoline(%S)", temp_code), - ret - ); - - return 1; -} - -int gen_closure_code(MalType *fn_name, MalEnv *env, struct codegen *code, int ret) { - MalType *closure_name = mal_string("closure_"); - mal_string_append_mal_string(closure_name, fn_name); - MalType *temp_code = mal_sprintf( - "MalType *%S = mal_closure(%S, %S);\n ", - closure_name, - fn_name, - build_env_name(env) - ); - append_code(code->decl, temp_code, 0); - append_code(code->body, closure_name, ret); - return 1; -} - -int gen_continuation_code(char *prefix, MalType *node, MalEnv *env, struct codegen *code, int ret, int trampoline, int *var_num) { - MalType *fn = mal_cons(mal_empty(), mal_cons(node, mal_empty())); - MalType *fn_name = next_var_name(prefix, var_num); - if (!gen_fn_code(fn_name, fn, env, code, var_num, 0)) { - return 0; - } - MalType *temp_code = mal_string(""); - append_code(temp_code, mal_sprintf("mal_continuation(%S, %S, 0, NULL)", fn_name, build_env_name(env)), 0); - append_code(code->body, trampoline ? temp_code : mal_sprintf("trampoline(%S)", temp_code), ret); - return 1; -} - -int gen_def_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *env_name = build_env_name(env); - MalType *name = mal_car(node); - assert(is_symbol(name)); - char *name_str = pr_str(mal_string(name->symbol), 1); - - int key_already_exists = !!env_get(env, name->symbol); - if (!key_already_exists) env_set(env, name->symbol, mal_true()); - struct codegen code2 = (struct codegen){ code->top, code->decl, mal_string("") }; - MalType *val_node = mal_car(mal_cdr(node)); - if (!gen_code(val_node, env, &code2, 0, var_num, 0)) { - if (!key_already_exists) env_delete(env, name->symbol); - return 0; - } - - MalType *temp_code = mal_sprintf("env_set(%S, %s, bubble_if_error(%S))", env_name, name_str, code2.body); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_do_code(MalType *list, MalEnv *env, struct codegen *code, int ret, int *var_num) { - struct list_or_vector_iter *iter; - struct codegen code2; - MalType *node, *temp_decl, *temp_code; - int is_last = 0; - for (iter = list_or_vector_iter(list); iter; iter = list_or_vector_iter_next(iter)) { - temp_decl = mal_string(""); - temp_code = mal_string(""); - node = list_or_vector_iter_get_obj(iter); - is_last = list_or_vector_iter_is_last(iter); - code2 = (struct codegen){ code->top, temp_decl, temp_code }; - if (is_last) { - if (!gen_continuation_code("do", node, env, &code2, ret, ret, var_num)) { - return 0; - } - } else { - if (!gen_code(node, env, &code2, 0, var_num, 0)) { - return 0; - } - } - if (is_last) { - append_code(code->decl, temp_decl, 0); - append_code(code->body, temp_code, 0); - } else { - mal_string_append(temp_code, ";\n "); - append_code(code->decl, temp_decl, 0); - append_code(code->decl, temp_code, 0); - } - } - return 1; -} - -int gen_fn_code(MalType *fn_name, MalType *node, MalEnv *env, struct codegen *code, int *var_num, int new_env) { - MalType *args = mal_car(node); - size_t arg_count = list_or_vector_len(args); - - // function header - MalType *temp_fn = mal_sprintf("MalType* %S(MalEnv *env, size_t argc, MalType **args) {\n ", fn_name); - - // inner env - MalEnv *inner_env; - MalType *inner_env_name; - if (new_env) { - inner_env = build_env(env); - inner_env->num = (*var_num)++; - inner_env_name = build_env_name(inner_env); - mal_string_append_mal_string(temp_fn, mal_sprintf("MalEnv *%S = build_env(env);\n ", inner_env_name)); - } else { - inner_env = env; - inner_env_name = build_env_name(env); - mal_string_append_mal_string(temp_fn, mal_sprintf("MalEnv *%S = env;\n ", inner_env_name)); - } - - // arity check - int more_pos = list_or_vector_index_of(args, mal_symbol("&")); - if (more_pos == -1) { - mal_string_append_mal_string( - temp_fn, - mal_sprintf("mal_assert(argc == %i, \"Arity mismatch.\");\n ", arg_count) - ); - } else { - mal_string_append_mal_string( - temp_fn, - mal_sprintf("mal_assert(argc >= %i, \"Arity mismatch.\");\n ", more_pos) - ); - } - - // set arguments in inner env - if (arg_count > 0) { - struct list_or_vector_iter *iter; - MalType *arg; - size_t index = 0; - int is_more = 0; - for (iter = list_or_vector_iter(args); iter; iter = list_or_vector_iter_next(iter)) { - arg = list_or_vector_iter_get_obj(iter); - assert(is_symbol(arg)); - if (strcmp("&", arg->symbol) == 0) { - is_more = 1; - continue; - } - if (is_more) { - // accumulate remaining args in a list - char *more_name = arg->symbol; - mal_string_append(temp_fn, "MalType *rest_args = mal_vector();\n "); - mal_string_append_mal_string( - temp_fn, - mal_sprintf("for(size_t arg_i=%z; arg_isymbol), 1), - index - ) - ); - env_set(inner_env, arg->symbol, mal_true()); - index++; - } - } - } - - // function body - MalType *fn_decl = mal_string(""); - MalType *fn_code = mal_string(""); - struct codegen code2 = (struct codegen){ code->top, fn_decl, fn_code }; - MalType *fn_body = mal_cdr(node); - assert(!is_empty(fn_body)); - if (!gen_code(mal_car(fn_body), inner_env, &code2, 1, var_num, 0)) { - return 0; - } - append_code(temp_fn, fn_decl, 0); - append_code(temp_fn, fn_code, 0); - - // closing brace - mal_string_append(temp_fn, "\n}\n\n"); - append_code(code->top, temp_fn, 0); - - return 1; -} - -int gen_hashmap_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - int len = mal_hashmap_size(node); - if (len == 0) { - append_code(code->body, mal_string("mal_hashmap()"), ret); - return 1; - } - - MalType *var_name = next_var_name("var", var_num); - MalType *temp_code = mal_string("MalType *"); - mal_string_append_mal_string(temp_code, var_name); - mal_string_append(temp_code, " = mal_hashmap();\n "); - - struct hashmap_iter *iter; - struct codegen code2; - char *key_str; - MalType *val; - for (iter = hashmap_iter(&node->hashmap); iter; iter = hashmap_iter_next(&node->hashmap, iter)) { - key_str = (char*)hashmap_iter_get_key(iter); - val = (MalType*)hashmap_iter_get_data(iter); - mal_string_append(temp_code, "mal_hashmap_put("); - mal_string_append_mal_string(temp_code, var_name); - mal_string_append(temp_code, ", "); - code2 = (struct codegen){ code->top, code->decl, temp_code }; - if (!gen_code(read_str(key_str), env, &code2, 0, var_num, 0)) { - return 0; - } - mal_string_append(temp_code, ", "); - code2 = (struct codegen){ code->top, code->decl, temp_code }; - if (!gen_code(val, env, &code2, 0, var_num, 0)) { - return 0; - } - mal_string_append(temp_code, ");\n "); - } - - append_code(code->decl, temp_code, 0); - append_code(code->body, var_name, ret); - return 1; -} - -int gen_if_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *cond_code = mal_string(""); - struct codegen code2 = (struct codegen){ code->top, code->decl, cond_code }; - if (!gen_code(mal_car(node), env, &code2, 0, var_num, 0)) { - return 0; - } - node = mal_cdr(node); - MalType *true_code = mal_string(""); - code2.body = true_code; - MalType *true_val = mal_car(node); - if (is_primitive(true_val)) { - if (!gen_code(true_val, env, &code2, 0, var_num, 0)) { - return 0; - } - } else { - if (!gen_continuation_code("if_true", true_val, env, &code2, 0, ret, var_num)) { - return 0; - } - } - node = mal_cdr(node); - MalType *false_code = mal_string(""); - code2.body = false_code; - MalType *false_val; - if (is_empty(node)) { - false_val = mal_nil(); - } else { - false_val = mal_car(node); - } - if (is_primitive(false_val)) { - if (!gen_code(false_val, env, &code2, 0, var_num, 0)) { - return 0; - } - } else { - if (!gen_continuation_code("if_false", false_val, env, &code2, 0, ret, var_num)) { - return 0; - } - } - append_code( - code->body, - mal_sprintf("is_truthy(%S) ? %S : %S", cond_code, true_code, false_code), - ret - ); - return 1; -} - -int gen_keyword_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_keyword(%s)", pr_str(mal_string(node->keyword), 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_lambda_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("(MalType*)%p /* %s */", node, pr_str(node, 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_let_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalEnv *inner_env = build_env(env); - inner_env->num = (*var_num)++; - MalType *outer_env_name = build_env_name(env); - MalType *inner_env_name = build_env_name(inner_env); - MalType *temp_code = mal_sprintf("MalEnv *%S = build_env(%S);\n ", inner_env_name, outer_env_name); - append_code(code->decl, temp_code, 0); - - temp_code = mal_string(""); - - struct list_or_vector_iter *iter; - struct codegen code2; - MalType *name, *val, *inner_decl, *val_code; - for (iter = list_or_vector_iter(mal_car(node)); iter; iter = list_or_vector_iter_next(iter)) { - inner_decl = mal_string(""); - name = list_or_vector_iter_get_obj(iter); - assert(is_symbol(name)); - iter = list_or_vector_iter_next(iter); - val = list_or_vector_iter_get_obj(iter); - env_set(inner_env, name->symbol, mal_true()); - code2 = (struct codegen){ code->top, inner_decl, mal_string("") }; - if (!gen_code(val, inner_env, &code2, 0, var_num, 0)) { - return 0; - } - val_code = mal_sprintf("env_set(%S, %s, %S);\n ", inner_env_name, pr_str(mal_string(name->symbol), 1), code2.body); - mal_string_append_mal_string(temp_code, inner_decl); - mal_string_append_mal_string(temp_code, val_code); - } - - append_code(code->decl, temp_code, 0); - - node = mal_cdr(node); - if (!gen_continuation_code("let", mal_car(node), inner_env, code, ret, ret, var_num)) { - return 0; - } - - return 1; -} - -int gen_list_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num, int quoting) { - MalType *list_name = next_var_name("list", var_num); - MalType *temp_decl = mal_sprintf("MalType *%S = mal_vector();\n ", list_name); - struct list_or_vector_iter *iter; - MalType *item; - struct codegen code2; - for (iter = list_or_vector_iter(node); iter; iter = list_or_vector_iter_next(iter)) { - item = list_or_vector_iter_get_obj(iter); - mal_string_append_mal_string( - temp_decl, - mal_sprintf("mal_vector_push(%S, ", list_name) - ); - code2 = (struct codegen){ code->top, code->decl, temp_decl }; - if (!gen_code(item, env, &code2, 0, var_num, quoting)) { - return 0; - } - mal_string_append(temp_decl, ");\n "); - } - append_code(code->decl, temp_decl, 0); - append_code(code->body, mal_sprintf("mal_vector_to_list(%S)", list_name), ret); - return 1; -} - -int gen_load_file(MalType *filename_node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *contents = core_slurp(env, 1, &filename_node); - MalType *ast = read_str(mal_sprintf("(do %S)", contents)->str); - return gen_code(ast, env, code, ret, var_num, 0); -} - -int gen_number_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_number(%s)", pr_str(node, 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_string_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_string(%s)", pr_str(node, 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_symbol_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_symbol(%s)", pr_str(mal_string(node->symbol), 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_symbol_lookup_code(MalType *node, MalEnv *env, struct codegen *code, int ret) { - UNUSED(env); - MalType *temp_code = mal_sprintf( - "bubble_if_error(env_get(%S, %s))", - build_env_name(env), - pr_str(mal_string(node->symbol), 1) - ); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_vector_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *var_name = next_var_name("var", var_num); - MalType *temp_code = mal_string("MalType *"); - mal_string_append_mal_string(temp_code, var_name); - mal_string_append(temp_code, " = mal_vector();\n "); - struct codegen code2; - for(size_t i=0; itop, code->decl, temp_code }; - if (!gen_code(mal_vector_ref(node, i), env, &code2, 0, var_num, 0)) { - return 0; - } - mal_string_append(temp_code, ");\n "); - } - append_code(code->decl, temp_code, 0); - append_code(code->body, var_name, ret); - return 1; -} - -MalType* quasiquote(MalType *node) { - if (!is_pair(node)) { - return mal_cons(mal_symbol("quote"), mal_cons(node, mal_empty())); - } else if (is_symbol(mal_car2(node)) && strcmp(mal_car2(node)->symbol, "unquote") == 0) { - return mal_car2(mal_cdr2(node)); - } else if (is_pair(mal_car2(node)) && is_symbol(mal_car2(mal_car2(node))) && strcmp(mal_car2(mal_car2(node))->symbol, "splice-unquote") == 0) { - return mal_cons( - mal_symbol("concat"), - mal_cons( - mal_car2(mal_cdr2(mal_car2(node))), - mal_cons( - quasiquote(mal_cdr2(node)), - mal_empty() - ) - ) - ); - } else { - return mal_cons( - mal_symbol("cons"), - mal_cons( - quasiquote(mal_car2(node)), - mal_cons( - quasiquote(mal_cdr2(node)), - mal_empty() - ) - ) - ); - } -} - -int is_macro_call(MalType *node, MalEnv *env) { - if (!is_cons(node)) { - return 0; - } - MalType *sym = mal_car(node); - if (!is_symbol(sym)) { - return 0; - } - MalType *macro = env_get(env, sym->symbol); - if (macro && macro->is_macro) { - return 1; - } else { - return 0; - } -} - -void defmacro(MalType *node, MalEnv *env) { - int var_num = 1; - MalType* (*EVAL)(MalEnv *env); - MalType *name = mal_car(node); - assert(is_symbol(name)); - node = mal_car(mal_cdr(node)); - if (!compile_eval(node, env, &var_num, &EVAL)) { - printf("Error compiling macro.\n"); - exit(1); - } - MalType *macro = trampoline(EVAL(env)); - macro->is_macro = 1; - env_set(env, name->symbol, macro); -} - -MalType* macroexpand(MalType *ast, MalEnv *env) { - MalType *name, *macro, *arg_list, **args; - size_t argc; - while (is_macro_call(ast, env)) { - name = mal_car(ast); - macro = env_get(env, name->symbol); - arg_list = mal_cdr(ast); - argc = mal_list_len(arg_list); - if (argc > 0) { - args = GC_MALLOC(sizeof(MalType*) * argc); - for (size_t i=0; ifn, macro->env, argc, args)); - assert(ast != NULL); - } - return ast; -} - -void append_code(MalType *code, MalType *temp_code, int ret) { - if (ret) mal_string_append(code, "return "); - mal_string_append_mal_string(code, temp_code); - if (ret) mal_string_append(code, ";"); -} - -MalType* next_var_name(char *base, int *var_num) { - MalType *var_name = mal_string(base); - mal_string_append_long_long(var_name, (*var_num)++); - return var_name; -} - -MalType* build_env_name(MalEnv *env) { - MalType *name = mal_string("env"); - mal_string_append_long_long(name, env->num); - return name; -} - -char* PRINT(MalType *ast) { - return pr_str(ast, 2); -} - -char* rep(char *str, MalEnv *repl_env) { - MalType *result = EVAL(READ(str), repl_env); - if (is_error(result)) { - return PRINT(mal_sprintf("ERROR: %s\n", pr_str(result->error_val, 0))); - } else { - return PRINT(result); - } -} - -char *parent_directory(char *bin_path) { - char *path = string(bin_path); - size_t len; - while ((len = strlen(path)) > 0 && path[len - 1] != '/') { - path[len - 1] = 0; - } - if (len > 0) path[len - 1] = 0; - if (strlen(path) == 0) { - return string("."); - } else { - return path; - } -} - -int main(int argc, char *argv[]) { - PATH = parent_directory(argv[0]); - - MalEnv *repl_env = build_top_env(); - - struct hashmap *ns = core_ns(); - struct hashmap_iter *core_iter; - char *name; - MalType* (*fn)(MalEnv*, size_t, MalType**); - for (core_iter = hashmap_iter(ns); core_iter; core_iter = hashmap_iter_next(ns, core_iter)) { - name = (char*)hashmap_iter_get_key(core_iter); - fn = hashmap_iter_get_data(core_iter); - env_set(repl_env, name, mal_builtin_function(fn, name, repl_env)); - } - env_set(repl_env, "eval", mal_builtin_function(user_eval, "eval", repl_env)); - - MalType *arg_list = mal_vector(); - for (int i=2; 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)))))))" - "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs)))))))))", - pr_str(arg_list, 1) - )->str, - repl_env - ); - - if (argc > 1) { - rep(mal_sprintf("(load-file %s)", pr_str(mal_string(argv[1]), 1))->str, repl_env); - } else { - char *buffer; - read_history("history.txt"); - while ((buffer = readline("user> ")) != NULL) { - printf("%s\n", rep(buffer, repl_env)); - if (strlen(buffer) > 0) { - add_history(buffer); - } - free(buffer); - } - write_history("history.txt"); - } - - return 0; -} diff --git a/step9_try.c b/step9_try.c deleted file mode 100644 index 9bbefb9..0000000 --- a/step9_try.c +++ /dev/null @@ -1,963 +0,0 @@ -#include -#include -#include -#include -#include -#include -#include -#include - -#include "core.h" -#include "env.h" -#include "printer.h" -#include "reader.h" -#include "util.h" - -char program_template[] = -"#include \n" -"#include \n" -"#include \n" -"#include \n" -"#include \n" -"#include \n" -"{{TOP_CODE}}\n" -"MalType* EVAL(MalEnv *env0) {\n" -" {{EVAL_CODE}}\n" -"}"; - -int compile_eval(MalType *ast, MalEnv *env, int *var_num, MalType* (**EVAL)(MalEnv *env)); -int gen_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num, int quoting); -int gen_call_args_code(MalType *args_name, MalType *node, MalEnv *env, struct codegen *code, int *var_num); -int gen_call_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_closure_code(MalType *fn_name, MalEnv *env, struct codegen *code, int ret); -int gen_continuation_code(char *prefix, MalType *node, MalEnv *env, struct codegen *code, int ret, int trampoline, int *var_num); -int gen_def_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_do_code(MalType *list, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_fn_code(MalType *fn_name, MalType *node, MalEnv *env, struct codegen *code, int *var_num, int new_env); -int gen_hashmap_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_if_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_keyword_code(MalType *node, struct codegen *code, int ret); -int gen_lambda_code(MalType *node, struct codegen *code, int ret); -int gen_let_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_list_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num, int quoting); -int gen_load_file(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_number_code(MalType *node, struct codegen *code, int ret); -int gen_string_code(MalType *node, struct codegen *code, int ret); -int gen_symbol_code(MalType *node, struct codegen *code, int ret); -int gen_symbol_lookup_code(MalType *node, MalEnv *env, struct codegen *code, int ret); -int gen_try_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_vector_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -MalType* quasiquote(MalType *node); -int is_macro_call(MalType *node, MalEnv *env); -void defmacro(MalType *node, MalEnv *env); -MalType* macroexpand(MalType *ast, MalEnv *env); -void append_code(MalType *code, MalType *temp_code, int ret); -MalType* next_var_name(char *base, int *var_num); -MalType* build_env_name(MalEnv *env); -MalType* trampoline(MalType *result); - -MalType* READ(char *str) { - return read_str(str); -} - -MalType* EVAL(MalType *ast, MalEnv *repl_env) { - MalType* (*EVAL)(MalEnv *env); - int var_num = 1; - if (compile_eval(ast, repl_env, &var_num, &EVAL)) { - return trampoline(EVAL(repl_env)); - } else { - printf("There was an error compiling.\n"); - return mal_blank_line(); - } -} - -MalType* user_eval(MalEnv *repl_env, size_t argc, MalType **args) { - UNUSED(repl_env); - mal_assert(argc == 1, "Expected 1 argument to eval"); - MalType* (*EVAL)(MalEnv *env); - MalType *ast = args[0]; - int var_num = 1; - if (compile_eval(ast, repl_env, &var_num, &EVAL)) { - return trampoline(EVAL(repl_env)); - } else { - return mal_error(mal_string("There was an error compiling.")); - } -} - -char *PATH = NULL; - -int compile_eval(MalType *ast, MalEnv *env, int *var_num, MalType* (**EVAL)(MalEnv *env)) { - struct codegen code = { mal_string(""), mal_string(""), mal_string("") }; - int success = gen_code(ast, env, &code, 1, var_num, 0); - - if (!success) { - return 0; - } - - MalType *generated = mal_string_replace(mal_string(program_template), "{{TOP_CODE}}", code.top->str); - - MalType *combined = code.decl; - mal_string_append_mal_string(combined, code.body); - generated = mal_string_replace(generated, "{{EVAL_CODE}}", combined->str); - - if (getenv("DEBUG")) { - printf("-----------------\n%s-----------------\n", generated->str); - } - - TCCState *s = tcc_new(); - if (!s) { - fprintf(stderr, "Could not create tcc state\n"); - return 0; - } - - if(access("./tinycc/libtcc.h", F_OK) != -1) { - tcc_set_lib_path(s, "./tinycc"); - tcc_add_include_path(s, "./tinycc"); - tcc_add_include_path(s, "."); - } else if(PATH) { - tcc_set_lib_path(s, mal_sprintf("%s/tinycc", PATH)->str); - tcc_add_include_path(s, mal_sprintf("%s/tinycc", PATH)->str); - tcc_add_include_path(s, PATH); - } else { - printf("Could not determine path to tinycc and libtcc.h\n"); - exit(1); - } - - tcc_set_output_type(s, TCC_OUTPUT_MEMORY); - - if (tcc_compile_string(s, string(generated->str)) == -1) { - fprintf(stderr, "Could not compile program\n"); - return 0; - } - - tcc_add_symbol(s, "build_env", build_env); - tcc_add_symbol(s, "env_get", env_get); - tcc_add_symbol(s, "env_set", env_set); - tcc_add_symbol(s, "mal_blank_line", mal_blank_line); - tcc_add_symbol(s, "mal_closure", mal_closure); - tcc_add_symbol(s, "mal_continuation", mal_continuation); - tcc_add_symbol(s, "mal_continuation_0", mal_continuation_0); - tcc_add_symbol(s, "mal_continuation_1", mal_continuation_1); - tcc_add_symbol(s, "mal_empty", mal_empty); - tcc_add_symbol(s, "mal_error", mal_error); - tcc_add_symbol(s, "mal_false", mal_false); - tcc_add_symbol(s, "mal_hashmap", mal_hashmap); - tcc_add_symbol(s, "mal_hashmap_put", mal_hashmap_put); - tcc_add_symbol(s, "mal_keyword", mal_keyword); - tcc_add_symbol(s, "mal_nil", mal_nil); - tcc_add_symbol(s, "mal_number", mal_number); - tcc_add_symbol(s, "mal_sprintf", mal_sprintf); - tcc_add_symbol(s, "mal_string", mal_string); - tcc_add_symbol(s, "mal_symbol", mal_symbol); - tcc_add_symbol(s, "mal_true", mal_true); - tcc_add_symbol(s, "mal_vector", mal_vector); - tcc_add_symbol(s, "mal_vector_push", mal_vector_push); - tcc_add_symbol(s, "mal_vector_to_list", mal_vector_to_list); - tcc_add_symbol(s, "pr_str", pr_str); - tcc_add_symbol(s, "trampoline", trampoline); - - int size = tcc_relocate(s, NULL); - if (size < 0) { - fprintf(stderr, "Could not determine size of program\n"); - return 0; - } - - void *mem = GC_MALLOC(size); - if (tcc_relocate(s, mem) < 0) { - fprintf(stderr, "Could not relocate program\n"); - return 0; - } - - *EVAL = tcc_get_symbol(s, "EVAL"); - tcc_delete(s); - - if (!*EVAL) { - fprintf(stderr, "Could not find symbol EVAL\n"); - return 0; - } - - return 1; -} - -int gen_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num, int quoting) { - switch (node->type) { - case MAL_CONS_TYPE: - if (quoting) { - return gen_list_code(node, env, code, ret, var_num, quoting); - } else { - return gen_call_code(node, env, code, ret, var_num); - } - case MAL_EMPTY_TYPE: - append_code(code->body, mal_string("mal_empty()"), ret); - return 1; - case MAL_FALSE_TYPE: - append_code(code->body, mal_string("mal_false()"), ret); - return 1; - case MAL_HASHMAP_TYPE: - return gen_hashmap_code(node, env, code, ret, var_num); - case MAL_KEYWORD_TYPE: - return gen_keyword_code(node, code, ret); - case MAL_LAMBDA_TYPE: - return gen_lambda_code(node, code, ret); - case MAL_NIL_TYPE: - append_code(code->body, mal_string("mal_nil()"), ret); - return 1; - case MAL_NUMBER_TYPE: - return gen_number_code(node, code, ret); - case MAL_STRING_TYPE: - return gen_string_code(node, code, ret); - case MAL_SYMBOL_TYPE: - if (quoting) { - return gen_symbol_code(node, code, ret); - } else { - return gen_symbol_lookup_code(node, env, code, ret); - } - case MAL_TRUE_TYPE: - append_code(code->body, mal_string("mal_true()"), ret); - return 1; - case MAL_VECTOR_TYPE: - return gen_vector_code(node, env, code, ret, var_num); - default: - printf("unknown node type in code gen type=%d\n", node->type); - return 0; - } -} - -int gen_call_args_code(MalType *args_name, MalType *node, MalEnv *env, struct codegen *code, int *var_num) { - if (is_empty(node)) { - append_code(code->decl, mal_sprintf("MalType **%S = NULL;", args_name), 0); - return 1; - } - assert(is_cons(node)); - size_t arg_count = mal_list_len(node), index = 0; - MalType *temp_code = mal_sprintf("MalType **%S = GC_MALLOC(sizeof(MalType*) * %z);\n ", args_name, arg_count); - struct codegen code2; - while (!is_empty(node)) { - assert(is_cons(node)); - mal_string_append_mal_string(temp_code, mal_sprintf("%S[%z] = bubble_if_error(", args_name, index)); - code2 = (struct codegen){ code->top, code->decl, temp_code }; - if (!gen_code(mal_car(node), env, &code2, 0, var_num, 0)) { - return 0; - } - mal_string_append(temp_code, ");\n "); - node = mal_cdr(node); - index++; - } - append_code(code->decl, temp_code, 0); - return 1; -} - -int gen_call_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - node = macroexpand(node, env); - if (!is_cons(node)) { - return gen_code(node, env, code, ret, var_num, 0); - } - - MalType *sym = mal_car(node), *temp_code, *fn_name; - - if (is_symbol(sym)) { - if (strcmp(sym->symbol, "def!") == 0) { - return gen_def_code(mal_cdr(node), env, code, ret, var_num); - } else if (strcmp(sym->symbol, "let*") == 0) { - return gen_let_code(mal_cdr(node), env, code, ret, var_num); - } else if (strcmp(sym->symbol, "do") == 0) { - return gen_do_code(mal_cdr(node), env, code, ret, var_num); - } else if (strcmp(sym->symbol, "if") == 0) { - return gen_if_code(mal_cdr(node), env, code, ret, var_num); - } else if (strcmp(sym->symbol, "fn*") == 0) { - fn_name = next_var_name("fn", var_num); - if (!gen_fn_code(fn_name, mal_cdr(node), env, code, var_num, 1)) { - return 0; - } - return gen_closure_code(fn_name, env, code, ret); - } else if (strcmp(sym->symbol, "quote") == 0) { - return gen_code(mal_car(mal_cdr(node)), env, code, ret, var_num, 1); - } else if (strcmp(sym->symbol, "quasiquote") == 0) { - return gen_code(quasiquote(mal_car(mal_cdr(node))), env, code, ret, var_num, 0); - } else if (strcmp(sym->symbol, "defmacro!") == 0) { - defmacro(mal_cdr(node), env); - append_code(code->body, mal_string("mal_blank_line()"), ret); - return 1; - } else if (strcmp(sym->symbol, "macroexpand") == 0) { - node = macroexpand(mal_car(mal_cdr(node)), env); - return gen_code(node, env, code, ret, var_num, 1); - } else if (strcmp(sym->symbol, "try*") == 0) { - return gen_try_code(mal_cdr(node), env, code, ret, var_num); - } else if (strcmp(sym->symbol, "load-file") == 0) { - return gen_load_file(mal_car(mal_cdr(node)), env, code, ret, var_num); - } - } - - // look up the lambda in the env - MalType *lambda_name = next_var_name("lambda", var_num); - temp_code = mal_string("MalType *"); - mal_string_append_mal_string(temp_code, lambda_name); - mal_string_append(temp_code, " = "); - struct codegen code2 = { code->top, code->decl, temp_code }; - if (!gen_code(sym, env, &code2, 0, var_num, 0)) { - return 0; - } - mal_string_append(temp_code, ";\n "); - mal_string_append_mal_string( - temp_code, - mal_sprintf( - "if (!is_lambda(%S)) { return mal_error(mal_sprintf(\"%%s is not callable\", pr_str(%S, 1))); }\n ", - lambda_name, - lambda_name - ) - ); - append_code(code->decl, temp_code, 0); - - // build the args array - MalType *args_name, *args_node = mal_cdr(node); - size_t args_count = mal_list_len(args_node); - if (args_count == 0) { - args_name = mal_string("NULL"); - } else { - args_name = mal_string_replace(lambda_name, "lambda", "args"); - if (!gen_call_args_code(args_name, args_node, env, code, var_num)) { - return 0; - } - } - - // return the functional call as a continuation - temp_code = mal_sprintf( - "mal_continuation(%S->fn, %S->env, %z, %S)", - lambda_name, - lambda_name, - args_count, - args_name - ); - - append_code( - code->body, - ret ? temp_code : mal_sprintf("trampoline(%S)", temp_code), - ret - ); - - return 1; -} - -int gen_closure_code(MalType *fn_name, MalEnv *env, struct codegen *code, int ret) { - MalType *closure_name = mal_string("closure_"); - mal_string_append_mal_string(closure_name, fn_name); - MalType *temp_code = mal_sprintf( - "MalType *%S = mal_closure(%S, %S);\n ", - closure_name, - fn_name, - build_env_name(env) - ); - append_code(code->decl, temp_code, 0); - append_code(code->body, closure_name, ret); - return 1; -} - -int gen_continuation_code(char *prefix, MalType *node, MalEnv *env, struct codegen *code, int ret, int trampoline, int *var_num) { - MalType *fn = mal_cons(mal_empty(), mal_cons(node, mal_empty())); - MalType *fn_name = next_var_name(prefix, var_num); - if (!gen_fn_code(fn_name, fn, env, code, var_num, 0)) { - return 0; - } - MalType *temp_code = mal_string(""); - append_code(temp_code, mal_sprintf("mal_continuation(%S, %S, 0, NULL)", fn_name, build_env_name(env)), 0); - append_code(code->body, trampoline ? temp_code : mal_sprintf("trampoline(%S)", temp_code), ret); - return 1; -} - -int gen_def_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *env_name = build_env_name(env); - MalType *name = mal_car(node); - assert(is_symbol(name)); - char *name_str = pr_str(mal_string(name->symbol), 1); - - int key_already_exists = !!env_get(env, name->symbol); - if (!key_already_exists) env_set(env, name->symbol, mal_true()); - struct codegen code2 = (struct codegen){ code->top, code->decl, mal_string("") }; - MalType *val_node = mal_car(mal_cdr(node)); - if (!gen_code(val_node, env, &code2, 0, var_num, 0)) { - if (!key_already_exists) env_delete(env, name->symbol); - return 0; - } - - MalType *temp_code = mal_sprintf("env_set(%S, %s, bubble_if_error(%S))", env_name, name_str, code2.body); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_do_code(MalType *list, MalEnv *env, struct codegen *code, int ret, int *var_num) { - struct list_or_vector_iter *iter; - struct codegen code2; - MalType *node, *temp_decl, *temp_code; - int is_last = 0; - for (iter = list_or_vector_iter(list); iter; iter = list_or_vector_iter_next(iter)) { - temp_decl = mal_string(""); - temp_code = mal_string(""); - node = list_or_vector_iter_get_obj(iter); - is_last = list_or_vector_iter_is_last(iter); - code2 = (struct codegen){ code->top, temp_decl, temp_code }; - if (is_last) { - if (!gen_continuation_code("do", node, env, &code2, ret, ret, var_num)) { - return 0; - } - } else { - if (!gen_code(node, env, &code2, 0, var_num, 0)) { - return 0; - } - } - if (is_last) { - append_code(code->decl, temp_decl, 0); - append_code(code->body, temp_code, 0); - } else { - mal_string_append(temp_code, ";\n "); - append_code(code->decl, temp_decl, 0); - append_code(code->decl, temp_code, 0); - } - } - return 1; -} - -int gen_fn_code(MalType *fn_name, MalType *node, MalEnv *env, struct codegen *code, int *var_num, int new_env) { - MalType *args = mal_car(node); - size_t arg_count = list_or_vector_len(args); - - // function header - MalType *temp_fn = mal_sprintf("MalType* %S(MalEnv *env, size_t argc, MalType **args) {\n ", fn_name); - - // inner env - MalEnv *inner_env; - MalType *inner_env_name; - if (new_env) { - inner_env = build_env(env); - inner_env->num = (*var_num)++; - inner_env_name = build_env_name(inner_env); - mal_string_append_mal_string(temp_fn, mal_sprintf("MalEnv *%S = build_env(env);\n ", inner_env_name)); - } else { - inner_env = env; - inner_env_name = build_env_name(env); - mal_string_append_mal_string(temp_fn, mal_sprintf("MalEnv *%S = env;\n ", inner_env_name)); - } - - // arity check - int more_pos = list_or_vector_index_of(args, mal_symbol("&")); - if (more_pos == -1) { - mal_string_append_mal_string( - temp_fn, - mal_sprintf("mal_assert(argc == %i, \"Arity mismatch.\");\n ", arg_count) - ); - } else { - mal_string_append_mal_string( - temp_fn, - mal_sprintf("mal_assert(argc >= %i, \"Arity mismatch.\");\n ", more_pos) - ); - } - - // set arguments in inner env - if (arg_count > 0) { - struct list_or_vector_iter *iter; - MalType *arg; - size_t index = 0; - int is_more = 0; - for (iter = list_or_vector_iter(args); iter; iter = list_or_vector_iter_next(iter)) { - arg = list_or_vector_iter_get_obj(iter); - assert(is_symbol(arg)); - if (strcmp("&", arg->symbol) == 0) { - is_more = 1; - continue; - } - if (is_more) { - // accumulate remaining args in a list - char *more_name = arg->symbol; - mal_string_append(temp_fn, "MalType *rest_args = mal_vector();\n "); - mal_string_append_mal_string( - temp_fn, - mal_sprintf("for(size_t arg_i=%z; arg_isymbol), 1), - index - ) - ); - env_set(inner_env, arg->symbol, mal_true()); - index++; - } - } - } - - // function body - MalType *fn_decl = mal_string(""); - MalType *fn_code = mal_string(""); - struct codegen code2 = (struct codegen){ code->top, fn_decl, fn_code }; - MalType *fn_body = mal_cdr(node); - assert(!is_empty(fn_body)); - if (!gen_code(mal_car(fn_body), inner_env, &code2, 1, var_num, 0)) { - return 0; - } - append_code(temp_fn, fn_decl, 0); - append_code(temp_fn, fn_code, 0); - - // closing brace - mal_string_append(temp_fn, "\n}\n\n"); - append_code(code->top, temp_fn, 0); - - return 1; -} - -int gen_hashmap_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - int len = mal_hashmap_size(node); - if (len == 0) { - append_code(code->body, mal_string("mal_hashmap()"), ret); - return 1; - } - - MalType *var_name = next_var_name("var", var_num); - MalType *temp_code = mal_string("MalType *"); - mal_string_append_mal_string(temp_code, var_name); - mal_string_append(temp_code, " = mal_hashmap();\n "); - - struct hashmap_iter *iter; - struct codegen code2; - char *key_str; - MalType *val; - for (iter = hashmap_iter(&node->hashmap); iter; iter = hashmap_iter_next(&node->hashmap, iter)) { - key_str = (char*)hashmap_iter_get_key(iter); - val = (MalType*)hashmap_iter_get_data(iter); - mal_string_append(temp_code, "mal_hashmap_put("); - mal_string_append_mal_string(temp_code, var_name); - mal_string_append(temp_code, ", "); - code2 = (struct codegen){ code->top, code->decl, temp_code }; - if (!gen_code(read_str(key_str), env, &code2, 0, var_num, 0)) { - return 0; - } - mal_string_append(temp_code, ", "); - code2 = (struct codegen){ code->top, code->decl, temp_code }; - if (!gen_code(val, env, &code2, 0, var_num, 0)) { - return 0; - } - mal_string_append(temp_code, ");\n "); - } - - append_code(code->decl, temp_code, 0); - append_code(code->body, var_name, ret); - return 1; -} - -int gen_if_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *cond_code = mal_string(""); - struct codegen code2 = (struct codegen){ code->top, code->decl, cond_code }; - if (!gen_code(mal_car(node), env, &code2, 0, var_num, 0)) { - return 0; - } - node = mal_cdr(node); - MalType *true_code = mal_string(""); - code2.body = true_code; - MalType *true_val = mal_car(node); - if (is_primitive(true_val)) { - if (!gen_code(true_val, env, &code2, 0, var_num, 0)) { - return 0; - } - } else { - if (!gen_continuation_code("if_true", true_val, env, &code2, 0, ret, var_num)) { - return 0; - } - } - node = mal_cdr(node); - MalType *false_code = mal_string(""); - code2.body = false_code; - MalType *false_val; - if (is_empty(node)) { - false_val = mal_nil(); - } else { - false_val = mal_car(node); - } - if (is_primitive(false_val)) { - if (!gen_code(false_val, env, &code2, 0, var_num, 0)) { - return 0; - } - } else { - if (!gen_continuation_code("if_false", false_val, env, &code2, 0, ret, var_num)) { - return 0; - } - } - append_code( - code->body, - mal_sprintf("is_truthy(%S) ? %S : %S", cond_code, true_code, false_code), - ret - ); - return 1; -} - -int gen_keyword_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_keyword(%s)", pr_str(mal_string(node->keyword), 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_lambda_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("(MalType*)%p /* %s */", node, pr_str(node, 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_let_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalEnv *inner_env = build_env(env); - inner_env->num = (*var_num)++; - MalType *outer_env_name = build_env_name(env); - MalType *inner_env_name = build_env_name(inner_env); - MalType *temp_code = mal_sprintf("MalEnv *%S = build_env(%S);\n ", inner_env_name, outer_env_name); - append_code(code->decl, temp_code, 0); - - temp_code = mal_string(""); - - struct list_or_vector_iter *iter; - struct codegen code2; - MalType *name, *val, *inner_decl, *val_code; - for (iter = list_or_vector_iter(mal_car(node)); iter; iter = list_or_vector_iter_next(iter)) { - inner_decl = mal_string(""); - name = list_or_vector_iter_get_obj(iter); - assert(is_symbol(name)); - iter = list_or_vector_iter_next(iter); - val = list_or_vector_iter_get_obj(iter); - env_set(inner_env, name->symbol, mal_true()); - code2 = (struct codegen){ code->top, inner_decl, mal_string("") }; - if (!gen_code(val, inner_env, &code2, 0, var_num, 0)) { - return 0; - } - val_code = mal_sprintf("env_set(%S, %s, %S);\n ", inner_env_name, pr_str(mal_string(name->symbol), 1), code2.body); - mal_string_append_mal_string(temp_code, inner_decl); - mal_string_append_mal_string(temp_code, val_code); - } - - append_code(code->decl, temp_code, 0); - - node = mal_cdr(node); - if (!gen_continuation_code("let", mal_car(node), inner_env, code, ret, ret, var_num)) { - return 0; - } - - return 1; -} - -int gen_list_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num, int quoting) { - MalType *list_name = next_var_name("list", var_num); - MalType *temp_decl = mal_sprintf("MalType *%S = mal_vector();\n ", list_name); - struct list_or_vector_iter *iter; - MalType *item; - struct codegen code2; - for (iter = list_or_vector_iter(node); iter; iter = list_or_vector_iter_next(iter)) { - item = list_or_vector_iter_get_obj(iter); - mal_string_append_mal_string( - temp_decl, - mal_sprintf("mal_vector_push(%S, ", list_name) - ); - code2 = (struct codegen){ code->top, code->decl, temp_decl }; - if (!gen_code(item, env, &code2, 0, var_num, quoting)) { - return 0; - } - mal_string_append(temp_decl, ");\n "); - } - append_code(code->decl, temp_decl, 0); - append_code(code->body, mal_sprintf("mal_vector_to_list(%S)", list_name), ret); - return 1; -} - -int gen_load_file(MalType *filename_node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *contents = core_slurp(env, 1, &filename_node); - MalType *ast = read_str(mal_sprintf("(do %S)", contents)->str); - return gen_code(ast, env, code, ret, var_num, 0); -} - -int gen_number_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_number(%s)", pr_str(node, 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_string_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_string(%s)", pr_str(node, 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_symbol_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_symbol(%s)", pr_str(mal_string(node->symbol), 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_symbol_lookup_code(MalType *node, MalEnv *env, struct codegen *code, int ret) { - UNUSED(env); - MalType *temp_code = mal_sprintf( - "bubble_if_error(env_get(%S, %s))", - build_env_name(env), - pr_str(mal_string(node->symbol), 1) - ); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_try_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *try_expr = mal_car(node); // (A (catch* B C)) - MalType *catch_node_list = mal_cdr(node); // ((catch* B C)) - if (is_empty(catch_node_list)) { - return gen_code(try_expr, env, code, ret, var_num, 0); - } - MalType *try_as_lambda_expr = mal_cons( - mal_empty(), // fn args (none) - mal_cons(try_expr, mal_empty()) // fn body - ); - MalType *try_fn_name = next_var_name("try", var_num); - if (!gen_fn_code(try_fn_name, try_as_lambda_expr, env, code, var_num, 1)) { - return 0; - } - MalType *catch_node = mal_car(catch_node_list); // (catch* B C) - assert(is_cons(catch_node)); - MalType *catch_sym = mal_car(catch_node); // catch* - assert(is_symbol(catch_sym) && strcmp(catch_sym->symbol, "catch*") == 0); - MalType *arg_name = mal_car(mal_cdr(catch_node)); // B - assert(is_symbol(arg_name)); - MalType *catch_expr = mal_car(mal_cdr(mal_cdr(catch_node))); // C - MalType *catch_fn_name = next_var_name("catch", var_num); - MalType *catch_as_lambda_expr = mal_cons( - mal_cons(arg_name, mal_empty()), // fn arg - mal_cons(catch_expr, mal_empty()) // fn body - ); - if (!gen_fn_code(catch_fn_name, catch_as_lambda_expr, env, code, var_num, 1)) { - return 0; - } - MalType *result_name = next_var_name("try_result", var_num); - MalType *try_call_code = mal_sprintf("trampoline(mal_continuation_0(%S, %S))", try_fn_name, build_env_name(env)); - MalType *catch_call_code = mal_sprintf("mal_continuation_1(%S, %S, %S->error_val)", catch_fn_name, build_env_name(env), result_name); - if (!ret) { - catch_call_code = mal_sprintf("trampoline(%S)", catch_call_code); - } - mal_string_append_mal_string( - code->decl, - mal_sprintf("MalType *%S = %S;\n ", result_name, try_call_code) - ); - append_code( - code->body, - mal_sprintf("is_error(%S) ? %S : %S", result_name, catch_call_code, result_name), - ret - ); - return 1; -} - -int gen_vector_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *var_name = next_var_name("var", var_num); - MalType *temp_code = mal_string("MalType *"); - mal_string_append_mal_string(temp_code, var_name); - mal_string_append(temp_code, " = mal_vector();\n "); - struct codegen code2; - for(size_t i=0; itop, code->decl, temp_code }; - if (!gen_code(mal_vector_ref(node, i), env, &code2, 0, var_num, 0)) { - return 0; - } - mal_string_append(temp_code, ");\n "); - } - append_code(code->decl, temp_code, 0); - append_code(code->body, var_name, ret); - return 1; -} - -MalType* quasiquote(MalType *node) { - if (!is_pair(node)) { - return mal_cons(mal_symbol("quote"), mal_cons(node, mal_empty())); - } else if (is_symbol(mal_car2(node)) && strcmp(mal_car2(node)->symbol, "unquote") == 0) { - return mal_car2(mal_cdr2(node)); - } else if (is_pair(mal_car2(node)) && is_symbol(mal_car2(mal_car2(node))) && strcmp(mal_car2(mal_car2(node))->symbol, "splice-unquote") == 0) { - return mal_cons( - mal_symbol("concat"), - mal_cons( - mal_car2(mal_cdr2(mal_car2(node))), - mal_cons( - quasiquote(mal_cdr2(node)), - mal_empty() - ) - ) - ); - } else { - return mal_cons( - mal_symbol("cons"), - mal_cons( - quasiquote(mal_car2(node)), - mal_cons( - quasiquote(mal_cdr2(node)), - mal_empty() - ) - ) - ); - } -} - -int is_macro_call(MalType *node, MalEnv *env) { - if (!is_cons(node)) { - return 0; - } - MalType *sym = mal_car(node); - if (!is_symbol(sym)) { - return 0; - } - MalType *macro = env_get(env, sym->symbol); - if (macro && macro->is_macro) { - return 1; - } else { - return 0; - } -} - -void defmacro(MalType *node, MalEnv *env) { - int var_num = 1; - MalType* (*EVAL)(MalEnv *env); - MalType *name = mal_car(node); - assert(is_symbol(name)); - node = mal_car(mal_cdr(node)); - if (!compile_eval(node, env, &var_num, &EVAL)) { - printf("Error compiling macro.\n"); - exit(1); - } - MalType *macro = trampoline(EVAL(env)); - macro->is_macro = 1; - env_set(env, name->symbol, macro); -} - -MalType* macroexpand(MalType *ast, MalEnv *env) { - MalType *name, *macro, *arg_list, **args; - size_t argc; - while (is_macro_call(ast, env)) { - name = mal_car(ast); - macro = env_get(env, name->symbol); - arg_list = mal_cdr(ast); - argc = mal_list_len(arg_list); - if (argc > 0) { - args = GC_MALLOC(sizeof(MalType*) * argc); - for (size_t i=0; ifn, macro->env, argc, args)); - assert(ast != NULL); - } - return ast; -} - -void append_code(MalType *code, MalType *temp_code, int ret) { - if (ret) mal_string_append(code, "return "); - mal_string_append_mal_string(code, temp_code); - if (ret) mal_string_append(code, ";"); -} - -MalType* next_var_name(char *base, int *var_num) { - MalType *var_name = mal_string(base); - mal_string_append_long_long(var_name, (*var_num)++); - return var_name; -} - -MalType* build_env_name(MalEnv *env) { - MalType *name = mal_string("env"); - mal_string_append_long_long(name, env->num); - return name; -} - -char* PRINT(MalType *ast) { - return pr_str(ast, 2); -} - -char* rep(char *str, MalEnv *repl_env) { - MalType *result = EVAL(READ(str), repl_env); - if (is_error(result)) { - return PRINT(mal_sprintf("ERROR: %s\n", pr_str(result->error_val, 0))); - } else { - return PRINT(result); - } -} - -char *parent_directory(char *bin_path) { - char *path = string(bin_path); - size_t len; - while ((len = strlen(path)) > 0 && path[len - 1] != '/') { - path[len - 1] = 0; - } - if (len > 0) path[len - 1] = 0; - if (strlen(path) == 0) { - return string("."); - } else { - return path; - } -} - -int main(int argc, char *argv[]) { - PATH = parent_directory(argv[0]); - - MalEnv *repl_env = build_top_env(); - - struct hashmap *ns = core_ns(); - struct hashmap_iter *core_iter; - char *name; - MalType* (*fn)(MalEnv*, size_t, MalType**); - for (core_iter = hashmap_iter(ns); core_iter; core_iter = hashmap_iter_next(ns, core_iter)) { - name = (char*)hashmap_iter_get_key(core_iter); - fn = hashmap_iter_get_data(core_iter); - env_set(repl_env, name, mal_builtin_function(fn, name, repl_env)); - } - env_set(repl_env, "eval", mal_builtin_function(user_eval, "eval", repl_env)); - - MalType *arg_list = mal_vector(); - for (int i=2; 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)))))))" - "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs)))))))))", - pr_str(arg_list, 1) - )->str, - repl_env - ); - - if (argc > 1) { - rep(mal_sprintf("(load-file %s)", pr_str(mal_string(argv[1]), 1))->str, repl_env); - } else { - char *buffer; - read_history("history.txt"); - while ((buffer = readline("user> ")) != NULL) { - printf("%s\n", rep(buffer, repl_env)); - if (strlen(buffer) > 0) { - add_history(buffer); - } - free(buffer); - } - write_history("history.txt"); - } - - return 0; -} diff --git a/stepA_mal.c b/stepA_mal.c deleted file mode 100644 index 8150914..0000000 --- a/stepA_mal.c +++ /dev/null @@ -1,978 +0,0 @@ -#include -#include -#include -#include -#include -#include -#include -#include - -#include "core.h" -#include "env.h" -#include "printer.h" -#include "reader.h" -#include "util.h" - -char program_template[] = -"#include \n" -"#include \n" -"#include \n" -"#include \n" -"#include \n" -"#include \n" -"{{TOP_CODE}}\n" -"MalType* EVAL(MalEnv *env0) {\n" -" {{EVAL_CODE}}\n" -"}"; - -int compile_eval(MalType *ast, MalEnv *env, int *var_num, MalType* (**EVAL)(MalEnv *env)); -int gen_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num, int quoting); -int gen_call_args_code(MalType *args_name, MalType *node, MalEnv *env, struct codegen *code, int *var_num); -int gen_call_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_closure_code(MalType *fn_name, MalEnv *env, struct codegen *code, int ret); -int gen_continuation_code(char *prefix, MalType *node, MalEnv *env, struct codegen *code, int ret, int trampoline, int *var_num); -int gen_def_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_do_code(MalType *list, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_fn_code(MalType *fn_name, MalType *node, MalEnv *env, struct codegen *code, int *var_num, int new_env); -int gen_hashmap_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_if_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_keyword_code(MalType *node, struct codegen *code, int ret); -int gen_lambda_code(MalType *node, struct codegen *code, int ret); -int gen_let_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_list_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num, int quoting); -int gen_load_file(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_number_code(MalType *node, struct codegen *code, int ret); -int gen_string_code(MalType *node, struct codegen *code, int ret); -int gen_symbol_code(MalType *node, struct codegen *code, int ret); -int gen_symbol_lookup_code(MalType *node, MalEnv *env, struct codegen *code, int ret); -int gen_try_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -int gen_vector_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num); -MalType* quasiquote(MalType *node); -int is_macro_call(MalType *node, MalEnv *env); -void defmacro(MalType *node, MalEnv *env); -MalType* macroexpand(MalType *ast, MalEnv *env); -void append_code(MalType *code, MalType *temp_code, int ret); -MalType* next_var_name(char *base, int *var_num); -MalType* build_env_name(MalEnv *env); -MalType* trampoline(MalType *result); - -MalType* READ(char *str) { - return read_str(str); -} - -MalType* EVAL(MalType *ast, MalEnv *repl_env) { - MalType* (*EVAL)(MalEnv *env); - int var_num = 1; - if (compile_eval(ast, repl_env, &var_num, &EVAL)) { - return trampoline(EVAL(repl_env)); - } else { - printf("There was an error compiling.\n"); - return mal_blank_line(); - } -} - -MalType* user_eval(MalEnv *repl_env, size_t argc, MalType **args) { - mal_assert(argc == 1, "Expected 1 argument to eval"); - MalType* (*EVAL)(MalEnv *env); - MalType *ast = args[0]; - int var_num = 1; - if (compile_eval(ast, repl_env, &var_num, &EVAL)) { - return trampoline(EVAL(repl_env)); - } else { - return mal_error(mal_string("There was an error compiling.")); - } -} - -char *PATH = NULL; - -int compile_eval(MalType *ast, MalEnv *env, int *var_num, MalType* (**EVAL)(MalEnv *env)) { - struct codegen code = { mal_string(""), mal_string(""), mal_string("") }; - int success = gen_code(ast, env, &code, 1, var_num, 0); - - if (!success) { - return 0; - } - - MalType *generated = mal_string_replace(mal_string(program_template), "{{TOP_CODE}}", code.top->str); - - MalType *combined = code.decl; - mal_string_append_mal_string(combined, code.body); - generated = mal_string_replace(generated, "{{EVAL_CODE}}", combined->str); - - if (getenv("DEBUG")) { - printf("-----------------\n%s-----------------\n", generated->str); - } - - TCCState *s = tcc_new(); - if (!s) { - fprintf(stderr, "Could not create tcc state\n"); - return 0; - } - - if (access("./tinycc/libtcc.h", F_OK) != -1) { - tcc_set_lib_path(s, "./tinycc"); - tcc_add_include_path(s, "./tinycc"); - tcc_add_include_path(s, "."); - } else if (PATH) { - tcc_set_lib_path(s, mal_sprintf("%s/tinycc", PATH)->str); - tcc_add_include_path(s, mal_sprintf("%s/tinycc", PATH)->str); - tcc_add_include_path(s, PATH); - } else { - printf("Could not determine path to tinycc and libtcc.h\n"); - exit(1); - } - - tcc_set_output_type(s, TCC_OUTPUT_MEMORY); - - if (tcc_compile_string(s, string(generated->str)) == -1) { - fprintf(stderr, "Could not compile program\n"); - return 0; - } - - tcc_add_symbol(s, "build_env", build_env); - tcc_add_symbol(s, "env_get", env_get); - tcc_add_symbol(s, "env_set", env_set); - tcc_add_symbol(s, "mal_blank_line", mal_blank_line); - tcc_add_symbol(s, "mal_closure", mal_closure); - tcc_add_symbol(s, "mal_continuation", mal_continuation); - tcc_add_symbol(s, "mal_continuation_0", mal_continuation_0); - tcc_add_symbol(s, "mal_continuation_1", mal_continuation_1); - tcc_add_symbol(s, "mal_empty", mal_empty); - tcc_add_symbol(s, "mal_error", mal_error); - tcc_add_symbol(s, "mal_false", mal_false); - tcc_add_symbol(s, "mal_hashmap", mal_hashmap); - tcc_add_symbol(s, "mal_hashmap_put", mal_hashmap_put); - tcc_add_symbol(s, "mal_keyword", mal_keyword); - tcc_add_symbol(s, "mal_nil", mal_nil); - tcc_add_symbol(s, "mal_number", mal_number); - tcc_add_symbol(s, "mal_sprintf", mal_sprintf); - tcc_add_symbol(s, "mal_string", mal_string); - tcc_add_symbol(s, "mal_symbol", mal_symbol); - tcc_add_symbol(s, "mal_true", mal_true); - tcc_add_symbol(s, "mal_vector", mal_vector); - tcc_add_symbol(s, "mal_vector_push", mal_vector_push); - tcc_add_symbol(s, "mal_vector_to_list", mal_vector_to_list); - tcc_add_symbol(s, "pr_str", pr_str); - tcc_add_symbol(s, "trampoline", trampoline); - - int size = tcc_relocate(s, NULL); - if (size < 0) { - fprintf(stderr, "Could not determine size of program\n"); - return 0; - } - - void *mem = GC_MALLOC(size); - if (tcc_relocate(s, mem) < 0) { - fprintf(stderr, "Could not relocate program\n"); - return 0; - } - - *EVAL = tcc_get_symbol(s, "EVAL"); - tcc_delete(s); - - if (!*EVAL) { - fprintf(stderr, "Could not find symbol EVAL\n"); - return 0; - } - - return 1; -} - -int gen_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num, int quoting) { - switch (node->type) { - case MAL_CONS_TYPE: - if (quoting) { - return gen_list_code(node, env, code, ret, var_num, quoting); - } else { - return gen_call_code(node, env, code, ret, var_num); - } - case MAL_EMPTY_TYPE: - append_code(code->body, mal_string("mal_empty()"), ret); - return 1; - case MAL_FALSE_TYPE: - append_code(code->body, mal_string("mal_false()"), ret); - return 1; - case MAL_HASHMAP_TYPE: - return gen_hashmap_code(node, env, code, ret, var_num); - case MAL_KEYWORD_TYPE: - return gen_keyword_code(node, code, ret); - case MAL_LAMBDA_TYPE: - return gen_lambda_code(node, code, ret); - case MAL_NIL_TYPE: - append_code(code->body, mal_string("mal_nil()"), ret); - return 1; - case MAL_NUMBER_TYPE: - return gen_number_code(node, code, ret); - case MAL_STRING_TYPE: - return gen_string_code(node, code, ret); - case MAL_SYMBOL_TYPE: - if (quoting) { - return gen_symbol_code(node, code, ret); - } else { - return gen_symbol_lookup_code(node, env, code, ret); - } - case MAL_TRUE_TYPE: - append_code(code->body, mal_string("mal_true()"), ret); - return 1; - case MAL_VECTOR_TYPE: - return gen_vector_code(node, env, code, ret, var_num); - default: - printf("unknown node type in code gen type=%d\n", node->type); - return 0; - } -} - -int gen_call_args_code(MalType *args_name, MalType *node, MalEnv *env, struct codegen *code, int *var_num) { - if (is_empty(node)) { - append_code(code->decl, mal_sprintf("MalType **%S = NULL;", args_name), 0); - return 1; - } - assert(is_cons(node)); - size_t arg_count = mal_list_len(node), index = 0; - MalType *temp_code = mal_sprintf("MalType **%S = GC_MALLOC(sizeof(MalType*) * %z);\n ", args_name, arg_count); - struct codegen code2; - while (!is_empty(node)) { - assert(is_cons(node)); - mal_string_append_mal_string(temp_code, mal_sprintf("%S[%z] = bubble_if_error(", args_name, index)); - code2 = (struct codegen){ code->top, code->decl, temp_code }; - if (!gen_code(mal_car(node), env, &code2, 0, var_num, 0)) { - return 0; - } - mal_string_append(temp_code, ");\n "); - node = mal_cdr(node); - index++; - } - append_code(code->decl, temp_code, 0); - return 1; -} - -int gen_call_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - node = macroexpand(node, env); - if (!is_cons(node)) { - return gen_code(node, env, code, ret, var_num, 0); - } - - MalType *sym = mal_car(node), *temp_code, *fn_name; - - if (is_symbol(sym)) { - if (strcmp(sym->symbol, "def!") == 0) { - return gen_def_code(mal_cdr(node), env, code, ret, var_num); - } else if (strcmp(sym->symbol, "let*") == 0) { - return gen_let_code(mal_cdr(node), env, code, ret, var_num); - } else if (strcmp(sym->symbol, "do") == 0) { - return gen_do_code(mal_cdr(node), env, code, ret, var_num); - } else if (strcmp(sym->symbol, "if") == 0) { - return gen_if_code(mal_cdr(node), env, code, ret, var_num); - } else if (strcmp(sym->symbol, "fn*") == 0) { - fn_name = next_var_name("fn", var_num); - if (!gen_fn_code(fn_name, mal_cdr(node), env, code, var_num, 1)) { - return 0; - } - return gen_closure_code(fn_name, env, code, ret); - } else if (strcmp(sym->symbol, "quote") == 0) { - return gen_code(mal_car(mal_cdr(node)), env, code, ret, var_num, 1); - } else if (strcmp(sym->symbol, "quasiquote") == 0) { - return gen_code(quasiquote(mal_car(mal_cdr(node))), env, code, ret, var_num, 0); - } else if (strcmp(sym->symbol, "defmacro!") == 0) { - defmacro(mal_cdr(node), env); - append_code(code->body, mal_string("mal_blank_line()"), ret); - return 1; - } else if (strcmp(sym->symbol, "macroexpand") == 0) { - node = macroexpand(mal_car(mal_cdr(node)), env); - return gen_code(node, env, code, ret, var_num, 1); - } else if (strcmp(sym->symbol, "try*") == 0) { - return gen_try_code(mal_cdr(node), env, code, ret, var_num); - } else if (strcmp(sym->symbol, "load-file") == 0) { - return gen_load_file(mal_car(mal_cdr(node)), env, code, ret, var_num); - } - } - - // look up the lambda in the env - MalType *lambda_name = next_var_name("lambda", var_num); - temp_code = mal_string("MalType *"); - mal_string_append_mal_string(temp_code, lambda_name); - mal_string_append(temp_code, " = "); - struct codegen code2 = { code->top, code->decl, temp_code }; - if (!gen_code(sym, env, &code2, 0, var_num, 0)) { - return 0; - } - mal_string_append(temp_code, ";\n "); - mal_string_append_mal_string( - temp_code, - mal_sprintf( - "if (!is_lambda(%S)) { return mal_error(mal_sprintf(\"%%s is not callable\", pr_str(%S, 1))); }\n ", - lambda_name, - lambda_name - ) - ); - append_code(code->decl, temp_code, 0); - - // build the args array - MalType *args_name, *args_node = mal_cdr(node); - size_t args_count = mal_list_len(args_node); - if (args_count == 0) { - args_name = mal_string("NULL"); - } else { - args_name = mal_string_replace(lambda_name, "lambda", "args"); - if (!gen_call_args_code(args_name, args_node, env, code, var_num)) { - return 0; - } - } - - // return the functional call as a continuation - temp_code = mal_sprintf( - "mal_continuation(%S->fn, %S->env, %z, %S)", - lambda_name, - lambda_name, - args_count, - args_name - ); - - append_code( - code->body, - ret ? temp_code : mal_sprintf("trampoline(%S)", temp_code), - ret - ); - - return 1; -} - -int gen_closure_code(MalType *fn_name, MalEnv *env, struct codegen *code, int ret) { - MalType *closure_name = mal_string("closure_"); - mal_string_append_mal_string(closure_name, fn_name); - MalType *temp_code = mal_sprintf( - "MalType *%S = mal_closure(%S, %S);\n ", - closure_name, - fn_name, - build_env_name(env) - ); - append_code(code->decl, temp_code, 0); - append_code(code->body, closure_name, ret); - return 1; -} - -int gen_continuation_code(char *prefix, MalType *node, MalEnv *env, struct codegen *code, int ret, int trampoline, int *var_num) { - MalType *fn = mal_cons(mal_empty(), mal_cons(node, mal_empty())); - MalType *fn_name = next_var_name(prefix, var_num); - if (!gen_fn_code(fn_name, fn, env, code, var_num, 0)) { - return 0; - } - MalType *temp_code = mal_string(""); - append_code(temp_code, mal_sprintf("mal_continuation(%S, %S, 0, NULL)", fn_name, build_env_name(env)), 0); - append_code(code->body, trampoline ? temp_code : mal_sprintf("trampoline(%S)", temp_code), ret); - return 1; -} - -int gen_def_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *env_name = build_env_name(env); - MalType *name = mal_car(node); - assert(is_symbol(name)); - char *name_str = pr_str(mal_string(name->symbol), 1); - - int key_already_exists = !!env_get(env, name->symbol); - if (!key_already_exists) env_set(env, name->symbol, mal_true()); - struct codegen code2 = (struct codegen){ code->top, code->decl, mal_string("") }; - MalType *val_node = mal_car(mal_cdr(node)); - if (!gen_code(val_node, env, &code2, 0, var_num, 0)) { - if (!key_already_exists) env_delete(env, name->symbol); - return 0; - } - - MalType *temp_code = mal_sprintf("env_set(%S, %s, bubble_if_error(%S))", env_name, name_str, code2.body); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_do_code(MalType *list, MalEnv *env, struct codegen *code, int ret, int *var_num) { - struct list_or_vector_iter *iter; - struct codegen code2; - MalType *node, *temp_decl, *temp_code; - int is_last = 0; - for (iter = list_or_vector_iter(list); iter; iter = list_or_vector_iter_next(iter)) { - temp_decl = mal_string(""); - temp_code = mal_string(""); - node = list_or_vector_iter_get_obj(iter); - is_last = list_or_vector_iter_is_last(iter); - code2 = (struct codegen){ code->top, temp_decl, temp_code }; - if (is_last) { - if (!gen_continuation_code("do", node, env, &code2, ret, ret, var_num)) { - return 0; - } - } else { - if (!gen_code(node, env, &code2, 0, var_num, 0)) { - return 0; - } - } - if (is_last) { - append_code(code->decl, temp_decl, 0); - append_code(code->body, temp_code, 0); - } else { - mal_string_append(temp_code, ";\n "); - append_code(code->decl, temp_decl, 0); - append_code(code->decl, temp_code, 0); - } - } - return 1; -} - -int gen_fn_code(MalType *fn_name, MalType *node, MalEnv *env, struct codegen *code, int *var_num, int new_env) { - MalType *args = mal_car(node); - size_t arg_count = list_or_vector_len(args); - - // function header - MalType *temp_fn = mal_sprintf("MalType* %S(MalEnv *env, size_t argc, MalType **args) {\n ", fn_name); - - // inner env - MalEnv *inner_env; - MalType *inner_env_name; - if (new_env) { - inner_env = build_env(env); - inner_env->num = (*var_num)++; - inner_env_name = build_env_name(inner_env); - mal_string_append_mal_string(temp_fn, mal_sprintf("MalEnv *%S = build_env(env);\n ", inner_env_name)); - } else { - inner_env = env; - inner_env_name = build_env_name(env); - mal_string_append_mal_string(temp_fn, mal_sprintf("MalEnv *%S = env;\n ", inner_env_name)); - } - - // arity check - int more_pos = list_or_vector_index_of(args, mal_symbol("&")); - if (more_pos == -1) { - mal_string_append_mal_string( - temp_fn, - mal_sprintf("mal_assert(argc == %i, \"Arity mismatch.\");\n ", arg_count) - ); - } else { - mal_string_append_mal_string( - temp_fn, - mal_sprintf("mal_assert(argc >= %i, \"Arity mismatch.\");\n ", more_pos) - ); - } - - // set arguments in inner env - if (arg_count > 0) { - struct list_or_vector_iter *iter; - MalType *arg; - size_t index = 0; - int is_more = 0; - for (iter = list_or_vector_iter(args); iter; iter = list_or_vector_iter_next(iter)) { - arg = list_or_vector_iter_get_obj(iter); - assert(is_symbol(arg)); - if (strcmp("&", arg->symbol) == 0) { - is_more = 1; - continue; - } - if (is_more) { - // accumulate remaining args in a list - char *more_name = arg->symbol; - mal_string_append(temp_fn, "MalType *rest_args = mal_vector();\n "); - mal_string_append_mal_string( - temp_fn, - mal_sprintf("for(size_t arg_i=%z; arg_isymbol), 1), - index - ) - ); - env_set(inner_env, arg->symbol, mal_true()); - index++; - } - } - } - - // function body - MalType *fn_decl = mal_string(""); - MalType *fn_code = mal_string(""); - struct codegen code2 = (struct codegen){ code->top, fn_decl, fn_code }; - MalType *fn_body = mal_cdr(node); - assert(!is_empty(fn_body)); - if (!gen_code(mal_car(fn_body), inner_env, &code2, 1, var_num, 0)) { - return 0; - } - append_code(temp_fn, fn_decl, 0); - append_code(temp_fn, fn_code, 0); - - // closing brace - mal_string_append(temp_fn, "\n}\n\n"); - append_code(code->top, temp_fn, 0); - - return 1; -} - -int gen_hashmap_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - int len = mal_hashmap_size(node); - if (len == 0) { - append_code(code->body, mal_string("mal_hashmap()"), ret); - return 1; - } - - MalType *var_name = next_var_name("var", var_num); - MalType *temp_code = mal_string("MalType *"); - mal_string_append_mal_string(temp_code, var_name); - mal_string_append(temp_code, " = mal_hashmap();\n "); - - struct hashmap_iter *iter; - struct codegen code2; - char *key_str; - MalType *val; - for (iter = hashmap_iter(&node->hashmap); iter; iter = hashmap_iter_next(&node->hashmap, iter)) { - key_str = (char*)hashmap_iter_get_key(iter); - val = (MalType*)hashmap_iter_get_data(iter); - mal_string_append(temp_code, "mal_hashmap_put("); - mal_string_append_mal_string(temp_code, var_name); - mal_string_append(temp_code, ", "); - code2 = (struct codegen){ code->top, code->decl, temp_code }; - if (!gen_code(read_str(key_str), env, &code2, 0, var_num, 0)) { - return 0; - } - mal_string_append(temp_code, ", "); - code2 = (struct codegen){ code->top, code->decl, temp_code }; - if (!gen_code(val, env, &code2, 0, var_num, 0)) { - return 0; - } - mal_string_append(temp_code, ");\n "); - } - - append_code(code->decl, temp_code, 0); - append_code(code->body, var_name, ret); - return 1; -} - -int gen_if_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *cond_code = mal_string(""); - struct codegen code2 = (struct codegen){ code->top, code->decl, cond_code }; - if (!gen_code(mal_car(node), env, &code2, 0, var_num, 0)) { - return 0; - } - node = mal_cdr(node); - MalType *true_code = mal_string(""); - code2.body = true_code; - MalType *true_val = mal_car(node); - if (is_primitive(true_val)) { - if (!gen_code(true_val, env, &code2, 0, var_num, 0)) { - return 0; - } - } else { - if (!gen_continuation_code("if_true", true_val, env, &code2, 0, ret, var_num)) { - return 0; - } - } - node = mal_cdr(node); - MalType *false_code = mal_string(""); - code2.body = false_code; - MalType *false_val; - if (is_empty(node)) { - false_val = mal_nil(); - } else { - false_val = mal_car(node); - } - if (is_primitive(false_val)) { - if (!gen_code(false_val, env, &code2, 0, var_num, 0)) { - return 0; - } - } else { - if (!gen_continuation_code("if_false", false_val, env, &code2, 0, ret, var_num)) { - return 0; - } - } - append_code( - code->body, - mal_sprintf("is_truthy(%S) ? %S : %S", cond_code, true_code, false_code), - ret - ); - return 1; -} - -int gen_keyword_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_keyword(%s)", pr_str(mal_string(node->keyword), 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_lambda_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("(MalType*)%p /* %s */", node, pr_str(node, 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_let_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalEnv *inner_env = build_env(env); - inner_env->num = (*var_num)++; - MalType *outer_env_name = build_env_name(env); - MalType *inner_env_name = build_env_name(inner_env); - MalType *temp_code = mal_sprintf("MalEnv *%S = build_env(%S);\n ", inner_env_name, outer_env_name); - append_code(code->decl, temp_code, 0); - - temp_code = mal_string(""); - - struct list_or_vector_iter *iter; - struct codegen code2; - MalType *name, *val, *inner_decl, *val_code; - for (iter = list_or_vector_iter(mal_car(node)); iter; iter = list_or_vector_iter_next(iter)) { - inner_decl = mal_string(""); - name = list_or_vector_iter_get_obj(iter); - assert(is_symbol(name)); - iter = list_or_vector_iter_next(iter); - val = list_or_vector_iter_get_obj(iter); - env_set(inner_env, name->symbol, mal_true()); - code2 = (struct codegen){ code->top, inner_decl, mal_string("") }; - if (!gen_code(val, inner_env, &code2, 0, var_num, 0)) { - return 0; - } - val_code = mal_sprintf("env_set(%S, %s, %S);\n ", inner_env_name, pr_str(mal_string(name->symbol), 1), code2.body); - mal_string_append_mal_string(temp_code, inner_decl); - mal_string_append_mal_string(temp_code, val_code); - } - - append_code(code->decl, temp_code, 0); - - node = mal_cdr(node); - if (!gen_continuation_code("let", mal_car(node), inner_env, code, ret, ret, var_num)) { - return 0; - } - - return 1; -} - -int gen_list_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num, int quoting) { - MalType *list_name = next_var_name("list", var_num); - MalType *temp_decl = mal_sprintf("MalType *%S = mal_vector();\n ", list_name); - struct list_or_vector_iter *iter; - MalType *item; - struct codegen code2; - for (iter = list_or_vector_iter(node); iter; iter = list_or_vector_iter_next(iter)) { - item = list_or_vector_iter_get_obj(iter); - mal_string_append_mal_string( - temp_decl, - mal_sprintf("mal_vector_push(%S, ", list_name) - ); - code2 = (struct codegen){ code->top, code->decl, temp_decl }; - if (!gen_code(item, env, &code2, 0, var_num, quoting)) { - return 0; - } - mal_string_append(temp_decl, ");\n "); - } - append_code(code->decl, temp_decl, 0); - append_code(code->body, mal_sprintf("mal_vector_to_list(%S)", list_name), ret); - return 1; -} - -int gen_load_file(MalType *filename_node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *contents = core_slurp(env, 1, &filename_node); - MalType *ast = read_str(mal_sprintf("(do %S)", contents)->str); - return gen_code(ast, env, code, ret, var_num, 0); -} - -int gen_number_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_number(%s)", pr_str(node, 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_string_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_string(%s)", pr_str(node, 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_symbol_code(MalType *node, struct codegen *code, int ret) { - MalType *temp_code = mal_sprintf("mal_symbol(%s)", pr_str(mal_string(node->symbol), 1)); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_symbol_lookup_code(MalType *node, MalEnv *env, struct codegen *code, int ret) { - UNUSED(env); - MalType *temp_code = mal_sprintf( - "bubble_if_error(env_get(%S, %s))", - build_env_name(env), - pr_str(mal_string(node->symbol), 1) - ); - append_code(code->body, temp_code, ret); - return 1; -} - -int gen_try_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *try_expr = mal_car(node); // (A (catch* B C)) - MalType *catch_node_list = mal_cdr(node); // ((catch* B C)) - if (is_empty(catch_node_list)) { - return gen_code(try_expr, env, code, ret, var_num, 0); - } - MalType *try_as_lambda_expr = mal_cons( - mal_empty(), // fn args (none) - mal_cons(try_expr, mal_empty()) // fn body - ); - MalType *try_fn_name = next_var_name("try", var_num); - if (!gen_fn_code(try_fn_name, try_as_lambda_expr, env, code, var_num, 1)) { - return 0; - } - MalType *catch_node = mal_car(catch_node_list); // (catch* B C) - assert(is_cons(catch_node)); - MalType *catch_sym = mal_car(catch_node); // catch* - assert(is_symbol(catch_sym) && strcmp(catch_sym->symbol, "catch*") == 0); - MalType *arg_name = mal_car(mal_cdr(catch_node)); // B - assert(is_symbol(arg_name)); - MalType *catch_expr = mal_car(mal_cdr(mal_cdr(catch_node))); // C - MalType *catch_fn_name = next_var_name("catch", var_num); - MalType *catch_as_lambda_expr = mal_cons( - mal_cons(arg_name, mal_empty()), // fn arg - mal_cons(catch_expr, mal_empty()) // fn body - ); - if (!gen_fn_code(catch_fn_name, catch_as_lambda_expr, env, code, var_num, 1)) { - return 0; - } - MalType *result_name = next_var_name("try_result", var_num); - MalType *try_call_code = mal_sprintf("trampoline(mal_continuation_0(%S, %S))", try_fn_name, build_env_name(env)); - MalType *catch_call_code = mal_sprintf("mal_continuation_1(%S, %S, %S->error_val)", catch_fn_name, build_env_name(env), result_name); - if (!ret) { - catch_call_code = mal_sprintf("trampoline(%S)", catch_call_code); - } - mal_string_append_mal_string( - code->decl, - mal_sprintf("MalType *%S = %S;\n ", result_name, try_call_code) - ); - append_code( - code->body, - mal_sprintf("is_error(%S) ? %S : %S", result_name, catch_call_code, result_name), - ret - ); - return 1; -} - -int gen_vector_code(MalType *node, MalEnv *env, struct codegen *code, int ret, int *var_num) { - MalType *var_name = next_var_name("var", var_num); - MalType *temp_code = mal_string("MalType *"); - mal_string_append_mal_string(temp_code, var_name); - mal_string_append(temp_code, " = mal_vector();\n "); - struct codegen code2; - for(size_t i=0; itop, code->decl, temp_code }; - if (!gen_code(mal_vector_ref(node, i), env, &code2, 0, var_num, 0)) { - return 0; - } - mal_string_append(temp_code, ");\n "); - } - append_code(code->decl, temp_code, 0); - append_code(code->body, var_name, ret); - return 1; -} - -MalType* quasiquote(MalType *node) { - if (!is_pair(node)) { - return mal_cons(mal_symbol("quote"), mal_cons(node, mal_empty())); - } else if (is_symbol(mal_car2(node)) && strcmp(mal_car2(node)->symbol, "unquote") == 0) { - return mal_car2(mal_cdr2(node)); - } else if (is_pair(mal_car2(node)) && is_symbol(mal_car2(mal_car2(node))) && strcmp(mal_car2(mal_car2(node))->symbol, "splice-unquote") == 0) { - return mal_cons( - mal_symbol("concat"), - mal_cons( - mal_car2(mal_cdr2(mal_car2(node))), - mal_cons( - quasiquote(mal_cdr2(node)), - mal_empty() - ) - ) - ); - } else { - return mal_cons( - mal_symbol("cons"), - mal_cons( - quasiquote(mal_car2(node)), - mal_cons( - quasiquote(mal_cdr2(node)), - mal_empty() - ) - ) - ); - } -} - -int is_macro_call(MalType *node, MalEnv *env) { - if (!is_cons(node)) { - return 0; - } - MalType *sym = mal_car(node); - if (!is_symbol(sym)) { - return 0; - } - MalType *macro = env_get(env, sym->symbol); - if (macro && macro->is_macro) { - return 1; - } else { - return 0; - } -} - -void defmacro(MalType *node, MalEnv *env) { - int var_num = 1; - MalType* (*EVAL)(MalEnv *env); - MalType *name = mal_car(node); - assert(is_symbol(name)); - node = mal_car(mal_cdr(node)); - if (!compile_eval(node, env, &var_num, &EVAL)) { - printf("Error compiling macro.\n"); - exit(1); - } - MalType *macro = trampoline(EVAL(env)); - macro->is_macro = 1; - env_set(env, name->symbol, macro); -} - -void inspect_env(MalEnv *env) { - char *key_str, *val_str; - struct hashmap_iter *iter; - for (iter = hashmap_iter(&env->data); iter; iter = hashmap_iter_next(&env->data, iter)) { - key_str = (char*)hashmap_iter_get_key(iter); - val_str = pr_str((MalType*)hashmap_iter_get_data(iter), 1); - printf("%s=%s\n", key_str, val_str); - } -} - -MalType* macroexpand(MalType *ast, MalEnv *env) { - MalType *name, *macro, *arg_list, **args; - size_t argc; - while (is_macro_call(ast, env)) { - name = mal_car(ast); - macro = env_get(env, name->symbol); - arg_list = mal_cdr(ast); - argc = mal_list_len(arg_list); - if (argc > 0) { - args = GC_MALLOC(sizeof(MalType*) * argc); - for (size_t i=0; ifn, macro->env, argc, args)); - assert(ast != NULL); - } - return ast; -} - -void append_code(MalType *code, MalType *temp_code, int ret) { - if (ret) mal_string_append(code, "return "); - mal_string_append_mal_string(code, temp_code); - if (ret) mal_string_append(code, ";"); -} - -MalType* next_var_name(char *base, int *var_num) { - MalType *var_name = mal_string(base); - mal_string_append_long_long(var_name, (*var_num)++); - return var_name; -} - -MalType* build_env_name(MalEnv *env) { - MalType *name = mal_string("env"); - mal_string_append_long_long(name, env->num); - return name; -} - -char* PRINT(MalType *ast) { - return pr_str(ast, 2); -} - -char* rep(char *str, MalEnv *repl_env) { - MalType *result = EVAL(READ(str), repl_env); - if (is_error(result)) { - return PRINT(mal_sprintf("ERROR: %s\n", pr_str(result->error_val, 0))); - } else { - return PRINT(result); - } -} - -char *parent_directory(char *bin_path) { - char *path = string(bin_path); - size_t len; - while ((len = strlen(path)) > 0 && path[len - 1] != '/') { - path[len - 1] = 0; - } - if (len > 0) path[len - 1] = 0; - if (strlen(path) == 0) { - return string("."); - } else { - return path; - } -} - -int main(int argc, char *argv[]) { - PATH = parent_directory(argv[0]); - - MalEnv *repl_env = build_top_env(); - - struct hashmap *ns = core_ns(); - struct hashmap_iter *core_iter; - char *name; - MalType* (*fn)(MalEnv*, size_t, MalType**); - for (core_iter = hashmap_iter(ns); core_iter; core_iter = hashmap_iter_next(ns, core_iter)) { - name = (char*)hashmap_iter_get_key(core_iter); - fn = hashmap_iter_get_data(core_iter); - env_set(repl_env, name, mal_builtin_function(fn, name, repl_env)); - } - env_set(repl_env, "eval", mal_builtin_function(user_eval, "eval", repl_env)); - - MalType *arg_list = mal_vector(); - for (int i=2; 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))))))))", - pr_str(arg_list, 1) - )->str, - repl_env - ); - - if (argc > 1) { - rep(mal_sprintf("(load-file %s)", pr_str(mal_string(argv[1]), 1))->str, repl_env); - } else { - rep("(println (str \"Mal [\" *host-language* \"]\"))", repl_env); - char *buffer; - read_history("history.txt"); - while ((buffer = readline("user> ")) != NULL) { - printf("%s\n", rep(buffer, repl_env)); - if (strlen(buffer) > 0) { - add_history(buffer); - } - free(buffer); - } - write_history("history.txt"); - } - - return 0; -} diff --git a/tests/regex.mal b/tests/regex.mal deleted file mode 100644 index b3aa5c6..0000000 --- a/tests/regex.mal +++ /dev/null @@ -1,49 +0,0 @@ -;;; -;;; Supplemental malcc test for regex support -;;; - -;; Testing that the reader understands regex literals -/regex/ -;=>/regex/ -/escaped \/ slash/ -;=>/escaped \/ slash/ -(regex? /foo/) -;=>true -(regex? / foo /) -;=>true -(regex? "foo") -;=>false -(regex? /) -;=>false - -;; Not to be confused with the division function -/ -;=> -(/ 6 2) -;=>3 -(/ 6 (/ 4 2)) -;=>3 -(/ 6 (/ 4 (/ 2 1))) -;=>3 - -;; Testing that matching works -(regex-match /foo/ "foo") -;=>0 -(regex-match /foo/ "foofoo") -;=>0 -(regex-match /bar/ "foobar") -;=>3 -(regex-match /foo/ "foobar") -;=>0 -(regex-match /^foo/ "foobar") -;=>0 -(regex-match /^foo$/ "foobar") -;=>nil -(regex-match /foo/ "bar") -;=>nil - -;; Testing that regex is callable (calls regex-match under the hood) -(/foo/ "foo") -;=>0 -(/foo/ "bar") -;=>nil diff --git a/tests/utf-8.mal b/tests/utf-8.mal deleted file mode 100644 index 5a99233..0000000 --- a/tests/utf-8.mal +++ /dev/null @@ -1,37 +0,0 @@ -;;; -;;; Supplemental malcc test for unicode support -;;; - -;; Testing that (seq str) doesn't split 2-byte utf-8 characters in the middle -(first (seq "ă")) -;=>"ă" - -;; Testing that (seq str) doesn't split 3-byte utf-8 characters in the middle -(first (seq "€")) -;=>"€" - -;; Testing that (seq str) doesn't split 4-byte utf-8 characters in the middle -(first (seq "🙅")) -;=>"🙅" - -;; Testing that splitting and re-joining multibyte characters does not change anything -(apply str (seq "\xf0\x9f\xa4\xb7\xf0\x9f\x99\x8e")) -;=>"🤷🙎" - -;; Testing that escaped hex escape sequences are intepreted -"\xf0\x9f\xa4\xb7\xf0\x9f\x99\x8e" -;=>"🤷🙎" - -;; Testing that incomplete hex escape sequence produces an error -"\xf" -;/.*Invalid escape sequence in string.* - -;; Testing that (seq str) splits emoji modifiers apart from emoji base -(first (seq "\xf0\x9f\xa4\xb7\xf0\x9f\x8f\xbf\xe2\x80\x8d\xe2\x99\x80\xef\xb8\x8f")) -;=>"🤷" -(first (rest (seq "\xf0\x9f\xa4\xb7\xf0\x9f\x8f\xbf\xe2\x80\x8d\xe2\x99\x80\xef\xb8\x8f"))) -;=>"🏿" - -;; Testing that splitting on incomplete utf-8 encodings produce an error -(seq "\xf0\x9f\xa4") -;/.*Invalid utf-8 encoding in string.* diff --git a/tinycc b/tinycc deleted file mode 160000 index d348a9a..0000000 --- a/tinycc +++ /dev/null @@ -1 +0,0 @@ -Subproject commit d348a9a51d32cece842b7885d27a411436d7887b diff --git a/types.c b/types.c deleted file mode 100644 index 72e7b5c..0000000 --- a/types.c +++ /dev/null @@ -1,631 +0,0 @@ -#include -#include -#include -#include -#include -#include - -#include "hashmap.h" -#include "printer.h" -#include "reader.h" -#include "types.h" -#include "util.h" - -MalType* mal_alloc() { - MalType *val = GC_MALLOC(sizeof(MalType)); - val->meta = NULL; - val->is_macro = 0; - return val; -} - -MalType* mal_nil() { - MalType *val = mal_alloc(); - val->type = MAL_NIL_TYPE; - return val; -} - -int is_nil(MalType *val) { - return val->type == MAL_NIL_TYPE; -} - -MalType* mal_empty() { - MalType *val = mal_alloc(); - val->type = MAL_EMPTY_TYPE; - return val; -} - -int is_empty(MalType *val) { - return val->type == MAL_EMPTY_TYPE; -} - -MalType* mal_true() { - MalType *val = mal_alloc(); - val->type = MAL_TRUE_TYPE; - return val; -} - -MalType* mal_false() { - MalType *val = mal_alloc(); - val->type = MAL_FALSE_TYPE; - return val; -} - -MalType* mal_cons(MalType *car, MalType *cdr) { - MalType *val = mal_alloc(); - val->type = MAL_CONS_TYPE; - val->car = car; - val->cdr = cdr; - return val; -} - -MalType* mal_car(MalType *val) { - assert(is_cons(val)); - return val->car; -} - -MalType* mal_cdr(MalType *val) { - assert(is_cons(val)); - return val->cdr; -} - -MalType* mal_car2(MalType *val) { - assert(is_cons(val) || is_vector(val)); - if (is_cons(val)) { - return val->car; - } else { - return val->vec[0]; - } -} - -MalType* mal_cdr2(MalType *val) { - assert(is_cons(val) || is_vector(val)); - if (is_cons(val)) { - return val->cdr; - } else { - MalType *rest = mal_empty(); - for (int i=mal_vector_len(val)-1; i>=1; i--) { - rest = mal_cons(mal_vector_ref(val, i), rest); - } - return rest; - } -} - -size_t mal_list_len(MalType *val) { - if (is_empty(val)) return 0; - assert(is_cons(val)); - size_t len = 1; - MalType *cell = val; - while (!is_empty(cell = mal_cdr(cell))) { - len++; - } - return len; -} - -MalType* mal_list_ref(MalType *val, size_t index) { - assert(is_cons(val)); - struct list_or_vector_iter *iter; - size_t i = 0; - for (iter = list_or_vector_iter(val); iter; iter = list_or_vector_iter_next(iter)) { - if (i == index) { - return list_or_vector_iter_get_obj(iter); - } - i++; - } - assert(0 && "index out of range"); -} - - -#define STRING_GROW_FACTOR 2 - -MalType* mal_string(char *str) { - MalType *val = mal_alloc(); - size_t len = strlen(str); - val->type = MAL_STRING_TYPE; - val->str_len = len; - val->str_cap = len; - val->str = GC_MALLOC(len + 1); - snprintf(val->str, len + 1, "%s", str); - return val; -} - -void mal_grow_string(MalType *val, size_t capacity) { - size_t len = strlen(val->str); - assert(capacity >= len); - val->str = GC_REALLOC(val->str, capacity + 1); - val->str_cap = capacity; -} - -void mal_grow_string_at_least(MalType *val, size_t min_capacity) { - size_t capacity = val->str_cap; - if (capacity >= min_capacity) return; - if (capacity > 0 && min_capacity <= capacity * STRING_GROW_FACTOR) { - mal_grow_string(val, capacity * STRING_GROW_FACTOR); - } else { - mal_grow_string(val, min_capacity); - } -} - -void mal_string_append(MalType *val, char *str) { - assert(is_string(val)); - size_t new_len = strlen(str); - if (new_len == 0) return; - size_t total_len = val->str_len + new_len; - mal_grow_string_at_least(val, total_len); - strcat(val->str, str); - val->str_len = total_len; - assert(strlen(val->str) == val->str_len); -} - -void mal_string_append_mal_string(MalType *val, MalType *str) { - assert(strlen(str->str) == str->str_len); - mal_string_append(val, str->str); -} - -void mal_string_append_long_long(MalType *val, long long n) { - return mal_string_append(val, long_long_to_string(n)); -} - -void mal_string_append_char(MalType *val, char c) { - assert(is_string(val)); - size_t total_len = val->str_len + 1; - mal_grow_string_at_least(val, total_len); - val->str[total_len - 1] = c; - val->str[total_len] = 0; - val->str_len = total_len; -} - -MalType* mal_string_replace(MalType *orig, char *find, char *replace) { - char *pos = strstr(orig->str, find); - assert(pos); - size_t index = pos - orig->str; - size_t find_len = strlen(find); - char *before = substring(orig->str, 0, index); - char *after = substring(orig->str, index + find_len, orig->str_len - (index + find_len)); - MalType *final = mal_string(before); - mal_string_append(final, replace); - mal_string_append(final, after); - return final; -} - -MalType* mal_string_replace_all(MalType *orig, char *find, char *replace) { - MalType *final = mal_string(""); - char *pos = NULL; - char *str = orig->str, *before; - size_t find_len = strlen(find); - while ((pos = strstr(str, find))) { - size_t index = pos - str; - before = substring(str, 0, index); - mal_string_append(final, before); - mal_string_append(final, replace); - str = str + index + find_len; - } - mal_string_append(final, str); - return final; -} - -char* mal_string_substring(MalType *orig, size_t start, size_t len) { - assert(start < orig->str_len); - assert(start + len <= orig->str_len); - char *buffer = GC_MALLOC(len + 1); - snprintf(buffer, len + 1, "%s", orig->str + start); - return buffer; -} - -MalType* mal_string_to_list(MalType *orig) { - assert(is_string(orig)); - MalType *vec = mal_vector(); - char buffer[5]; - for (size_t i=0; istr_len; i++) { - buffer[0] = orig->str[i]; - if (((unsigned char)buffer[0] >> 3) == 30) { // 11110xxx, 4 bytes - if (i + 3 >= orig->str_len) return mal_error(mal_string("Invalid utf-8 encoding in string")); - buffer[1] = orig->str[++i]; - buffer[2] = orig->str[++i]; - buffer[3] = orig->str[++i]; - buffer[4] = 0; - } else if (((unsigned char)buffer[0] >> 4) == 14) { // 1110xxxx, 3 bytes - if (i + 2 >= orig->str_len) return mal_error(mal_string("Invalid utf-8 encoding in string")); - buffer[1] = orig->str[++i]; - buffer[2] = orig->str[++i]; - buffer[3] = 0; - } else if (((unsigned char)buffer[0] >> 5) == 6) { // 110xxxxx, 2 bytes - if (i + 1 >= orig->str_len) return mal_error(mal_string("Invalid utf-8 encoding in string")); - buffer[1] = orig->str[++i]; - buffer[2] = 0; - } else { - buffer[1] = 0; - } - mal_vector_push(vec, mal_string(buffer)); - } - return mal_vector_to_list(vec); -} - -MalType* mal_regex(char *str) { - MalType *val = mal_alloc(); - size_t len = strlen(str); - val->type = MAL_REGEX_TYPE; - val->regex_len = len; - val->regex = GC_MALLOC(len + 1); - snprintf(val->regex, len + 1, "%s", str); - return val; -} - -#define VECTOR_INIT_SIZE 10 -#define VECTOR_GROW_FACTOR 2 - -MalType* mal_vector() { - MalType *val = mal_alloc(); - val->type = MAL_VECTOR_TYPE; - val->vec_len = 0; - val->vec_cap = VECTOR_INIT_SIZE; - val->vec = GC_MALLOC(sizeof(MalType*) * val->vec_cap); - return val; -} - -size_t mal_vector_len(MalType *val) { - assert(is_vector(val)); - return val->vec_len; -} - -MalType* mal_vector_ref(MalType *val, size_t index) { - assert(is_vector(val)); - return val->vec[index]; -} - -void mal_vector_push(MalType *vector, MalType *value) { - assert(is_vector(vector)); - size_t capacity = vector->vec_cap; - size_t len = mal_vector_len(vector); - if (len >= capacity) { - vector->vec_cap *= VECTOR_GROW_FACTOR; - vector->vec = GC_REALLOC(vector->vec, sizeof(MalType*) * vector->vec_cap); - } - vector->vec_len++; - vector->vec[len] = value; -} - -MalType* mal_vector_to_list(MalType *val) { - int len = mal_vector_len(val); - MalType *cell = mal_empty(); - for (int i=len-1; i>=0; i--) { - cell = mal_cons(mal_vector_ref(val, i), cell); - } - return cell; -} - -MalType* mal_vector_range(MalType *vec, int start, int stop_exclusive) { - int len = mal_vector_len(vec); - if (stop_exclusive == -1 || stop_exclusive > len) stop_exclusive = len; - MalType *new_vec = mal_vector(); - for (int i=start; itype = MAL_HASHMAP_TYPE; - hashmap_init(&val->hashmap, hashmap_hash_string, hashmap_compare_string, HASHMAP_INIT_SIZE); - hashmap_set_key_alloc_funcs(&val->hashmap, hashmap_alloc_key_string, NULL); - return val; -} - -MalType* mal_hashmap_get(MalType *map, MalType *key) { - assert(is_hashmap(map)); - return hashmap_get(&map->hashmap, pr_str(key, 1)); -} - -void mal_hashmap_put(MalType *map, MalType *key, MalType *val) { - assert(is_hashmap(map)); - char *key_str = pr_str(key, 1); - hashmap_remove(&map->hashmap, key_str); - hashmap_put(&map->hashmap, key_str, (void*)val); -} - -void mal_hashmap_remove(MalType *map, MalType *key) { - assert(is_hashmap(map)); - hashmap_remove(&map->hashmap, pr_str(key, 1)); -} - -size_t mal_hashmap_size(MalType *map) { - assert(is_hashmap(map)); - return hashmap_size(&map->hashmap); -} - -MalType* mal_hashmap_keys_to_vector(MalType *map) { - assert(is_hashmap(map)); - MalType *keys_vec = mal_vector(); - struct hashmap_iter *iter; - MalType *key; - for (iter = hashmap_iter(&map->hashmap); iter; iter = hashmap_iter_next(&map->hashmap, iter)) { - key = read_str((char*)hashmap_iter_get_key(iter)); - mal_vector_push(keys_vec, key); - } - return keys_vec; -} - -MalType* mal_keyword(char *name) { - MalType *val = mal_alloc(); - val->type = MAL_KEYWORD_TYPE; - val->keyword = name; - return val; -} - -MalType* mal_number(long long number) { - MalType *val = mal_alloc(); - val->type = MAL_NUMBER_TYPE; - val->number = number; - return val; -} - -MalType* mal_symbol(char *name) { - MalType *val = mal_alloc(); - val->type = MAL_SYMBOL_TYPE; - val->symbol = string(name); - return val; -} - -MalType* mal_closure(MalType* (*fn)(MalEnv *env, size_t argc, MalType **args), MalEnv *env) { - MalType *val = mal_alloc(); - val->type = MAL_LAMBDA_TYPE; - val->fn = fn; - val->function_name = NULL; - val->env = env; - val->argc = 0; - val->args = NULL; - val->is_macro = 0; - return val; -} - -MalType* mal_builtin_function(MalType* (*fn)(MalEnv *env, size_t argc, MalType **args), char *function_name, MalEnv *env) { - MalType *val = mal_alloc(); - val->type = MAL_LAMBDA_TYPE; - val->fn = fn; - val->function_name = function_name; - val->env = env; - val->argc = 0; - val->args = NULL; - val->is_macro = 0; - return val; -} - -MalType* mal_continuation(MalType* (*fn)(MalEnv *env, size_t argc, MalType **args), MalEnv *env, size_t argc, MalType **args) { - MalType *val = mal_alloc(); - val->type = MAL_CONTINUATION_TYPE; - val->fn = fn; - val->function_name = NULL; - val->env = env; - val->argc = argc; - val->args = args; - val->is_macro = 0; - return val; -} - -MalType* mal_continuation_0(MalType* (*fn)(MalEnv *env, size_t argc, MalType **args), MalEnv *env) { - return mal_continuation(fn, env, 0, NULL); -} - -MalType* mal_continuation_1(MalType* (*fn)(MalEnv *env, size_t argc, MalType **args), MalEnv *env, MalType *arg) { - MalType **args = GC_MALLOC(sizeof(MalType*) * 1); - args[0] = arg; - return mal_continuation(fn, env, 1, args); -} - -MalType* mal_atom(MalType *inner_val) { - MalType *val = mal_alloc(); - val->type = MAL_ATOM_TYPE; - val->atom_val = inner_val; - return val; -} - -MalType* mal_blank_line() { - MalType *val = mal_alloc(); - val->type = MAL_BLANK_LINE_TYPE; - return val; -} - -MalType* mal_error(MalType *inner_val) { - MalType *val = mal_alloc(); - val->type = MAL_ERROR_TYPE; - val->error_val = inner_val; - return val; -} - -size_t list_or_vector_len(MalType *obj) { - assert(is_empty(obj) || is_cons(obj) || is_vector(obj)); - if (is_empty(obj)) { - return 0; - } else if (is_cons(obj)) { - return mal_list_len(obj); - } else { - return mal_vector_len(obj); - } -} - -struct list_or_vector_iter* list_or_vector_iter(MalType *obj) { - assert(is_list_like(obj)); - if (is_empty(obj) || (obj->type == MAL_VECTOR_TYPE && obj->vec_len == 0)) return NULL; - struct list_or_vector_iter *iter = GC_MALLOC(sizeof(struct list_or_vector_iter)); - iter->cell = obj; - if (is_cons(obj)) { - iter->type = LIST_ITER; - } else { - iter->type = VECTOR_ITER; - iter->len = obj->vec_len; - iter->i = 0; - } - return iter; -} - -struct list_or_vector_iter* list_or_vector_iter_next(struct list_or_vector_iter *iter) { - if (!iter) { - return NULL; - } else if (iter->type == LIST_ITER) { - iter->cell = mal_cdr(iter->cell); - if (!iter->cell || is_empty(iter->cell)) return NULL; - } else { - if (iter->i+1 >= iter->len) { - return NULL; - } - iter->i++; - } - return iter; -} - -int list_or_vector_iter_is_last(struct list_or_vector_iter *iter) { - if (!iter) { - return 0; - } else if (iter->type == LIST_ITER) { - return is_empty(mal_cdr(iter->cell)); - } else { - return iter->i+2 >= iter->len; - } -} - -MalType* list_or_vector_iter_get_obj(struct list_or_vector_iter *iter) { - if (!iter) { - return NULL; - } else if (iter->type == LIST_ITER) { - return iter->cell ? mal_car(iter->cell) : NULL; - } else { - return iter->i < iter->len ? mal_vector_ref(iter->cell, iter->i) : NULL; - } -} - -int list_or_vector_index_of(MalType *list, MalType *val) { - MalType *item; - struct list_or_vector_iter *iter; - int index = 0; - for (iter = list_or_vector_iter(list); iter; iter = list_or_vector_iter_next(iter)) { - item = list_or_vector_iter_get_obj(iter); - if (is_equal(item, val)) { - return index; - } - index++; - } - return -1; -} - -MalType* mal_sprintf(char *format, ...) { - MalType *out = mal_string(""); - char c, c2; - size_t len = strlen(format); - va_list ap; - va_start(ap, format); - va_end(ap); - for (size_t i=0; itype != arg2->type) { - return 0; - } - switch (arg1->type) { - case MAL_EMPTY_TYPE: - case MAL_FALSE_TYPE: - case MAL_NIL_TYPE: - case MAL_TRUE_TYPE: - return 1; - case MAL_HASHMAP_TYPE: - return hashmap_is_equal(arg1, arg2); - case MAL_KEYWORD_TYPE: - return strcmp(arg1->keyword, arg2->keyword) == 0; - case MAL_NUMBER_TYPE: - return arg1->number == arg2->number; - case MAL_STRING_TYPE: - return strcmp(arg1->str, arg2->str) == 0; - case MAL_SYMBOL_TYPE: - return strcmp(arg1->symbol, arg2->symbol) == 0; - default: - return 0; - } -} - -int list_or_vector_is_equal(MalType *arg1, MalType *arg2) { - assert(is_list_like(arg1) && is_list_like(arg2)); - struct list_or_vector_iter *iter1 = list_or_vector_iter(arg1), - *iter2 = list_or_vector_iter(arg2); - MalType *item1, *item2; - if (!iter1 && !iter2) { - return 1; // both empty - } - do { - item1 = list_or_vector_iter_get_obj(iter1); - item2 = list_or_vector_iter_get_obj(iter2); - if (!item1 || !item2 || !is_equal(item1, item2)) { - return 0; - } - iter1 = list_or_vector_iter_next(iter1); - iter2 = list_or_vector_iter_next(iter2); - } while(iter1 && iter2); - if (iter1 || iter2) { - return 0; // one of the lists still has items - } - return 1; -} - -int hashmap_is_equal(MalType *map1, MalType *map2) { - assert(is_hashmap(map1) && is_hashmap(map2)); - if (mal_hashmap_size(map1) != mal_hashmap_size(map2)) { - return 0; - } - MalType *keys1 = mal_hashmap_keys_to_vector(map1); - MalType *keys2 = mal_hashmap_keys_to_vector(map2); - if (!list_or_vector_is_equal(keys1, keys2)) { - return 0; - } - MalType *key, *val1, *val2; - for (size_t i=0; ivec_len; i++) { - key = keys1->vec[i]; - val1 = mal_hashmap_get(map1, key); - val2 = mal_hashmap_get(map2, key); - if (!is_equal(val1, val2)) { - return 0; - } - } - return 1; -} - -MalType* trampoline(MalType *result) { - while (result->type == MAL_CONTINUATION_TYPE) { - result = (result->fn)(result->env, result->argc, result->args); - } - return result; -} diff --git a/types.h b/types.h deleted file mode 100644 index a46050c..0000000 --- a/types.h +++ /dev/null @@ -1,216 +0,0 @@ -#ifndef __MAL_TYPES__ -#define __MAL_TYPES__ - -#include -#include - -#include "hashmap.h" - -typedef struct MalType MalType; -typedef struct MalEnv MalEnv; - -struct MalEnv { - size_t num; - struct hashmap data; - MalEnv *outer; -}; - -enum MalTypeType { - MAL_NIL_TYPE, - MAL_TRUE_TYPE, - MAL_FALSE_TYPE, - MAL_EMPTY_TYPE, - MAL_CONS_TYPE, - MAL_KEYWORD_TYPE, - MAL_NUMBER_TYPE, - MAL_SYMBOL_TYPE, - MAL_VECTOR_TYPE, - MAL_HASHMAP_TYPE, - MAL_STRING_TYPE, - MAL_REGEX_TYPE, - MAL_LAMBDA_TYPE, - MAL_CONTINUATION_TYPE, - MAL_ATOM_TYPE, - MAL_BLANK_LINE_TYPE, - MAL_ERROR_TYPE -}; - -struct MalType { - enum MalTypeType type; - - union { - long long number; - char *symbol; - char *keyword; - struct hashmap hashmap; - MalType *atom_val; - MalType *error_val; - - // MAL_CONS_TYPE - struct { - MalType *car; - MalType *cdr; - }; - - // MAL_VECTOR_TYPE - struct { - size_t vec_len; - size_t vec_cap; - MalType **vec; - }; - - // MAL_STRING_TYPE - struct { - size_t str_len; - size_t str_cap; - char *str; - }; - - // MAL_REGEX_TYPE - struct { - size_t regex_len; - char *regex; - }; - - // MAL_LAMBDA_TYPE, MAL_CONTINUATION_TYPE - struct { - MalType* (*fn)(MalEnv *env, size_t argc, MalType **args); - char *function_name; - MalEnv *env; - size_t argc; - MalType **args; - }; - }; - - int is_macro; - MalType *meta; -}; - -#define is_primitive(val) ((val)->type == MAL_NIL_TYPE || \ - (val)->type == MAL_FALSE_TYPE || \ - (val)->type == MAL_TRUE_TYPE || \ - (val)->type == MAL_EMPTY_TYPE || \ - (val)->type == MAL_KEYWORD_TYPE || \ - (val)->type == MAL_NUMBER_TYPE || \ - (val)->type == MAL_SYMBOL_TYPE || \ - (val)->type == MAL_STRING_TYPE || \ - (val)->type == MAL_REGEX_TYPE) - -MalType* mal_alloc(); - -MalType* mal_nil(); -int is_nil(MalType *val); - -MalType* mal_empty(); -int is_empty(MalType *val); - -MalType* mal_true(); -MalType* mal_false(); - -#define is_true(val) ((val)->type == MAL_TRUE_TYPE) -#define is_false(val) ((val)->type == MAL_FALSE_TYPE) -#define is_truthy(val) ((val)->type != MAL_NIL_TYPE && (val)->type != MAL_FALSE_TYPE) -#define is_falsey(val) ((val)->type == MAL_NIL_TYPE || (val)->type == MAL_FALSE_TYPE) - -MalType* mal_cons(MalType *car, MalType *cdr); -#define is_cons(val) ((val)->type == MAL_CONS_TYPE) -MalType* mal_car(MalType *val); -MalType* mal_cdr(MalType *val); - -size_t mal_list_len(MalType *val); -MalType* mal_list_ref(MalType *val, size_t index); - -MalType* mal_vector(); -#define is_vector(val) ((val)->type == MAL_VECTOR_TYPE) -size_t mal_vector_len(MalType *vector); -MalType* mal_vector_ref(MalType *val, size_t index); -void mal_vector_push(MalType *vector, MalType *value); -MalType* mal_vector_to_list(MalType *val); -MalType* mal_vector_range(MalType *vec, int start, int stop_exclusive); - -MalType* mal_car2(MalType *val); -MalType* mal_cdr2(MalType *val); - -MalType* mal_hashmap(); -#define is_hashmap(val) ((val)->type == MAL_HASHMAP_TYPE) -MalType* mal_hashmap_get(MalType *map, MalType *key); -void mal_hashmap_put(MalType *map, MalType *key, MalType *val); -void mal_hashmap_remove(MalType *map, MalType *key); -size_t mal_hashmap_size(MalType *map); -MalType* mal_hashmap_keys_to_vector(MalType *map); - -MalType* mal_string(char *str); -#define is_string(val) ((val)->type == MAL_STRING_TYPE) -void mal_grow_string(MalType *val, size_t capacity); -void mal_grow_string_at_least(MalType *val, size_t min_capacity); -void mal_string_append(MalType *val, char *str); -void mal_string_append_mal_string(MalType *val, MalType *str); -void mal_string_append_char(MalType *val, char c); -void mal_string_append_long_long(MalType *val, long long n); -MalType* mal_string_replace(MalType *val, char *find, char *replace); -MalType* mal_string_replace_all(MalType *orig, char *find, char *replace); -MalType* mal_string_to_list(MalType *orig); - -MalType* mal_regex(char *str); -#define is_regex(val) ((val)->type == MAL_REGEX_TYPE) - -MalType* mal_keyword(char *name); -#define is_keyword(val) ((val)->type == MAL_KEYWORD_TYPE) - -MalType* mal_number(long long number); -#define is_number(val) ((val)->type == MAL_NUMBER_TYPE) - -MalType* mal_symbol(char *name); -#define is_symbol(val) ((val)->type == MAL_SYMBOL_TYPE) - -MalType* mal_closure(MalType* (*lambda)(MalEnv *env, size_t argc, MalType **args), MalEnv *env); -MalType* mal_builtin_function(MalType* (*lambda)(MalEnv *env, size_t argc, MalType **args), char *function_name, MalEnv *env); -MalType* mal_continuation(MalType* (*fn)(MalEnv *env, size_t argc, MalType **args), MalEnv *env, size_t argc, MalType **args); -MalType* mal_continuation_0(MalType* (*fn)(MalEnv *env, size_t argc, MalType **args), MalEnv *env); -MalType* mal_continuation_1(MalType* (*fn)(MalEnv *env, size_t argc, MalType **args), MalEnv *env, MalType *arg); -#define is_lambda(val) ((val)->type == MAL_LAMBDA_TYPE) -#define is_macro(val) ((val)->is_macro) -#define is_builtin_function(val) ((val)->type == MAL_LAMBDA_TYPE && (val)->function_name) - -MalType* mal_atom(MalType *inner_val); -#define is_atom(val) ((val)->type == MAL_ATOM_TYPE) - -MalType* mal_blank_line(); -#define is_blank_line(val) ((val)->type == MAL_BLANK_LINE_TYPE) - -MalType* mal_error(); -#define is_error(val) ((val)->type == MAL_ERROR_TYPE) -#define bubble_if_error(val) ({ MalType *v = (val); if (is_error(v)) { return (v); }; v; }) - -struct list_or_vector_iter { - enum { LIST_ITER, VECTOR_ITER } type; - MalType *cell; - size_t len; - size_t i; -}; - -size_t list_or_vector_len(MalType *obj); -struct list_or_vector_iter* list_or_vector_iter(MalType *obj); -struct list_or_vector_iter* list_or_vector_iter_next(struct list_or_vector_iter *iter); -int list_or_vector_iter_is_last(struct list_or_vector_iter *iter); -MalType* list_or_vector_iter_get_obj(struct list_or_vector_iter *iter); -int list_or_vector_index_of(MalType *list, MalType *val); - -MalType* mal_sprintf(char *format, ...); - -#define is_list_like(obj) ((obj)->type == MAL_EMPTY_TYPE || (obj)->type == MAL_CONS_TYPE || (obj)->type == MAL_VECTOR_TYPE) -#define is_pair(obj) ((obj)->type == MAL_CONS_TYPE || ((obj)->type == MAL_VECTOR_TYPE && (obj)->vec_len > 0)) - -int is_equal(MalType *arg1, MalType *arg2); -int hashmap_is_equal(MalType *arg1, MalType *arg2); -int list_or_vector_is_equal(MalType *arg1, MalType *arg2); - -struct codegen { - MalType *top; - MalType *decl; - MalType *body; -}; - -MalType* trampoline(MalType *result); - -#endif diff --git a/util.c b/util.c deleted file mode 100644 index c6db5c9..0000000 --- a/util.c +++ /dev/null @@ -1,89 +0,0 @@ -#include -#include -#include -#include -#include - -#include "util.h" - -char* long_long_to_string(long long num) { - char* str; - size_t len; - if (num == 0) { - return string("0"); - } else { - len = num_char_len(num); - str = GC_MALLOC(len + 1); - snprintf(str, len + 1, "%lli", num); - return str; - } -} - -// note: there is a formula using log10 to calculate a number length, -// but it uses the math lib which yelled at me for using TinyCC :-/ -size_t num_char_len(long long num) { - if (num < 0) { - return 1 + num_char_len(llabs(num)); - } else if (num < 10) { - return 1; - } else if (num < 100) { - return 2; - } else if (num < 1000) { - return 3; - } else if (num < 10000) { - return 4; - } else if (num < 100000) { - return 5; - } else if (num < 1000000) { - return 6; - } else if (num < 1000000000) { - return 9; - } else if (num < 1000000000000) { - return 12; - } else if (num < 1000000000000000) { - return 15; - } else if (num < 1000000000000000000) { - return 18; - } else { // up to 128 bits - return 40; - } -} - -char* string(char *str) { - size_t len = strlen(str); - char *copy = GC_MALLOC(len + 1); - snprintf(copy, len + 1, "%s", str); - return copy; -} - -char* substring(char *orig, size_t start, size_t len) { - size_t orig_len = strlen(orig); - assert(start < orig_len); - assert(start + len <= orig_len); - char *buffer = GC_MALLOC(len + 1); - snprintf(buffer, len + 1, "%s", orig + start); - return buffer; -} - -MalType* program_arguments_as_vector(int argc, char *argv[]) { - MalType *arg_vec = mal_vector(); - for (int i=1; i - -#include "env.h" -#include "types.h" - -#define UNUSED(x) (void)(x) - -#define mal_assert(val, message) if (!(val)) { return mal_error(mal_string(message)); } - -char* long_long_to_string(long long num); -size_t num_char_len(long long num); -char* string(char *str); -char* substring(char *orig, size_t start, size_t len); -void add_core_ns_to_env(MalEnv *env); -MalType* program_arguments_as_vector(int argc, char *argv[]); -MalType* read_file(char *filename); - -#endif -- 2.45.2