From 01c9731649a7ed97fad0bdeac9cb75b7323c0ad6 Mon Sep 17 00:00:00 2001 From: Joel Martin Date: Thu, 9 Oct 2014 23:48:47 -0500 Subject: All: swap step9,A. Fixes for bash, C, perl. step9_interop -> stepA_interop stepA_more -> step9_try C: fix glib headers bash: behavior change of declare -A and pattern replacement. perl: squelch new 5.18 warnings related to switch/given statement. Also, include some in-progress interop related files. --- .gitignore | 9 +- Makefile | 12 +- README.md | 12 +- bash/Makefile | 2 +- bash/step9_interop.sh | 263 ---------------------- bash/step9_try.sh | 271 +++++++++++++++++++++++ bash/stepA_interop.sh | 280 ++++++++++++++++++++++++ bash/stepA_more.sh | 280 ------------------------ bash/tests/step9_interop.mal | 17 -- bash/tests/stepA_interop.mal | 17 ++ bash/types.sh | 6 +- c/Makefile | 4 +- c/reader.c | 5 +- c/step9_interop.c | 328 ---------------------------- c/step9_try.c | 346 +++++++++++++++++++++++++++++ c/stepA_interop.c | 351 ++++++++++++++++++++++++++++++ c/stepA_more.c | 351 ------------------------------ c/tests/step9_interop.mal | 23 -- c/tests/stepA_interop.mal | 23 ++ clojure/Makefile | 2 +- clojure/project.clj | 4 +- clojure/src/step9_interop.clj | 164 -------------- clojure/src/step9_try.clj | 178 +++++++++++++++ clojure/src/stepA_interop.clj | 181 +++++++++++++++ clojure/src/stepA_more.clj | 181 --------------- clojure/tests/step9_interop.mal | 17 -- clojure/tests/stepA_interop.mal | 17 ++ cs/Makefile | 4 +- cs/interop.cs | 66 ++++++ cs/step9_try.cs | 288 ++++++++++++++++++++++++ cs/stepA_interop.cs | 288 ++++++++++++++++++++++++ cs/stepA_more.cs | 288 ------------------------ docs/TODO | 10 +- go/Makefile | 4 +- go/src/step9_try/step9_try.go | 306 ++++++++++++++++++++++++++ go/src/stepA_interop/stepA_interop.go | 306 ++++++++++++++++++++++++++ go/src/stepA_more/stepA_more.go | 306 -------------------------- java/Makefile | 2 +- java/src/main/java/mal/step9_try.java | 302 +++++++++++++++++++++++++ java/src/main/java/mal/stepA_interop.java | 302 +++++++++++++++++++++++++ java/src/main/java/mal/stepA_more.java | 302 ------------------------- js/Makefile | 2 +- js/step9_interop.js | 185 ---------------- js/step9_try.js | 192 ++++++++++++++++ js/stepA_interop.js | 198 +++++++++++++++++ js/stepA_more.js | 198 ----------------- js/tests/step9_interop.mal | 24 -- js/tests/stepA_interop.mal | 24 ++ make/Makefile | 4 +- make/step9_interop.mk | 174 --------------- make/step9_try.mk | 188 ++++++++++++++++ make/stepA_interop.mk | 192 ++++++++++++++++ make/stepA_more.mk | 192 ---------------- make/tests/step9_interop.mal | 19 -- make/tests/stepA_interop.mal | 19 ++ mal/Makefile | 2 +- mal/step9_try.mal | 181 +++++++++++++++ mal/stepA_interop.mal | 181 +++++++++++++++ mal/stepA_more.mal | 181 --------------- perl/Makefile | 2 +- perl/interop.pm | 1 + perl/printer.pm | 1 + perl/reader.pm | 1 + perl/step1_read_print.pl | 1 + perl/step2_eval.pl | 1 + perl/step3_env.pl | 1 + perl/step4_if_fn_do.pl | 1 + perl/step5_tco.pl | 1 + perl/step6_file.pl | 1 + perl/step7_quote.pl | 1 + perl/step8_macros.pl | 1 + perl/step9_interop.pl | 226 ------------------- perl/step9_try.pl | 256 ++++++++++++++++++++++ perl/stepA_interop.pl | 259 ++++++++++++++++++++++ perl/stepA_more.pl | 258 ---------------------- perl/tests/step9_interop.mal | 22 -- perl/tests/stepA_interop.mal | 22 ++ perl/types.pm | 1 + php/Makefile | 2 +- php/step9_interop.php | 197 ----------------- php/step9_try.php | 215 ++++++++++++++++++ php/stepA_interop.php | 217 ++++++++++++++++++ php/stepA_more.php | 217 ------------------ php/tests/stepA_interop.mal | 25 +++ ps/Makefile | 2 +- ps/interop.ps | 21 ++ ps/step9_interop.ps | 258 ---------------------- ps/step9_try.ps | 282 ++++++++++++++++++++++++ ps/stepA_interop.ps | 296 +++++++++++++++++++++++++ ps/stepA_more.ps | 296 ------------------------- python/Makefile | 2 +- python/step9_interop.py | 164 -------------- python/step9_try.py | 171 +++++++++++++++ python/stepA_interop.py | 177 +++++++++++++++ python/stepA_more.py | 177 --------------- ruby/Makefile | 2 +- ruby/step9_interop.rb | 163 -------------- ruby/step9_try.rb | 180 +++++++++++++++ ruby/stepA_interop.rb | 163 ++++++++++++++ ruby/stepA_more.rb | 180 --------------- ruby/tests/stepA_interop.mal | 27 +++ tests/step1_read_print.mal | 4 + tests/step9_try.mal | 337 ++++++++++++++++++++++++++++ tests/stepA_more.mal | 337 ---------------------------- 104 files changed, 7413 insertions(+), 6030 deletions(-) delete mode 100755 bash/step9_interop.sh create mode 100755 bash/step9_try.sh create mode 100755 bash/stepA_interop.sh delete mode 100755 bash/stepA_more.sh delete mode 100644 bash/tests/step9_interop.mal create mode 100644 bash/tests/stepA_interop.mal delete mode 100644 c/step9_interop.c create mode 100644 c/step9_try.c create mode 100644 c/stepA_interop.c delete mode 100644 c/stepA_more.c delete mode 100644 c/tests/step9_interop.mal create mode 100644 c/tests/stepA_interop.mal delete mode 100644 clojure/src/step9_interop.clj create mode 100644 clojure/src/step9_try.clj create mode 100644 clojure/src/stepA_interop.clj delete mode 100644 clojure/src/stepA_more.clj delete mode 100644 clojure/tests/step9_interop.mal create mode 100644 clojure/tests/stepA_interop.mal create mode 100644 cs/interop.cs create mode 100644 cs/step9_try.cs create mode 100644 cs/stepA_interop.cs delete mode 100644 cs/stepA_more.cs create mode 100644 go/src/step9_try/step9_try.go create mode 100644 go/src/stepA_interop/stepA_interop.go delete mode 100644 go/src/stepA_more/stepA_more.go create mode 100644 java/src/main/java/mal/step9_try.java create mode 100644 java/src/main/java/mal/stepA_interop.java delete mode 100644 java/src/main/java/mal/stepA_more.java delete mode 100644 js/step9_interop.js create mode 100644 js/step9_try.js create mode 100644 js/stepA_interop.js delete mode 100644 js/stepA_more.js delete mode 100644 js/tests/step9_interop.mal create mode 100644 js/tests/stepA_interop.mal delete mode 100644 make/step9_interop.mk create mode 100644 make/step9_try.mk create mode 100644 make/stepA_interop.mk delete mode 100644 make/stepA_more.mk delete mode 100644 make/tests/step9_interop.mal create mode 100644 make/tests/stepA_interop.mal create mode 100644 mal/step9_try.mal create mode 100644 mal/stepA_interop.mal delete mode 100644 mal/stepA_more.mal delete mode 100644 perl/step9_interop.pl create mode 100644 perl/step9_try.pl create mode 100644 perl/stepA_interop.pl delete mode 100644 perl/stepA_more.pl delete mode 100644 perl/tests/step9_interop.mal create mode 100644 perl/tests/stepA_interop.mal delete mode 100644 php/step9_interop.php create mode 100644 php/step9_try.php create mode 100644 php/stepA_interop.php delete mode 100644 php/stepA_more.php create mode 100644 php/tests/stepA_interop.mal create mode 100644 ps/interop.ps delete mode 100644 ps/step9_interop.ps create mode 100644 ps/step9_try.ps create mode 100644 ps/stepA_interop.ps delete mode 100644 ps/stepA_more.ps delete mode 100644 python/step9_interop.py create mode 100644 python/step9_try.py create mode 100644 python/stepA_interop.py delete mode 100644 python/stepA_more.py delete mode 100644 ruby/step9_interop.rb create mode 100644 ruby/step9_try.rb create mode 100644 ruby/stepA_interop.rb delete mode 100644 ruby/stepA_more.rb create mode 100644 ruby/tests/stepA_interop.mal create mode 100644 tests/step9_try.mal delete mode 100644 tests/stepA_more.mal diff --git a/.gitignore b/.gitignore index 691f079..cded525 100644 --- a/.gitignore +++ b/.gitignore @@ -16,14 +16,15 @@ c/step5_tco c/step6_file c/step7_quote c/step8_macros -c/step9_interop -c/stepA_more +c/step9_try +c/stepA_interop cs/*.exe cs/*.dll cs/*.mdb clojure/target clojure/.lein-repl-history go/step* +go/mal java/target/ java/dependency-reduced-pom.xml rust/step0_repl @@ -35,5 +36,5 @@ rust/step5_tco rust/step6_file rust/step7_quote rust/step8_macros -rust/step9_interop -rust/stepA_more +rust/step9_try +rust/stepA_interop diff --git a/Makefile b/Makefile index 97a8e0b..6c1bf12 100644 --- a/Makefile +++ b/Makefile @@ -21,8 +21,8 @@ step5 = step5_tco step6 = step6_file step7 = step7_quote step8 = step8_macros -step9 = step9_interop -stepA = stepA_more +step9 = step9_try +stepA = stepA_interop EXCLUDE_TESTS += test^bash^step5 # no stack exhaustion or completion EXCLUDE_TESTS += test^c^step5 # segfault @@ -34,9 +34,9 @@ EXCLUDE_TESTS += test^php^step5 # test completes, even at 100,000 EXCLUDE_TESTS += test^ruby^step5 # test completes, even at 100,000 # interop tests now implemented yet -EXCLUDE_TESTS += test^cs^step9 test^java^step9 test^mal^step9 \ - test^mal^step0 test^php^step9 test^ps^step9 \ - test^python^step9 test^ruby^step9 +EXCLUDE_TESTS += test^cs^stepA test^java^stepA test^mal^stepA \ + test^mal^step0 test^php^stepA test^ps^stepA \ + test^python^stepA test^ruby^stepA EXCLUDE_PERFS = perf^mal # TODO: fix this @@ -73,7 +73,7 @@ make_RUNSTEP = make -f ../$(2) $(3) mal_RUNSTEP = $(call $(MAL_IMPL)_RUNSTEP,$(1),$(call $(MAL_IMPL)_STEP_TO_PROG,stepA),../$(2),") #" perl_RUNSTEP = perl ../$(2) $(3) php_RUNSTEP = php ../$(2) $(3) -ps_RUNSTEP = $(4)gs -q -dNODISPLAY -- ../$(2) $(3)$(4) +ps_RUNSTEP = $(4)gs -q -I./ -dNODISPLAY -- ../$(2) $(3)$(4) python_RUNSTEP = $(PYTHON) ../$(2) $(3) ruby_RUNSTEP = ruby ../$(2) $(3) diff --git a/README.md b/README.md index 44fb631..f6d756a 100644 --- a/README.md +++ b/README.md @@ -57,8 +57,8 @@ bash stepX_YYY.sh ### C -The C implementation of mal requires the following libraries: glib, -libffi6 and either the libedit or GNU readline library. +The C implementation of mal requires the following libraries (lib and +header packages): glib, libffi6 and either the libedit or GNU readline library. ``` cd c @@ -97,6 +97,8 @@ make ### Java 1.7 +The Java implementation of mal requires maven2 to build. + ``` cd java mvn compile @@ -145,6 +147,9 @@ perl 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 @@ -152,6 +157,9 @@ php stepX_YYY.php ### 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 diff --git a/bash/Makefile b/bash/Makefile index e171f69..df663b5 100644 --- a/bash/Makefile +++ b/bash/Makefile @@ -1,5 +1,5 @@ SOURCES_BASE = types.sh reader.sh printer.sh -SOURCES_LISP = env.sh core.sh stepA_more.sh +SOURCES_LISP = env.sh core.sh stepA_interop.sh SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) all: mal.sh diff --git a/bash/step9_interop.sh b/bash/step9_interop.sh deleted file mode 100755 index ec8d6eb..0000000 --- a/bash/step9_interop.sh +++ /dev/null @@ -1,263 +0,0 @@ -#!/bin/bash - -source $(dirname $0)/reader.sh -source $(dirname $0)/printer.sh -source $(dirname $0)/env.sh -source $(dirname $0)/core.sh - -# read -READ () { - [ "${1}" ] && r="${1}" || READLINE - READ_STR "${r}" -} - -# eval -IS_PAIR () { - if _sequential? "${1}"; then - _count "${1}" - [[ "${r}" > 0 ]] && return 0 - fi - return 1 -} - -QUASIQUOTE () { - if ! IS_PAIR "${1}"; then - _symbol quote - _list "${r}" "${1}" - return - else - _nth "${1}" 0; local a0="${r}" - if [[ "${ANON["${a0}"]}" == "unquote" ]]; then - _nth "${1}" 1 - return - elif IS_PAIR "${a0}"; then - _nth "${a0}" 0; local a00="${r}" - if [[ "${ANON["${a00}"]}" == "splice-unquote" ]]; then - _symbol concat; local a="${r}" - _nth "${a0}" 1; local b="${r}" - _rest "${1}" - QUASIQUOTE "${r}"; local c="${r}" - _list "${a}" "${b}" "${c}" - return - fi - fi - fi - _symbol cons; local a="${r}" - QUASIQUOTE "${a0}"; local b="${r}" - _rest "${1}" - QUASIQUOTE "${r}"; local c="${r}" - _list "${a}" "${b}" "${c}" - return -} - -IS_MACRO_CALL () { - if ! _list? "${1}"; then return 1; fi - _nth "${1}" 0; local a0="${r}" - if _symbol? "${a0}"; then - ENV_FIND "${2}" "${ANON["${a0}"]}_ismacro_" - if [[ "${r}" ]]; then - return 0 - fi - fi - return 1 -} - -MACROEXPAND () { - local ast="${1}" env="${2}" - while IS_MACRO_CALL "${ast}" "${env}"; do - _nth "${ast}" 0; local a0="${r}" - ENV_GET "${env}" "${ANON["${a0}"]}"; local mac="${ANON["${r}"]}" - _rest "${ast}" - ${mac%%@*} ${ANON["${r}"]} - ast="${r}" - done - r="${ast}" -} - - -EVAL_AST () { - local ast="${1}" env="${2}" - #_pr_str "${ast}"; echo "EVAL_AST '${ast}:${r} / ${env}'" - _obj_type "${ast}"; local ot="${r}" - case "${ot}" in - symbol) - local val="${ANON["${ast}"]}" - ENV_GET "${env}" "${val}" - return ;; - list) - _map_with_type _list EVAL "${ast}" "${env}" ;; - vector) - _map_with_type _vector EVAL "${ast}" "${env}" ;; - hash_map) - local res="" val="" hm="${ANON["${ast}"]}" - _hash_map; local new_hm="${r}" - eval local keys="\${!${hm}[@]}" - for key in ${keys}; do - eval val="\${${hm}[\"${key}\"]}" - EVAL "${val}" "${env}" - _assoc! "${new_hm}" "${key}" "${r}" - done - r="${new_hm}" ;; - *) - r="${ast}" ;; - esac -} - -EVAL () { - local ast="${1}" env="${2}" - while true; do - r= - [[ "${__ERROR}" ]] && return 1 - #_pr_str "${ast}"; echo "EVAL '${r} / ${env}'" - if ! _list? "${ast}"; then - EVAL_AST "${ast}" "${env}" - return - fi - - # apply list - MACROEXPAND "${ast}" "${env}" - ast="${r}" - if ! _list? "${ast}"; then return; fi - _nth "${ast}" 0; local a0="${r}" - _nth "${ast}" 1; local a1="${r}" - _nth "${ast}" 2; local a2="${r}" - case "${ANON["${a0}"]}" in - def!) local k="${ANON["${a1}"]}" - #echo "def! ${k} to ${a2} in ${env}" - EVAL "${a2}" "${env}" - ENV_SET "${env}" "${k}" "${r}" - return ;; - let*) ENV "${env}"; local let_env="${r}" - local let_pairs=(${ANON["${a1}"]}) - local idx=0 - #echo "let: [${let_pairs[*]}] for ${a2}" - while [[ "${let_pairs["${idx}"]}" ]]; do - EVAL "${let_pairs[$(( idx + 1))]}" "${let_env}" - ENV_SET "${let_env}" "${ANON["${let_pairs[${idx}]}"]}" "${r}" - idx=$(( idx + 2)) - done - ast="${a2}" - env="${let_env}" - # Continue loop - ;; - quote) - r="${a1}" - return ;; - quasiquote) - QUASIQUOTE "${a1}" - ast="${r}" - # Continue loop - ;; - defmacro!) - local k="${ANON["${a1}"]}" - EVAL "${a2}" "${env}" - ENV_SET "${env}" "${k}" "${r}" - ENV_SET "${env}" "${k}_ismacro_" "yes" - return ;; - macroexpand) - MACROEXPAND "${a1}" "${env}" - return ;; - sh*) MACROEXPAND "${a1}" "${env}" - EVAL "${r}" "${env}" - local output="" - local line="" - while read line; do - output="${output}${line}\n" - done < <(eval ${ANON["${r}"]}) - _string "${output%\\n}" - return ;; - do) _count "${ast}" - _slice "${ast}" 1 $(( ${r} - 2 )) - EVAL_AST "${r}" "${env}" - [[ "${__ERROR}" ]] && r= && return 1 - _last "${ast}" - ast="${r}" - # Continue loop - ;; - if) EVAL "${a1}" "${env}" - if [[ "${r}" == "${__false}" || "${r}" == "${__nil}" ]]; then - # eval false form - _nth "${ast}" 3; local a3="${r}" - if [[ "${a3}" ]]; then - ast="${a3}" - else - r="${__nil}" - return - fi - else - # eval true condition - ast="${a2}" - fi - # Continue loop - ;; - fn*) _function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ - EVAL \"${a2}\" \"\${r}\"" \ - "${a2}" "${env}" "${a1}" - return ;; - *) EVAL_AST "${ast}" "${env}" - [[ "${__ERROR}" ]] && r= && return 1 - local el="${r}" - _first "${el}"; local f="${ANON["${r}"]}" - _rest "${el}"; local args="${ANON["${r}"]}" - #echo "invoke: [${f}] ${args}" - if [[ "${f//@/ }" != "${f}" ]]; then - set -- ${f//@/ } - ast="${2}" - ENV "${3}" "${4}" ${args} - env="${r}" - else - eval ${f%%@*} ${args} - return - fi - # Continue loop - ;; - esac - done -} - -# print -PRINT () { - if [[ "${__ERROR}" ]]; then - _pr_str "${__ERROR}" yes - r="Error: ${r}" - __ERROR= - else - _pr_str "${1}" yes - fi -} - -# repl -ENV; REPL_ENV="${r}" -REP () { - r= - READ "${1}" - EVAL "${r}" "${REPL_ENV}" - PRINT "${r}" -} - -# core.sh: defined using bash -_fref () { _function "${2} \"\${@}\""; ENV_SET "${REPL_ENV}" "${1}" "${r}"; } -for n in "${!core_ns[@]}"; do _fref "${n}" "${core_ns["${n}"]}"; done -_eval () { EVAL "${1}" "${REPL_ENV}"; } -_fref "eval" _eval -_list; argv="${r}" -for _arg in "${@:2}"; do _string "${_arg}"; _conj! "${argv}" "${r}"; done -ENV_SET "${REPL_ENV}" "__STAR__ARGV__STAR__" "${argv}"; - -# core.mal: defined using the language itself -REP "(def! not (fn* (a) (if a false true)))" -REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" -REP "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" -REP "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) \`(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))" - -# load/run file from command line (then exit) -if [[ "${1}" ]]; then - REP "(load-file \"${1}\")" - exit 0 -fi - -# repl loop -while true; do - READLINE "user> " || exit "$?" - [[ "${r}" ]] && REP "${r}" && echo "${r}" -done diff --git a/bash/step9_try.sh b/bash/step9_try.sh new file mode 100755 index 0000000..db0b5a7 --- /dev/null +++ b/bash/step9_try.sh @@ -0,0 +1,271 @@ +#!/bin/bash + +source $(dirname $0)/reader.sh +source $(dirname $0)/printer.sh +source $(dirname $0)/env.sh +source $(dirname $0)/core.sh + +# read +READ () { + [ "${1}" ] && r="${1}" || READLINE + READ_STR "${r}" +} + +# eval +IS_PAIR () { + if _sequential? "${1}"; then + _count "${1}" + [[ "${r}" > 0 ]] && return 0 + fi + return 1 +} + +QUASIQUOTE () { + if ! IS_PAIR "${1}"; then + _symbol quote + _list "${r}" "${1}" + return + else + _nth "${1}" 0; local a0="${r}" + if [[ "${ANON["${a0}"]}" == "unquote" ]]; then + _nth "${1}" 1 + return + elif IS_PAIR "${a0}"; then + _nth "${a0}" 0; local a00="${r}" + if [[ "${ANON["${a00}"]}" == "splice-unquote" ]]; then + _symbol concat; local a="${r}" + _nth "${a0}" 1; local b="${r}" + _rest "${1}" + QUASIQUOTE "${r}"; local c="${r}" + _list "${a}" "${b}" "${c}" + return + fi + fi + fi + _symbol cons; local a="${r}" + QUASIQUOTE "${a0}"; local b="${r}" + _rest "${1}" + QUASIQUOTE "${r}"; local c="${r}" + _list "${a}" "${b}" "${c}" + return +} + +IS_MACRO_CALL () { + if ! _list? "${1}"; then return 1; fi + _nth "${1}" 0; local a0="${r}" + if _symbol? "${a0}"; then + ENV_FIND "${2}" "${ANON["${a0}"]}_ismacro_" + if [[ "${r}" ]]; then + return 0 + fi + fi + return 1 +} + +MACROEXPAND () { + local ast="${1}" env="${2}" + while IS_MACRO_CALL "${ast}" "${env}"; do + _nth "${ast}" 0; local a0="${r}" + ENV_GET "${env}" "${ANON["${a0}"]}"; local mac="${ANON["${r}"]}" + _rest "${ast}" + ${mac%%@*} ${ANON["${r}"]} + ast="${r}" + done + r="${ast}" +} + + +EVAL_AST () { + local ast="${1}" env="${2}" + #_pr_str "${ast}"; echo "EVAL_AST '${ast}:${r} / ${env}'" + _obj_type "${ast}"; local ot="${r}" + case "${ot}" in + symbol) + local val="${ANON["${ast}"]}" + ENV_GET "${env}" "${val}" + return ;; + list) + _map_with_type _list EVAL "${ast}" "${env}" ;; + vector) + _map_with_type _vector EVAL "${ast}" "${env}" ;; + hash_map) + local res="" val="" hm="${ANON["${ast}"]}" + _hash_map; local new_hm="${r}" + eval local keys="\${!${hm}[@]}" + for key in ${keys}; do + eval val="\${${hm}[\"${key}\"]}" + EVAL "${val}" "${env}" + _assoc! "${new_hm}" "${key}" "${r}" + done + r="${new_hm}" ;; + *) + r="${ast}" ;; + esac +} + +EVAL () { + local ast="${1}" env="${2}" + while true; do + r= + [[ "${__ERROR}" ]] && return 1 + #_pr_str "${ast}"; echo "EVAL '${r} / ${env}'" + if ! _list? "${ast}"; then + EVAL_AST "${ast}" "${env}" + return + fi + + # apply list + MACROEXPAND "${ast}" "${env}" + ast="${r}" + if ! _list? "${ast}"; then return; fi + _nth "${ast}" 0; local a0="${r}" + _nth "${ast}" 1; local a1="${r}" + _nth "${ast}" 2; local a2="${r}" + case "${ANON["${a0}"]}" in + def!) local k="${ANON["${a1}"]}" + #echo "def! ${k} to ${a2} in ${env}" + EVAL "${a2}" "${env}" + ENV_SET "${env}" "${k}" "${r}" + return ;; + let*) ENV "${env}"; local let_env="${r}" + local let_pairs=(${ANON["${a1}"]}) + local idx=0 + #echo "let: [${let_pairs[*]}] for ${a2}" + while [[ "${let_pairs["${idx}"]}" ]]; do + EVAL "${let_pairs[$(( idx + 1))]}" "${let_env}" + ENV_SET "${let_env}" "${ANON["${let_pairs[${idx}]}"]}" "${r}" + idx=$(( idx + 2)) + done + ast="${a2}" + env="${let_env}" + # Continue loop + ;; + quote) + r="${a1}" + return ;; + quasiquote) + QUASIQUOTE "${a1}" + ast="${r}" + # Continue loop + ;; + defmacro!) + local k="${ANON["${a1}"]}" + EVAL "${a2}" "${env}" + ENV_SET "${env}" "${k}" "${r}" + ENV_SET "${env}" "${k}_ismacro_" "yes" + return ;; + macroexpand) + MACROEXPAND "${a1}" "${env}" + return ;; + try*) MACROEXPAND "${a1}" "${env}" + EVAL "${r}" "${env}" + [[ -z "${__ERROR}" ]] && return + _nth "${a2}" 0; local a20="${r}" + if [ "${ANON["${a20}"]}" == "catch__STAR__" ]; then + _nth "${a2}" 1; local a21="${r}" + _nth "${a2}" 2; local a22="${r}" + _list "${a21}"; local binds="${r}" + ENV "${env}" "${binds}" "${__ERROR}" + local try_env="${r}" + __ERROR= + MACROEXPAND "${a22}" "${try_env}" + EVAL "${r}" "${try_env}" + fi # if no catch* clause, just propagate __ERROR + return ;; + do) _count "${ast}" + _slice "${ast}" 1 $(( ${r} - 2 )) + EVAL_AST "${r}" "${env}" + [[ "${__ERROR}" ]] && r= && return 1 + _last "${ast}" + ast="${r}" + # Continue loop + ;; + if) EVAL "${a1}" "${env}" + if [[ "${r}" == "${__false}" || "${r}" == "${__nil}" ]]; then + # eval false form + _nth "${ast}" 3; local a3="${r}" + if [[ "${a3}" ]]; then + ast="${a3}" + else + r="${__nil}" + return + fi + else + # eval true condition + ast="${a2}" + fi + # Continue loop + ;; + fn*) _function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ + EVAL \"${a2}\" \"\${r}\"" \ + "${a2}" "${env}" "${a1}" + return ;; + *) EVAL_AST "${ast}" "${env}" + [[ "${__ERROR}" ]] && r= && return 1 + local el="${r}" + _first "${el}"; local f="${ANON["${r}"]}" + _rest "${el}"; local args="${ANON["${r}"]}" + #echo "invoke: [${f}] ${args}" + if [[ "${f//@/ }" != "${f}" ]]; then + set -- ${f//@/ } + ast="${2}" + ENV "${3}" "${4}" ${args} + env="${r}" + else + eval ${f%%@*} ${args} + return + fi + # Continue loop + ;; + esac + done +} + +# print +PRINT () { + if [[ "${__ERROR}" ]]; then + _pr_str "${__ERROR}" yes + r="Error: ${r}" + __ERROR= + else + _pr_str "${1}" yes + fi +} + +# repl +ENV; REPL_ENV="${r}" +REP () { + r= + READ "${1}" + EVAL "${r}" "${REPL_ENV}" + PRINT "${r}" +} + +# core.sh: defined using bash +_fref () { _function "${2} \"\${@}\""; ENV_SET "${REPL_ENV}" "${1}" "${r}"; } +for n in "${!core_ns[@]}"; do _fref "${n}" "${core_ns["${n}"]}"; done +_eval () { EVAL "${1}" "${REPL_ENV}"; } +_fref "eval" _eval +_list; argv="${r}" +for _arg in "${@:2}"; do _string "${_arg}"; _conj! "${argv}" "${r}"; done +ENV_SET "${REPL_ENV}" "__STAR__ARGV__STAR__" "${argv}"; + +# core.mal: defined using the language itself +REP "(def! *host-language* \"bash\")" +REP "(def! not (fn* (a) (if a false true)))" +REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" +REP "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" +REP "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) \`(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))" + +# load/run file from command line (then exit) +if [[ "${1}" ]]; then + REP "(load-file \"${1}\")" + exit 0 +fi + +# repl loop +REP "(println (str \"Mal [\" *host-language* \"]\"))" +while true; do + READLINE "user> " || exit "$?" + [[ "${r}" ]] && REP "${r}" && echo "${r}" +done diff --git a/bash/stepA_interop.sh b/bash/stepA_interop.sh new file mode 100755 index 0000000..2422643 --- /dev/null +++ b/bash/stepA_interop.sh @@ -0,0 +1,280 @@ +#!/bin/bash + +source $(dirname $0)/reader.sh +source $(dirname $0)/printer.sh +source $(dirname $0)/env.sh +source $(dirname $0)/core.sh + +# read +READ () { + [ "${1}" ] && r="${1}" || READLINE + READ_STR "${r}" +} + +# eval +IS_PAIR () { + if _sequential? "${1}"; then + _count "${1}" + [[ "${r}" > 0 ]] && return 0 + fi + return 1 +} + +QUASIQUOTE () { + if ! IS_PAIR "${1}"; then + _symbol quote + _list "${r}" "${1}" + return + else + _nth "${1}" 0; local a0="${r}" + if [[ "${ANON["${a0}"]}" == "unquote" ]]; then + _nth "${1}" 1 + return + elif IS_PAIR "${a0}"; then + _nth "${a0}" 0; local a00="${r}" + if [[ "${ANON["${a00}"]}" == "splice-unquote" ]]; then + _symbol concat; local a="${r}" + _nth "${a0}" 1; local b="${r}" + _rest "${1}" + QUASIQUOTE "${r}"; local c="${r}" + _list "${a}" "${b}" "${c}" + return + fi + fi + fi + _symbol cons; local a="${r}" + QUASIQUOTE "${a0}"; local b="${r}" + _rest "${1}" + QUASIQUOTE "${r}"; local c="${r}" + _list "${a}" "${b}" "${c}" + return +} + +IS_MACRO_CALL () { + if ! _list? "${1}"; then return 1; fi + _nth "${1}" 0; local a0="${r}" + if _symbol? "${a0}"; then + ENV_FIND "${2}" "${ANON["${a0}"]}_ismacro_" + if [[ "${r}" ]]; then + return 0 + fi + fi + return 1 +} + +MACROEXPAND () { + local ast="${1}" env="${2}" + while IS_MACRO_CALL "${ast}" "${env}"; do + _nth "${ast}" 0; local a0="${r}" + ENV_GET "${env}" "${ANON["${a0}"]}"; local mac="${ANON["${r}"]}" + _rest "${ast}" + ${mac%%@*} ${ANON["${r}"]} + ast="${r}" + done + r="${ast}" +} + + +EVAL_AST () { + local ast="${1}" env="${2}" + #_pr_str "${ast}"; echo "EVAL_AST '${ast}:${r} / ${env}'" + _obj_type "${ast}"; local ot="${r}" + case "${ot}" in + symbol) + local val="${ANON["${ast}"]}" + ENV_GET "${env}" "${val}" + return ;; + list) + _map_with_type _list EVAL "${ast}" "${env}" ;; + vector) + _map_with_type _vector EVAL "${ast}" "${env}" ;; + hash_map) + local res="" val="" hm="${ANON["${ast}"]}" + _hash_map; local new_hm="${r}" + eval local keys="\${!${hm}[@]}" + for key in ${keys}; do + eval val="\${${hm}[\"${key}\"]}" + EVAL "${val}" "${env}" + _assoc! "${new_hm}" "${key}" "${r}" + done + r="${new_hm}" ;; + *) + r="${ast}" ;; + esac +} + +EVAL () { + local ast="${1}" env="${2}" + while true; do + r= + [[ "${__ERROR}" ]] && return 1 + #_pr_str "${ast}"; echo "EVAL '${r} / ${env}'" + if ! _list? "${ast}"; then + EVAL_AST "${ast}" "${env}" + return + fi + + # apply list + MACROEXPAND "${ast}" "${env}" + ast="${r}" + if ! _list? "${ast}"; then return; fi + _nth "${ast}" 0; local a0="${r}" + _nth "${ast}" 1; local a1="${r}" + _nth "${ast}" 2; local a2="${r}" + case "${ANON["${a0}"]}" in + def!) local k="${ANON["${a1}"]}" + #echo "def! ${k} to ${a2} in ${env}" + EVAL "${a2}" "${env}" + ENV_SET "${env}" "${k}" "${r}" + return ;; + let*) ENV "${env}"; local let_env="${r}" + local let_pairs=(${ANON["${a1}"]}) + local idx=0 + #echo "let: [${let_pairs[*]}] for ${a2}" + while [[ "${let_pairs["${idx}"]}" ]]; do + EVAL "${let_pairs[$(( idx + 1))]}" "${let_env}" + ENV_SET "${let_env}" "${ANON["${let_pairs[${idx}]}"]}" "${r}" + idx=$(( idx + 2)) + done + ast="${a2}" + env="${let_env}" + # Continue loop + ;; + quote) + r="${a1}" + return ;; + quasiquote) + QUASIQUOTE "${a1}" + ast="${r}" + # Continue loop + ;; + defmacro!) + local k="${ANON["${a1}"]}" + EVAL "${a2}" "${env}" + ENV_SET "${env}" "${k}" "${r}" + ENV_SET "${env}" "${k}_ismacro_" "yes" + return ;; + macroexpand) + MACROEXPAND "${a1}" "${env}" + return ;; + sh*) MACROEXPAND "${a1}" "${env}" + EVAL "${r}" "${env}" + local output="" + local line="" + while read line; do + output="${output}${line}\n" + done < <(eval ${ANON["${r}"]}) + _string "${output%\\n}" + return ;; + try*) MACROEXPAND "${a1}" "${env}" + EVAL "${r}" "${env}" + [[ -z "${__ERROR}" ]] && return + _nth "${a2}" 0; local a20="${r}" + if [ "${ANON["${a20}"]}" == "catch__STAR__" ]; then + _nth "${a2}" 1; local a21="${r}" + _nth "${a2}" 2; local a22="${r}" + _list "${a21}"; local binds="${r}" + ENV "${env}" "${binds}" "${__ERROR}" + local try_env="${r}" + __ERROR= + MACROEXPAND "${a22}" "${try_env}" + EVAL "${r}" "${try_env}" + fi # if no catch* clause, just propagate __ERROR + return ;; + do) _count "${ast}" + _slice "${ast}" 1 $(( ${r} - 2 )) + EVAL_AST "${r}" "${env}" + [[ "${__ERROR}" ]] && r= && return 1 + _last "${ast}" + ast="${r}" + # Continue loop + ;; + if) EVAL "${a1}" "${env}" + if [[ "${r}" == "${__false}" || "${r}" == "${__nil}" ]]; then + # eval false form + _nth "${ast}" 3; local a3="${r}" + if [[ "${a3}" ]]; then + ast="${a3}" + else + r="${__nil}" + return + fi + else + # eval true condition + ast="${a2}" + fi + # Continue loop + ;; + fn*) _function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ + EVAL \"${a2}\" \"\${r}\"" \ + "${a2}" "${env}" "${a1}" + return ;; + *) EVAL_AST "${ast}" "${env}" + [[ "${__ERROR}" ]] && r= && return 1 + local el="${r}" + _first "${el}"; local f="${ANON["${r}"]}" + _rest "${el}"; local args="${ANON["${r}"]}" + #echo "invoke: [${f}] ${args}" + if [[ "${f//@/ }" != "${f}" ]]; then + set -- ${f//@/ } + ast="${2}" + ENV "${3}" "${4}" ${args} + env="${r}" + else + eval ${f%%@*} ${args} + return + fi + # Continue loop + ;; + esac + done +} + +# print +PRINT () { + if [[ "${__ERROR}" ]]; then + _pr_str "${__ERROR}" yes + r="Error: ${r}" + __ERROR= + else + _pr_str "${1}" yes + fi +} + +# repl +ENV; REPL_ENV="${r}" +REP () { + r= + READ "${1}" + EVAL "${r}" "${REPL_ENV}" + PRINT "${r}" +} + +# core.sh: defined using bash +_fref () { _function "${2} \"\${@}\""; ENV_SET "${REPL_ENV}" "${1}" "${r}"; } +for n in "${!core_ns[@]}"; do _fref "${n}" "${core_ns["${n}"]}"; done +_eval () { EVAL "${1}" "${REPL_ENV}"; } +_fref "eval" _eval +_list; argv="${r}" +for _arg in "${@:2}"; do _string "${_arg}"; _conj! "${argv}" "${r}"; done +ENV_SET "${REPL_ENV}" "__STAR__ARGV__STAR__" "${argv}"; + +# core.mal: defined using the language itself +REP "(def! *host-language* \"bash\")" +REP "(def! not (fn* (a) (if a false true)))" +REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" +REP "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" +REP "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) \`(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))" + +# load/run file from command line (then exit) +if [[ "${1}" ]]; then + REP "(load-file \"${1}\")" + exit 0 +fi + +# repl loop +REP "(println (str \"Mal [\" *host-language* \"]\"))" +while true; do + READLINE "user> " || exit "$?" + [[ "${r}" ]] && REP "${r}" && echo "${r}" +done diff --git a/bash/stepA_more.sh b/bash/stepA_more.sh deleted file mode 100755 index 2422643..0000000 --- a/bash/stepA_more.sh +++ /dev/null @@ -1,280 +0,0 @@ -#!/bin/bash - -source $(dirname $0)/reader.sh -source $(dirname $0)/printer.sh -source $(dirname $0)/env.sh -source $(dirname $0)/core.sh - -# read -READ () { - [ "${1}" ] && r="${1}" || READLINE - READ_STR "${r}" -} - -# eval -IS_PAIR () { - if _sequential? "${1}"; then - _count "${1}" - [[ "${r}" > 0 ]] && return 0 - fi - return 1 -} - -QUASIQUOTE () { - if ! IS_PAIR "${1}"; then - _symbol quote - _list "${r}" "${1}" - return - else - _nth "${1}" 0; local a0="${r}" - if [[ "${ANON["${a0}"]}" == "unquote" ]]; then - _nth "${1}" 1 - return - elif IS_PAIR "${a0}"; then - _nth "${a0}" 0; local a00="${r}" - if [[ "${ANON["${a00}"]}" == "splice-unquote" ]]; then - _symbol concat; local a="${r}" - _nth "${a0}" 1; local b="${r}" - _rest "${1}" - QUASIQUOTE "${r}"; local c="${r}" - _list "${a}" "${b}" "${c}" - return - fi - fi - fi - _symbol cons; local a="${r}" - QUASIQUOTE "${a0}"; local b="${r}" - _rest "${1}" - QUASIQUOTE "${r}"; local c="${r}" - _list "${a}" "${b}" "${c}" - return -} - -IS_MACRO_CALL () { - if ! _list? "${1}"; then return 1; fi - _nth "${1}" 0; local a0="${r}" - if _symbol? "${a0}"; then - ENV_FIND "${2}" "${ANON["${a0}"]}_ismacro_" - if [[ "${r}" ]]; then - return 0 - fi - fi - return 1 -} - -MACROEXPAND () { - local ast="${1}" env="${2}" - while IS_MACRO_CALL "${ast}" "${env}"; do - _nth "${ast}" 0; local a0="${r}" - ENV_GET "${env}" "${ANON["${a0}"]}"; local mac="${ANON["${r}"]}" - _rest "${ast}" - ${mac%%@*} ${ANON["${r}"]} - ast="${r}" - done - r="${ast}" -} - - -EVAL_AST () { - local ast="${1}" env="${2}" - #_pr_str "${ast}"; echo "EVAL_AST '${ast}:${r} / ${env}'" - _obj_type "${ast}"; local ot="${r}" - case "${ot}" in - symbol) - local val="${ANON["${ast}"]}" - ENV_GET "${env}" "${val}" - return ;; - list) - _map_with_type _list EVAL "${ast}" "${env}" ;; - vector) - _map_with_type _vector EVAL "${ast}" "${env}" ;; - hash_map) - local res="" val="" hm="${ANON["${ast}"]}" - _hash_map; local new_hm="${r}" - eval local keys="\${!${hm}[@]}" - for key in ${keys}; do - eval val="\${${hm}[\"${key}\"]}" - EVAL "${val}" "${env}" - _assoc! "${new_hm}" "${key}" "${r}" - done - r="${new_hm}" ;; - *) - r="${ast}" ;; - esac -} - -EVAL () { - local ast="${1}" env="${2}" - while true; do - r= - [[ "${__ERROR}" ]] && return 1 - #_pr_str "${ast}"; echo "EVAL '${r} / ${env}'" - if ! _list? "${ast}"; then - EVAL_AST "${ast}" "${env}" - return - fi - - # apply list - MACROEXPAND "${ast}" "${env}" - ast="${r}" - if ! _list? "${ast}"; then return; fi - _nth "${ast}" 0; local a0="${r}" - _nth "${ast}" 1; local a1="${r}" - _nth "${ast}" 2; local a2="${r}" - case "${ANON["${a0}"]}" in - def!) local k="${ANON["${a1}"]}" - #echo "def! ${k} to ${a2} in ${env}" - EVAL "${a2}" "${env}" - ENV_SET "${env}" "${k}" "${r}" - return ;; - let*) ENV "${env}"; local let_env="${r}" - local let_pairs=(${ANON["${a1}"]}) - local idx=0 - #echo "let: [${let_pairs[*]}] for ${a2}" - while [[ "${let_pairs["${idx}"]}" ]]; do - EVAL "${let_pairs[$(( idx + 1))]}" "${let_env}" - ENV_SET "${let_env}" "${ANON["${let_pairs[${idx}]}"]}" "${r}" - idx=$(( idx + 2)) - done - ast="${a2}" - env="${let_env}" - # Continue loop - ;; - quote) - r="${a1}" - return ;; - quasiquote) - QUASIQUOTE "${a1}" - ast="${r}" - # Continue loop - ;; - defmacro!) - local k="${ANON["${a1}"]}" - EVAL "${a2}" "${env}" - ENV_SET "${env}" "${k}" "${r}" - ENV_SET "${env}" "${k}_ismacro_" "yes" - return ;; - macroexpand) - MACROEXPAND "${a1}" "${env}" - return ;; - sh*) MACROEXPAND "${a1}" "${env}" - EVAL "${r}" "${env}" - local output="" - local line="" - while read line; do - output="${output}${line}\n" - done < <(eval ${ANON["${r}"]}) - _string "${output%\\n}" - return ;; - try*) MACROEXPAND "${a1}" "${env}" - EVAL "${r}" "${env}" - [[ -z "${__ERROR}" ]] && return - _nth "${a2}" 0; local a20="${r}" - if [ "${ANON["${a20}"]}" == "catch__STAR__" ]; then - _nth "${a2}" 1; local a21="${r}" - _nth "${a2}" 2; local a22="${r}" - _list "${a21}"; local binds="${r}" - ENV "${env}" "${binds}" "${__ERROR}" - local try_env="${r}" - __ERROR= - MACROEXPAND "${a22}" "${try_env}" - EVAL "${r}" "${try_env}" - fi # if no catch* clause, just propagate __ERROR - return ;; - do) _count "${ast}" - _slice "${ast}" 1 $(( ${r} - 2 )) - EVAL_AST "${r}" "${env}" - [[ "${__ERROR}" ]] && r= && return 1 - _last "${ast}" - ast="${r}" - # Continue loop - ;; - if) EVAL "${a1}" "${env}" - if [[ "${r}" == "${__false}" || "${r}" == "${__nil}" ]]; then - # eval false form - _nth "${ast}" 3; local a3="${r}" - if [[ "${a3}" ]]; then - ast="${a3}" - else - r="${__nil}" - return - fi - else - # eval true condition - ast="${a2}" - fi - # Continue loop - ;; - fn*) _function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ - EVAL \"${a2}\" \"\${r}\"" \ - "${a2}" "${env}" "${a1}" - return ;; - *) EVAL_AST "${ast}" "${env}" - [[ "${__ERROR}" ]] && r= && return 1 - local el="${r}" - _first "${el}"; local f="${ANON["${r}"]}" - _rest "${el}"; local args="${ANON["${r}"]}" - #echo "invoke: [${f}] ${args}" - if [[ "${f//@/ }" != "${f}" ]]; then - set -- ${f//@/ } - ast="${2}" - ENV "${3}" "${4}" ${args} - env="${r}" - else - eval ${f%%@*} ${args} - return - fi - # Continue loop - ;; - esac - done -} - -# print -PRINT () { - if [[ "${__ERROR}" ]]; then - _pr_str "${__ERROR}" yes - r="Error: ${r}" - __ERROR= - else - _pr_str "${1}" yes - fi -} - -# repl -ENV; REPL_ENV="${r}" -REP () { - r= - READ "${1}" - EVAL "${r}" "${REPL_ENV}" - PRINT "${r}" -} - -# core.sh: defined using bash -_fref () { _function "${2} \"\${@}\""; ENV_SET "${REPL_ENV}" "${1}" "${r}"; } -for n in "${!core_ns[@]}"; do _fref "${n}" "${core_ns["${n}"]}"; done -_eval () { EVAL "${1}" "${REPL_ENV}"; } -_fref "eval" _eval -_list; argv="${r}" -for _arg in "${@:2}"; do _string "${_arg}"; _conj! "${argv}" "${r}"; done -ENV_SET "${REPL_ENV}" "__STAR__ARGV__STAR__" "${argv}"; - -# core.mal: defined using the language itself -REP "(def! *host-language* \"bash\")" -REP "(def! not (fn* (a) (if a false true)))" -REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" -REP "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" -REP "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) \`(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))" - -# load/run file from command line (then exit) -if [[ "${1}" ]]; then - REP "(load-file \"${1}\")" - exit 0 -fi - -# repl loop -REP "(println (str \"Mal [\" *host-language* \"]\"))" -while true; do - READLINE "user> " || exit "$?" - [[ "${r}" ]] && REP "${r}" && echo "${r}" -done diff --git a/bash/tests/step9_interop.mal b/bash/tests/step9_interop.mal deleted file mode 100644 index bf3eabd..0000000 --- a/bash/tests/step9_interop.mal +++ /dev/null @@ -1,17 +0,0 @@ -;; Testing basic bash interop - -(sh* "echo 7") -;=>"7" - -(sh* "echo >&2 hello") -; hello -;=>"" - -(sh* "foo=8; echo ${foo}") -;=>"8" - -(sh* "for x in a b c; do echo -n \"X${x}Y \"; done; echo") -;=>"XaY XbY XcY" - -(sh* "for x in 1 2 3; do echo -n \"$((1+$x)) \"; done; echo") -;=>"2 3 4" diff --git a/bash/tests/stepA_interop.mal b/bash/tests/stepA_interop.mal new file mode 100644 index 0000000..bf3eabd --- /dev/null +++ b/bash/tests/stepA_interop.mal @@ -0,0 +1,17 @@ +;; Testing basic bash interop + +(sh* "echo 7") +;=>"7" + +(sh* "echo >&2 hello") +; hello +;=>"" + +(sh* "foo=8; echo ${foo}") +;=>"8" + +(sh* "for x in a b c; do echo -n \"X${x}Y \"; done; echo") +;=>"XaY XbY XcY" + +(sh* "for x in 1 2 3; do echo -n \"$((1+$x)) \"; done; echo") +;=>"2 3 4" diff --git a/bash/types.sh b/bash/types.sh index 6781492..5cdc14a 100644 --- a/bash/types.sh +++ b/bash/types.sh @@ -104,7 +104,7 @@ _false? () { [[ ${1} =~ ^fals_ ]]; } _symbol () { __new_obj_hash_code r="symb_${r}" - ANON["${r}"]="${1//$'\*'/__STAR__}" + ANON["${r}"]="${1//\*/__STAR__}" } _symbol? () { [[ ${1} =~ ^symb_ ]]; } @@ -124,7 +124,7 @@ _number? () { [[ ${1} =~ ^numb_ ]]; } _string () { __new_obj_hash_code r="strn_${r}" - ANON["${r}"]="${1//$'\*'/__STAR__}" + ANON["${r}"]="${1//\*/__STAR__}" } _string? () { [[ ${1} =~ ^strn_ ]]; } @@ -173,7 +173,7 @@ _hash_map () { __new_obj_hash_code local name="hmap_${r}" local obj="${__obj_magic}_${name}" - declare -A -g ${obj} + declare -A -g ${obj}; eval "${obj}=()" ANON["${name}"]="${obj}" while [[ "${1}" ]]; do diff --git a/c/Makefile b/c/Makefile index e18d81f..81b384c 100644 --- a/c/Makefile +++ b/c/Makefile @@ -9,7 +9,7 @@ TESTS = SOURCES_BASE = readline.h readline.c types.h types.c \ reader.h reader.c printer.h printer.c \ interop.h interop.c -SOURCES_LISP = env.c core.h core.c stepA_more.c +SOURCES_LISP = env.c core.h core.c stepA_interop.c SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) @@ -17,7 +17,7 @@ SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) SRCS = step0_repl.c step1_read_print.c step2_eval.c step3_env.c \ step4_if_fn_do.c step5_tco.c step6_file.c step7_quote.c \ - step8_macros.c step9_interop.c stepA_more.c + step8_macros.c step9_try.c stepA_interop.c OBJS = $(SRCS:%.c=%.o) BINS = $(OBJS:%.o=%) OTHER_OBJS = types.o readline.o reader.o printer.o env.o core.o interop.o diff --git a/c/reader.c b/c/reader.c index dbb7335..d9b75b7 100644 --- a/c/reader.c +++ b/c/reader.c @@ -2,8 +2,9 @@ #include #include -#include -#include +//#include +//#include +#include #include "types.h" #include "reader.h" diff --git a/c/step9_interop.c b/c/step9_interop.c deleted file mode 100644 index 6ba594e..0000000 --- a/c/step9_interop.c +++ /dev/null @@ -1,328 +0,0 @@ -#include -#include -#include - -#include "types.h" -#include "readline.h" -#include "reader.h" -#include "core.h" -#include "interop.h" - -// Declarations -MalVal *EVAL(MalVal *ast, Env *env); -MalVal *macroexpand(MalVal *ast, Env *env); - -// read -MalVal *READ(char prompt[], char *str) { - char *line; - MalVal *ast; - if (str) { - line = str; - } else { - line = _readline(prompt); - if (!line) { - _error("EOF"); - return NULL; - } - } - ast = read_str(line); - if (!str) { free(line); } - return ast; -} - -// eval -int is_pair(MalVal *x) { - return _sequential_Q(x) && (_count(x) > 0); -} - -MalVal *quasiquote(MalVal *ast) { - if (!is_pair(ast)) { - return _listX(2, malval_new_symbol("quote"), ast); - } else { - MalVal *a0 = _nth(ast, 0); - if ((a0->type & MAL_SYMBOL) && - strcmp("unquote", a0->val.string) == 0) { - return _nth(ast, 1); - } else if (is_pair(a0)) { - MalVal *a00 = _nth(a0, 0); - if ((a00->type & MAL_SYMBOL) && - strcmp("splice-unquote", a00->val.string) == 0) { - return _listX(3, malval_new_symbol("concat"), - _nth(a0, 1), - quasiquote(_rest(ast))); - } - } - return _listX(3, malval_new_symbol("cons"), - quasiquote(a0), - quasiquote(_rest(ast))); - } -} - -int is_macro_call(MalVal *ast, Env *env) { - if (!ast || ast->type != MAL_LIST) { return 0; } - MalVal *a0 = _nth(ast, 0); - return (a0->type & MAL_SYMBOL) && - env_find(env, a0->val.string) && - env_get(env, a0->val.string)->ismacro; -} - -MalVal *macroexpand(MalVal *ast, Env *env) { - if (!ast || mal_error) return NULL; - while (is_macro_call(ast, env)) { - MalVal *a0 = _nth(ast, 0); - MalVal *mac = env_get(env, a0->val.string); - // TODO: this is weird and limits it to 20. FIXME - ast = _apply(mac, _rest(ast)); - } - return ast; -} - -MalVal *eval_ast(MalVal *ast, Env *env) { - if (!ast || mal_error) return NULL; - if (ast->type == MAL_SYMBOL) { - //g_print("EVAL symbol: %s\n", ast->val.string); - return env_get(env, ast->val.string); - } else if ((ast->type == MAL_LIST) || (ast->type == MAL_VECTOR)) { - //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); - MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); - if (!el || mal_error) return NULL; - el->type = ast->type; - return el; - } else if (ast->type == MAL_HASH_MAP) { - //g_print("EVAL hash_map: %s\n", _pr_str(ast,1)); - GHashTableIter iter; - gpointer key, value; - MalVal *seq = malval_new_list(MAL_LIST, - g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), - _count(ast))); - g_hash_table_iter_init (&iter, ast->val.hash_table); - while (g_hash_table_iter_next (&iter, &key, &value)) { - MalVal *kname = malval_new_string((char *)key); - g_array_append_val(seq->val.array, kname); - MalVal *new_val = EVAL((MalVal *)value, env); - g_array_append_val(seq->val.array, new_val); - } - return _hash_map(seq); - } else { - //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); - return ast; - } -} - -MalVal *EVAL(MalVal *ast, Env *env) { - while (TRUE) { - - if (!ast || mal_error) return NULL; - //g_print("EVAL: %s\n", _pr_str(ast,1)); - if (ast->type != MAL_LIST) { - return eval_ast(ast, env); - } - if (!ast || mal_error) return NULL; - - // apply list - //g_print("EVAL apply list: %s\n", _pr_str(ast,1)); - ast = macroexpand(ast, env); - if (!ast || mal_error) return NULL; - if (ast->type != MAL_LIST) { return ast; } - if (_count(ast) == 0) { return ast; } - - int i, len; - MalVal *a0 = _nth(ast, 0); - if ((a0->type & MAL_SYMBOL) && - strcmp("def!", a0->val.string) == 0) { - //g_print("eval apply def!\n"); - MalVal *a1 = _nth(ast, 1), - *a2 = _nth(ast, 2); - MalVal *res = EVAL(a2, env); - env_set(env, a1->val.string, res); - return res; - } else if ((a0->type & MAL_SYMBOL) && - strcmp("let*", a0->val.string) == 0) { - //g_print("eval apply let*\n"); - MalVal *a1 = _nth(ast, 1), - *a2 = _nth(ast, 2), - *key, *val; - assert_type(a1, MAL_LIST|MAL_VECTOR, - "let* bindings must be list or vector"); - len = _count(a1); - assert((len % 2) == 0, "odd number of let* bindings forms"); - Env *let_env = new_env(env, NULL, NULL); - for(i=0; ival.array, MalVal*, i); - val = g_array_index(a1->val.array, MalVal*, i+1); - assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); - env_set(let_env, key->val.string, EVAL(val, let_env)); - } - ast = a2; - env = let_env; - // Continue loop - } else if ((a0->type & MAL_SYMBOL) && - strcmp("quote", a0->val.string) == 0) { - //g_print("eval apply quote\n"); - return _nth(ast, 1); - } else if ((a0->type & MAL_SYMBOL) && - strcmp("quasiquote", a0->val.string) == 0) { - //g_print("eval apply quasiquote\n"); - MalVal *a1 = _nth(ast, 1); - ast = quasiquote(a1); - // Continue loop - } else if ((a0->type & MAL_SYMBOL) && - strcmp("defmacro!", a0->val.string) == 0) { - //g_print("eval apply defmacro!\n"); - MalVal *a1 = _nth(ast, 1), - *a2 = _nth(ast, 2); - MalVal *res = EVAL(a2, env); - res->ismacro = TRUE; - env_set(env, a1->val.string, res); - return res; - } else if ((a0->type & MAL_SYMBOL) && - strcmp("macroexpand", a0->val.string) == 0) { - //g_print("eval apply macroexpand\n"); - MalVal *a1 = _nth(ast, 1); - return macroexpand(a1, env); - } else if ((a0->type & MAL_SYMBOL) && - strcmp(".", a0->val.string) == 0) { - //g_print("eval apply .\n"); - MalVal *el = eval_ast(_slice(ast, 1, _count(ast)), env); - return invoke_native(el); - } else if ((a0->type & MAL_SYMBOL) && - strcmp("do", a0->val.string) == 0) { - //g_print("eval apply do\n"); - eval_ast(_slice(ast, 1, _count(ast)-1), env); - ast = _last(ast); - // Continue loop - } else if ((a0->type & MAL_SYMBOL) && - strcmp("if", a0->val.string) == 0) { - //g_print("eval apply if\n"); - MalVal *a1 = _nth(ast, 1); - MalVal *cond = EVAL(a1, env); - if (!cond || mal_error) return NULL; - if (cond->type & (MAL_FALSE|MAL_NIL)) { - // eval false slot form - ast = _nth(ast, 3); - if (!ast) { - return &mal_nil; - } - } else { - // eval true slot form - ast = _nth(ast, 2); - } - // Continue loop - } else if ((a0->type & MAL_SYMBOL) && - strcmp("fn*", a0->val.string) == 0) { - //g_print("eval apply fn*\n"); - MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL); - mf->ismacro = FALSE; - mf->val.func.evaluator = EVAL; - mf->val.func.args = _nth(ast, 1); - mf->val.func.body = _nth(ast, 2); - mf->val.func.env = env; - return mf; - } else { - //g_print("eval apply\n"); - MalVal *el = eval_ast(ast, env); - if (!el || mal_error) { return NULL; } - MalVal *f = _first(el), - *args = _rest(el); - assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, - "cannot apply '%s'", _pr_str(f,1)); - if (f->type & MAL_FUNCTION_MAL) { - ast = f->val.func.body; - env = new_env(f->val.func.env, f->val.func.args, args); - // Continue loop - } else { - return _apply(f, args); - } - } - - } // TCO while loop -} - -// print -char *PRINT(MalVal *exp) { - if (mal_error) { - fprintf(stderr, "Error: %s\n", mal_error->val.string); - malval_free(mal_error); - mal_error = NULL; - return NULL; - } - return _pr_str(exp,1); -} - -// repl - -// read and eval -MalVal *RE(Env *env, char *prompt, char *str) { - MalVal *ast, *exp; - ast = READ(prompt, str); - if (!ast || mal_error) return NULL; - exp = EVAL(ast, env); - if (ast != exp) { - malval_free(ast); // Free input structure - } - return exp; -} - -// Setup the initial REPL environment -Env *repl_env; - -void init_repl_env(int argc, char *argv[]) { - repl_env = new_env(NULL, NULL, NULL); - - // core.c: defined using C - int i; - for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) { - env_set(repl_env, core_ns[i].name, - malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); - } - MalVal *do_eval(MalVal *ast) { return EVAL(ast, repl_env); } - env_set(repl_env, "eval", - malval_new_function((void*(*)(void *))do_eval, 1)); - - MalVal *_argv = _listX(0); - for (i=2; i < argc; i++) { - MalVal *arg = malval_new_string(argv[i]); - g_array_append_val(_argv->val.array, arg); - } - env_set(repl_env, "*ARGV*", _argv); - - // core.mal: defined using the language itself - RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); - RE(repl_env, "", - "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); - RE(repl_env, "", "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); - RE(repl_env, "", "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); -} - -int main(int argc, char *argv[]) -{ - MalVal *exp; - char *output; - char prompt[100]; - - // Set the initial prompt and environment - snprintf(prompt, sizeof(prompt), "user> "); - init_repl_env(argc, argv); - - if (argc > 1) { - char *cmd = g_strdup_printf("(load-file \"%s\")", argv[1]); - RE(repl_env, "", cmd); - return 0; - } - - // repl loop - for(;;) { - exp = RE(repl_env, prompt, NULL); - if (mal_error && strcmp("EOF", mal_error->val.string) == 0) { - return 0; - } - output = PRINT(exp); - - if (output) { - g_print("%s\n", output); - free(output); // Free output string - } - - //malval_free(exp); // Free evaluated expression - } -} diff --git a/c/step9_try.c b/c/step9_try.c new file mode 100644 index 0000000..395a7f0 --- /dev/null +++ b/c/step9_try.c @@ -0,0 +1,346 @@ +#include +#include +#include + +#include "types.h" +#include "readline.h" +#include "reader.h" +#include "core.h" +#include "interop.h" + +// Declarations +MalVal *EVAL(MalVal *ast, Env *env); +MalVal *macroexpand(MalVal *ast, Env *env); + +// read +MalVal *READ(char prompt[], char *str) { + char *line; + MalVal *ast; + if (str) { + line = str; + } else { + line = _readline(prompt); + if (!line) { + _error("EOF"); + return NULL; + } + } + ast = read_str(line); + if (!str) { free(line); } + return ast; +} + +// eval +int is_pair(MalVal *x) { + return _sequential_Q(x) && (_count(x) > 0); +} + +MalVal *quasiquote(MalVal *ast) { + if (!is_pair(ast)) { + return _listX(2, malval_new_symbol("quote"), ast); + } else { + MalVal *a0 = _nth(ast, 0); + if ((a0->type & MAL_SYMBOL) && + strcmp("unquote", a0->val.string) == 0) { + return _nth(ast, 1); + } else if (is_pair(a0)) { + MalVal *a00 = _nth(a0, 0); + if ((a00->type & MAL_SYMBOL) && + strcmp("splice-unquote", a00->val.string) == 0) { + return _listX(3, malval_new_symbol("concat"), + _nth(a0, 1), + quasiquote(_rest(ast))); + } + } + return _listX(3, malval_new_symbol("cons"), + quasiquote(a0), + quasiquote(_rest(ast))); + } +} + +int is_macro_call(MalVal *ast, Env *env) { + if (!ast || ast->type != MAL_LIST) { return 0; } + MalVal *a0 = _nth(ast, 0); + return (a0->type & MAL_SYMBOL) && + env_find(env, a0->val.string) && + env_get(env, a0->val.string)->ismacro; +} + +MalVal *macroexpand(MalVal *ast, Env *env) { + if (!ast || mal_error) return NULL; + while (is_macro_call(ast, env)) { + MalVal *a0 = _nth(ast, 0); + MalVal *mac = env_get(env, a0->val.string); + // TODO: this is weird and limits it to 20. FIXME + ast = _apply(mac, _rest(ast)); + } + return ast; +} + +MalVal *eval_ast(MalVal *ast, Env *env) { + if (!ast || mal_error) return NULL; + if (ast->type == MAL_SYMBOL) { + //g_print("EVAL symbol: %s\n", ast->val.string); + return env_get(env, ast->val.string); + } else if ((ast->type == MAL_LIST) || (ast->type == MAL_VECTOR)) { + //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); + MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); + if (!el || mal_error) return NULL; + el->type = ast->type; + return el; + } else if (ast->type == MAL_HASH_MAP) { + //g_print("EVAL hash_map: %s\n", _pr_str(ast,1)); + GHashTableIter iter; + gpointer key, value; + MalVal *seq = malval_new_list(MAL_LIST, + g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), + _count(ast))); + g_hash_table_iter_init (&iter, ast->val.hash_table); + while (g_hash_table_iter_next (&iter, &key, &value)) { + MalVal *kname = malval_new_string((char *)key); + g_array_append_val(seq->val.array, kname); + MalVal *new_val = EVAL((MalVal *)value, env); + g_array_append_val(seq->val.array, new_val); + } + return _hash_map(seq); + } else { + //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); + return ast; + } +} + +MalVal *EVAL(MalVal *ast, Env *env) { + while (TRUE) { + + if (!ast || mal_error) return NULL; + //g_print("EVAL: %s\n", _pr_str(ast,1)); + if (ast->type != MAL_LIST) { + return eval_ast(ast, env); + } + if (!ast || mal_error) return NULL; + + // apply list + //g_print("EVAL apply list: %s\n", _pr_str(ast,1)); + ast = macroexpand(ast, env); + if (!ast || mal_error) return NULL; + if (ast->type != MAL_LIST) { return ast; } + if (_count(ast) == 0) { return ast; } + + int i, len; + MalVal *a0 = _nth(ast, 0); + if ((a0->type & MAL_SYMBOL) && + strcmp("def!", a0->val.string) == 0) { + //g_print("eval apply def!\n"); + MalVal *a1 = _nth(ast, 1), + *a2 = _nth(ast, 2); + MalVal *res = EVAL(a2, env); + env_set(env, a1->val.string, res); + return res; + } else if ((a0->type & MAL_SYMBOL) && + strcmp("let*", a0->val.string) == 0) { + //g_print("eval apply let*\n"); + MalVal *a1 = _nth(ast, 1), + *a2 = _nth(ast, 2), + *key, *val; + assert_type(a1, MAL_LIST|MAL_VECTOR, + "let* bindings must be list or vector"); + len = _count(a1); + assert((len % 2) == 0, "odd number of let* bindings forms"); + Env *let_env = new_env(env, NULL, NULL); + for(i=0; ival.array, MalVal*, i); + val = g_array_index(a1->val.array, MalVal*, i+1); + assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); + env_set(let_env, key->val.string, EVAL(val, let_env)); + } + ast = a2; + env = let_env; + // Continue loop + } else if ((a0->type & MAL_SYMBOL) && + strcmp("quote", a0->val.string) == 0) { + //g_print("eval apply quote\n"); + return _nth(ast, 1); + } else if ((a0->type & MAL_SYMBOL) && + strcmp("quasiquote", a0->val.string) == 0) { + //g_print("eval apply quasiquote\n"); + MalVal *a1 = _nth(ast, 1); + ast = quasiquote(a1); + // Continue loop + } else if ((a0->type & MAL_SYMBOL) && + strcmp("defmacro!", a0->val.string) == 0) { + //g_print("eval apply defmacro!\n"); + MalVal *a1 = _nth(ast, 1), + *a2 = _nth(ast, 2); + MalVal *res = EVAL(a2, env); + res->ismacro = TRUE; + env_set(env, a1->val.string, res); + return res; + } else if ((a0->type & MAL_SYMBOL) && + strcmp("macroexpand", a0->val.string) == 0) { + //g_print("eval apply macroexpand\n"); + MalVal *a1 = _nth(ast, 1); + return macroexpand(a1, env); + } else if ((a0->type & MAL_SYMBOL) && + strcmp("try*", a0->val.string) == 0) { + //g_print("eval apply try*\n"); + MalVal *a1 = _nth(ast, 1); + MalVal *a2 = _nth(ast, 2); + MalVal *res = EVAL(a1, env); + if (!mal_error) { return res; } + MalVal *a20 = _nth(a2, 0); + if (strcmp("catch*", a20->val.string) == 0) { + MalVal *a21 = _nth(a2, 1); + MalVal *a22 = _nth(a2, 2); + Env *catch_env = new_env(env, + _listX(1, a21), + _listX(1, mal_error)); + //malval_free(mal_error); + mal_error = NULL; + res = EVAL(a22, catch_env); + return res; + } else { + return &mal_nil; + } + } else if ((a0->type & MAL_SYMBOL) && + strcmp("do", a0->val.string) == 0) { + //g_print("eval apply do\n"); + eval_ast(_slice(ast, 1, _count(ast)-1), env); + ast = _last(ast); + // Continue loop + } else if ((a0->type & MAL_SYMBOL) && + strcmp("if", a0->val.string) == 0) { + //g_print("eval apply if\n"); + MalVal *a1 = _nth(ast, 1); + MalVal *cond = EVAL(a1, env); + if (!cond || mal_error) return NULL; + if (cond->type & (MAL_FALSE|MAL_NIL)) { + // eval false slot form + ast = _nth(ast, 3); + if (!ast) { + return &mal_nil; + } + } else { + // eval true slot form + ast = _nth(ast, 2); + } + // Continue loop + } else if ((a0->type & MAL_SYMBOL) && + strcmp("fn*", a0->val.string) == 0) { + //g_print("eval apply fn*\n"); + MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL); + mf->ismacro = FALSE; + mf->val.func.evaluator = EVAL; + mf->val.func.args = _nth(ast, 1); + mf->val.func.body = _nth(ast, 2); + mf->val.func.env = env; + return mf; + } else { + //g_print("eval apply\n"); + MalVal *el = eval_ast(ast, env); + if (!el || mal_error) { return NULL; } + MalVal *f = _first(el), + *args = _rest(el); + assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, + "cannot apply '%s'", _pr_str(f,1)); + if (f->type & MAL_FUNCTION_MAL) { + ast = f->val.func.body; + env = new_env(f->val.func.env, f->val.func.args, args); + // Continue loop + } else { + return _apply(f, args); + } + } + + } // TCO while loop +} + +// print +char *PRINT(MalVal *exp) { + if (mal_error) { + fprintf(stderr, "Error: %s\n", mal_error->val.string); + malval_free(mal_error); + mal_error = NULL; + return NULL; + } + return _pr_str(exp,1); +} + +// repl + +// read and eval +MalVal *RE(Env *env, char *prompt, char *str) { + MalVal *ast, *exp; + ast = READ(prompt, str); + if (!ast || mal_error) return NULL; + exp = EVAL(ast, env); + if (ast != exp) { + malval_free(ast); // Free input structure + } + return exp; +} + +// Setup the initial REPL environment +Env *repl_env; + +void init_repl_env(int argc, char *argv[]) { + repl_env = new_env(NULL, NULL, NULL); + + // core.c: defined using C + int i; + for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) { + env_set(repl_env, core_ns[i].name, + malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); + } + MalVal *do_eval(MalVal *ast) { return EVAL(ast, repl_env); } + env_set(repl_env, "eval", + malval_new_function((void*(*)(void *))do_eval, 1)); + + MalVal *_argv = _listX(0); + for (i=2; i < argc; i++) { + MalVal *arg = malval_new_string(argv[i]); + g_array_append_val(_argv->val.array, arg); + } + env_set(repl_env, "*ARGV*", _argv); + + // core.mal: defined using the language itself + RE(repl_env, "", "(def! *host-language* \"c\")"); + RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); + RE(repl_env, "", + "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); + RE(repl_env, "", "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); + RE(repl_env, "", "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); +} + +int main(int argc, char *argv[]) +{ + MalVal *exp; + char *output; + char prompt[100]; + + // Set the initial prompt and environment + snprintf(prompt, sizeof(prompt), "user> "); + init_repl_env(argc, argv); + + if (argc > 1) { + char *cmd = g_strdup_printf("(load-file \"%s\")", argv[1]); + RE(repl_env, "", cmd); + return 0; + } + + // repl loop + RE(repl_env, "", "(println (str \"Mal [\" *host-language* \"]\"))"); + for(;;) { + exp = RE(repl_env, prompt, NULL); + if (mal_error && strcmp("EOF", mal_error->val.string) == 0) { + return 0; + } + output = PRINT(exp); + + if (output) { + g_print("%s\n", output); + free(output); // Free output string + } + + //malval_free(exp); // Free evaluated expression + } +} diff --git a/c/stepA_interop.c b/c/stepA_interop.c new file mode 100644 index 0000000..b4b7431 --- /dev/null +++ b/c/stepA_interop.c @@ -0,0 +1,351 @@ +#include +#include +#include + +#include "types.h" +#include "readline.h" +#include "reader.h" +#include "core.h" +#include "interop.h" + +// Declarations +MalVal *EVAL(MalVal *ast, Env *env); +MalVal *macroexpand(MalVal *ast, Env *env); + +// read +MalVal *READ(char prompt[], char *str) { + char *line; + MalVal *ast; + if (str) { + line = str; + } else { + line = _readline(prompt); + if (!line) { + _error("EOF"); + return NULL; + } + } + ast = read_str(line); + if (!str) { free(line); } + return ast; +} + +// eval +int is_pair(MalVal *x) { + return _sequential_Q(x) && (_count(x) > 0); +} + +MalVal *quasiquote(MalVal *ast) { + if (!is_pair(ast)) { + return _listX(2, malval_new_symbol("quote"), ast); + } else { + MalVal *a0 = _nth(ast, 0); + if ((a0->type & MAL_SYMBOL) && + strcmp("unquote", a0->val.string) == 0) { + return _nth(ast, 1); + } else if (is_pair(a0)) { + MalVal *a00 = _nth(a0, 0); + if ((a00->type & MAL_SYMBOL) && + strcmp("splice-unquote", a00->val.string) == 0) { + return _listX(3, malval_new_symbol("concat"), + _nth(a0, 1), + quasiquote(_rest(ast))); + } + } + return _listX(3, malval_new_symbol("cons"), + quasiquote(a0), + quasiquote(_rest(ast))); + } +} + +int is_macro_call(MalVal *ast, Env *env) { + if (!ast || ast->type != MAL_LIST) { return 0; } + MalVal *a0 = _nth(ast, 0); + return (a0->type & MAL_SYMBOL) && + env_find(env, a0->val.string) && + env_get(env, a0->val.string)->ismacro; +} + +MalVal *macroexpand(MalVal *ast, Env *env) { + if (!ast || mal_error) return NULL; + while (is_macro_call(ast, env)) { + MalVal *a0 = _nth(ast, 0); + MalVal *mac = env_get(env, a0->val.string); + // TODO: this is weird and limits it to 20. FIXME + ast = _apply(mac, _rest(ast)); + } + return ast; +} + +MalVal *eval_ast(MalVal *ast, Env *env) { + if (!ast || mal_error) return NULL; + if (ast->type == MAL_SYMBOL) { + //g_print("EVAL symbol: %s\n", ast->val.string); + return env_get(env, ast->val.string); + } else if ((ast->type == MAL_LIST) || (ast->type == MAL_VECTOR)) { + //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); + MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); + if (!el || mal_error) return NULL; + el->type = ast->type; + return el; + } else if (ast->type == MAL_HASH_MAP) { + //g_print("EVAL hash_map: %s\n", _pr_str(ast,1)); + GHashTableIter iter; + gpointer key, value; + MalVal *seq = malval_new_list(MAL_LIST, + g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), + _count(ast))); + g_hash_table_iter_init (&iter, ast->val.hash_table); + while (g_hash_table_iter_next (&iter, &key, &value)) { + MalVal *kname = malval_new_string((char *)key); + g_array_append_val(seq->val.array, kname); + MalVal *new_val = EVAL((MalVal *)value, env); + g_array_append_val(seq->val.array, new_val); + } + return _hash_map(seq); + } else { + //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); + return ast; + } +} + +MalVal *EVAL(MalVal *ast, Env *env) { + while (TRUE) { + + if (!ast || mal_error) return NULL; + //g_print("EVAL: %s\n", _pr_str(ast,1)); + if (ast->type != MAL_LIST) { + return eval_ast(ast, env); + } + if (!ast || mal_error) return NULL; + + // apply list + //g_print("EVAL apply list: %s\n", _pr_str(ast,1)); + ast = macroexpand(ast, env); + if (!ast || mal_error) return NULL; + if (ast->type != MAL_LIST) { return ast; } + if (_count(ast) == 0) { return ast; } + + int i, len; + MalVal *a0 = _nth(ast, 0); + if ((a0->type & MAL_SYMBOL) && + strcmp("def!", a0->val.string) == 0) { + //g_print("eval apply def!\n"); + MalVal *a1 = _nth(ast, 1), + *a2 = _nth(ast, 2); + MalVal *res = EVAL(a2, env); + env_set(env, a1->val.string, res); + return res; + } else if ((a0->type & MAL_SYMBOL) && + strcmp("let*", a0->val.string) == 0) { + //g_print("eval apply let*\n"); + MalVal *a1 = _nth(ast, 1), + *a2 = _nth(ast, 2), + *key, *val; + assert_type(a1, MAL_LIST|MAL_VECTOR, + "let* bindings must be list or vector"); + len = _count(a1); + assert((len % 2) == 0, "odd number of let* bindings forms"); + Env *let_env = new_env(env, NULL, NULL); + for(i=0; ival.array, MalVal*, i); + val = g_array_index(a1->val.array, MalVal*, i+1); + assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); + env_set(let_env, key->val.string, EVAL(val, let_env)); + } + ast = a2; + env = let_env; + // Continue loop + } else if ((a0->type & MAL_SYMBOL) && + strcmp("quote", a0->val.string) == 0) { + //g_print("eval apply quote\n"); + return _nth(ast, 1); + } else if ((a0->type & MAL_SYMBOL) && + strcmp("quasiquote", a0->val.string) == 0) { + //g_print("eval apply quasiquote\n"); + MalVal *a1 = _nth(ast, 1); + ast = quasiquote(a1); + // Continue loop + } else if ((a0->type & MAL_SYMBOL) && + strcmp("defmacro!", a0->val.string) == 0) { + //g_print("eval apply defmacro!\n"); + MalVal *a1 = _nth(ast, 1), + *a2 = _nth(ast, 2); + MalVal *res = EVAL(a2, env); + res->ismacro = TRUE; + env_set(env, a1->val.string, res); + return res; + } else if ((a0->type & MAL_SYMBOL) && + strcmp("macroexpand", a0->val.string) == 0) { + //g_print("eval apply macroexpand\n"); + MalVal *a1 = _nth(ast, 1); + return macroexpand(a1, env); + } else if ((a0->type & MAL_SYMBOL) && + strcmp(".", a0->val.string) == 0) { + //g_print("eval apply .\n"); + MalVal *el = eval_ast(_slice(ast, 1, _count(ast)), env); + return invoke_native(el); + } else if ((a0->type & MAL_SYMBOL) && + strcmp("try*", a0->val.string) == 0) { + //g_print("eval apply try*\n"); + MalVal *a1 = _nth(ast, 1); + MalVal *a2 = _nth(ast, 2); + MalVal *res = EVAL(a1, env); + if (!mal_error) { return res; } + MalVal *a20 = _nth(a2, 0); + if (strcmp("catch*", a20->val.string) == 0) { + MalVal *a21 = _nth(a2, 1); + MalVal *a22 = _nth(a2, 2); + Env *catch_env = new_env(env, + _listX(1, a21), + _listX(1, mal_error)); + //malval_free(mal_error); + mal_error = NULL; + res = EVAL(a22, catch_env); + return res; + } else { + return &mal_nil; + } + } else if ((a0->type & MAL_SYMBOL) && + strcmp("do", a0->val.string) == 0) { + //g_print("eval apply do\n"); + eval_ast(_slice(ast, 1, _count(ast)-1), env); + ast = _last(ast); + // Continue loop + } else if ((a0->type & MAL_SYMBOL) && + strcmp("if", a0->val.string) == 0) { + //g_print("eval apply if\n"); + MalVal *a1 = _nth(ast, 1); + MalVal *cond = EVAL(a1, env); + if (!cond || mal_error) return NULL; + if (cond->type & (MAL_FALSE|MAL_NIL)) { + // eval false slot form + ast = _nth(ast, 3); + if (!ast) { + return &mal_nil; + } + } else { + // eval true slot form + ast = _nth(ast, 2); + } + // Continue loop + } else if ((a0->type & MAL_SYMBOL) && + strcmp("fn*", a0->val.string) == 0) { + //g_print("eval apply fn*\n"); + MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL); + mf->ismacro = FALSE; + mf->val.func.evaluator = EVAL; + mf->val.func.args = _nth(ast, 1); + mf->val.func.body = _nth(ast, 2); + mf->val.func.env = env; + return mf; + } else { + //g_print("eval apply\n"); + MalVal *el = eval_ast(ast, env); + if (!el || mal_error) { return NULL; } + MalVal *f = _first(el), + *args = _rest(el); + assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, + "cannot apply '%s'", _pr_str(f,1)); + if (f->type & MAL_FUNCTION_MAL) { + ast = f->val.func.body; + env = new_env(f->val.func.env, f->val.func.args, args); + // Continue loop + } else { + return _apply(f, args); + } + } + + } // TCO while loop +} + +// print +char *PRINT(MalVal *exp) { + if (mal_error) { + fprintf(stderr, "Error: %s\n", mal_error->val.string); + malval_free(mal_error); + mal_error = NULL; + return NULL; + } + return _pr_str(exp,1); +} + +// repl + +// read and eval +MalVal *RE(Env *env, char *prompt, char *str) { + MalVal *ast, *exp; + ast = READ(prompt, str); + if (!ast || mal_error) return NULL; + exp = EVAL(ast, env); + if (ast != exp) { + malval_free(ast); // Free input structure + } + return exp; +} + +// Setup the initial REPL environment +Env *repl_env; + +void init_repl_env(int argc, char *argv[]) { + repl_env = new_env(NULL, NULL, NULL); + + // core.c: defined using C + int i; + for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) { + env_set(repl_env, core_ns[i].name, + malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); + } + MalVal *do_eval(MalVal *ast) { return EVAL(ast, repl_env); } + env_set(repl_env, "eval", + malval_new_function((void*(*)(void *))do_eval, 1)); + + MalVal *_argv = _listX(0); + for (i=2; i < argc; i++) { + MalVal *arg = malval_new_string(argv[i]); + g_array_append_val(_argv->val.array, arg); + } + env_set(repl_env, "*ARGV*", _argv); + + // core.mal: defined using the language itself + RE(repl_env, "", "(def! *host-language* \"c\")"); + RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); + RE(repl_env, "", + "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); + RE(repl_env, "", "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); + RE(repl_env, "", "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); +} + +int main(int argc, char *argv[]) +{ + MalVal *exp; + char *output; + char prompt[100]; + + // Set the initial prompt and environment + snprintf(prompt, sizeof(prompt), "user> "); + init_repl_env(argc, argv); + + if (argc > 1) { + char *cmd = g_strdup_printf("(load-file \"%s\")", argv[1]); + RE(repl_env, "", cmd); + return 0; + } + + // repl loop + RE(repl_env, "", "(println (str \"Mal [\" *host-language* \"]\"))"); + for(;;) { + exp = RE(repl_env, prompt, NULL); + if (mal_error && strcmp("EOF", mal_error->val.string) == 0) { + return 0; + } + output = PRINT(exp); + + if (output) { + g_print("%s\n", output); + free(output); // Free output string + } + + //malval_free(exp); // Free evaluated expression + } +} diff --git a/c/stepA_more.c b/c/stepA_more.c deleted file mode 100644 index b4b7431..0000000 --- a/c/stepA_more.c +++ /dev/null @@ -1,351 +0,0 @@ -#include -#include -#include - -#include "types.h" -#include "readline.h" -#include "reader.h" -#include "core.h" -#include "interop.h" - -// Declarations -MalVal *EVAL(MalVal *ast, Env *env); -MalVal *macroexpand(MalVal *ast, Env *env); - -// read -MalVal *READ(char prompt[], char *str) { - char *line; - MalVal *ast; - if (str) { - line = str; - } else { - line = _readline(prompt); - if (!line) { - _error("EOF"); - return NULL; - } - } - ast = read_str(line); - if (!str) { free(line); } - return ast; -} - -// eval -int is_pair(MalVal *x) { - return _sequential_Q(x) && (_count(x) > 0); -} - -MalVal *quasiquote(MalVal *ast) { - if (!is_pair(ast)) { - return _listX(2, malval_new_symbol("quote"), ast); - } else { - MalVal *a0 = _nth(ast, 0); - if ((a0->type & MAL_SYMBOL) && - strcmp("unquote", a0->val.string) == 0) { - return _nth(ast, 1); - } else if (is_pair(a0)) { - MalVal *a00 = _nth(a0, 0); - if ((a00->type & MAL_SYMBOL) && - strcmp("splice-unquote", a00->val.string) == 0) { - return _listX(3, malval_new_symbol("concat"), - _nth(a0, 1), - quasiquote(_rest(ast))); - } - } - return _listX(3, malval_new_symbol("cons"), - quasiquote(a0), - quasiquote(_rest(ast))); - } -} - -int is_macro_call(MalVal *ast, Env *env) { - if (!ast || ast->type != MAL_LIST) { return 0; } - MalVal *a0 = _nth(ast, 0); - return (a0->type & MAL_SYMBOL) && - env_find(env, a0->val.string) && - env_get(env, a0->val.string)->ismacro; -} - -MalVal *macroexpand(MalVal *ast, Env *env) { - if (!ast || mal_error) return NULL; - while (is_macro_call(ast, env)) { - MalVal *a0 = _nth(ast, 0); - MalVal *mac = env_get(env, a0->val.string); - // TODO: this is weird and limits it to 20. FIXME - ast = _apply(mac, _rest(ast)); - } - return ast; -} - -MalVal *eval_ast(MalVal *ast, Env *env) { - if (!ast || mal_error) return NULL; - if (ast->type == MAL_SYMBOL) { - //g_print("EVAL symbol: %s\n", ast->val.string); - return env_get(env, ast->val.string); - } else if ((ast->type == MAL_LIST) || (ast->type == MAL_VECTOR)) { - //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); - MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); - if (!el || mal_error) return NULL; - el->type = ast->type; - return el; - } else if (ast->type == MAL_HASH_MAP) { - //g_print("EVAL hash_map: %s\n", _pr_str(ast,1)); - GHashTableIter iter; - gpointer key, value; - MalVal *seq = malval_new_list(MAL_LIST, - g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), - _count(ast))); - g_hash_table_iter_init (&iter, ast->val.hash_table); - while (g_hash_table_iter_next (&iter, &key, &value)) { - MalVal *kname = malval_new_string((char *)key); - g_array_append_val(seq->val.array, kname); - MalVal *new_val = EVAL((MalVal *)value, env); - g_array_append_val(seq->val.array, new_val); - } - return _hash_map(seq); - } else { - //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); - return ast; - } -} - -MalVal *EVAL(MalVal *ast, Env *env) { - while (TRUE) { - - if (!ast || mal_error) return NULL; - //g_print("EVAL: %s\n", _pr_str(ast,1)); - if (ast->type != MAL_LIST) { - return eval_ast(ast, env); - } - if (!ast || mal_error) return NULL; - - // apply list - //g_print("EVAL apply list: %s\n", _pr_str(ast,1)); - ast = macroexpand(ast, env); - if (!ast || mal_error) return NULL; - if (ast->type != MAL_LIST) { return ast; } - if (_count(ast) == 0) { return ast; } - - int i, len; - MalVal *a0 = _nth(ast, 0); - if ((a0->type & MAL_SYMBOL) && - strcmp("def!", a0->val.string) == 0) { - //g_print("eval apply def!\n"); - MalVal *a1 = _nth(ast, 1), - *a2 = _nth(ast, 2); - MalVal *res = EVAL(a2, env); - env_set(env, a1->val.string, res); - return res; - } else if ((a0->type & MAL_SYMBOL) && - strcmp("let*", a0->val.string) == 0) { - //g_print("eval apply let*\n"); - MalVal *a1 = _nth(ast, 1), - *a2 = _nth(ast, 2), - *key, *val; - assert_type(a1, MAL_LIST|MAL_VECTOR, - "let* bindings must be list or vector"); - len = _count(a1); - assert((len % 2) == 0, "odd number of let* bindings forms"); - Env *let_env = new_env(env, NULL, NULL); - for(i=0; ival.array, MalVal*, i); - val = g_array_index(a1->val.array, MalVal*, i+1); - assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); - env_set(let_env, key->val.string, EVAL(val, let_env)); - } - ast = a2; - env = let_env; - // Continue loop - } else if ((a0->type & MAL_SYMBOL) && - strcmp("quote", a0->val.string) == 0) { - //g_print("eval apply quote\n"); - return _nth(ast, 1); - } else if ((a0->type & MAL_SYMBOL) && - strcmp("quasiquote", a0->val.string) == 0) { - //g_print("eval apply quasiquote\n"); - MalVal *a1 = _nth(ast, 1); - ast = quasiquote(a1); - // Continue loop - } else if ((a0->type & MAL_SYMBOL) && - strcmp("defmacro!", a0->val.string) == 0) { - //g_print("eval apply defmacro!\n"); - MalVal *a1 = _nth(ast, 1), - *a2 = _nth(ast, 2); - MalVal *res = EVAL(a2, env); - res->ismacro = TRUE; - env_set(env, a1->val.string, res); - return res; - } else if ((a0->type & MAL_SYMBOL) && - strcmp("macroexpand", a0->val.string) == 0) { - //g_print("eval apply macroexpand\n"); - MalVal *a1 = _nth(ast, 1); - return macroexpand(a1, env); - } else if ((a0->type & MAL_SYMBOL) && - strcmp(".", a0->val.string) == 0) { - //g_print("eval apply .\n"); - MalVal *el = eval_ast(_slice(ast, 1, _count(ast)), env); - return invoke_native(el); - } else if ((a0->type & MAL_SYMBOL) && - strcmp("try*", a0->val.string) == 0) { - //g_print("eval apply try*\n"); - MalVal *a1 = _nth(ast, 1); - MalVal *a2 = _nth(ast, 2); - MalVal *res = EVAL(a1, env); - if (!mal_error) { return res; } - MalVal *a20 = _nth(a2, 0); - if (strcmp("catch*", a20->val.string) == 0) { - MalVal *a21 = _nth(a2, 1); - MalVal *a22 = _nth(a2, 2); - Env *catch_env = new_env(env, - _listX(1, a21), - _listX(1, mal_error)); - //malval_free(mal_error); - mal_error = NULL; - res = EVAL(a22, catch_env); - return res; - } else { - return &mal_nil; - } - } else if ((a0->type & MAL_SYMBOL) && - strcmp("do", a0->val.string) == 0) { - //g_print("eval apply do\n"); - eval_ast(_slice(ast, 1, _count(ast)-1), env); - ast = _last(ast); - // Continue loop - } else if ((a0->type & MAL_SYMBOL) && - strcmp("if", a0->val.string) == 0) { - //g_print("eval apply if\n"); - MalVal *a1 = _nth(ast, 1); - MalVal *cond = EVAL(a1, env); - if (!cond || mal_error) return NULL; - if (cond->type & (MAL_FALSE|MAL_NIL)) { - // eval false slot form - ast = _nth(ast, 3); - if (!ast) { - return &mal_nil; - } - } else { - // eval true slot form - ast = _nth(ast, 2); - } - // Continue loop - } else if ((a0->type & MAL_SYMBOL) && - strcmp("fn*", a0->val.string) == 0) { - //g_print("eval apply fn*\n"); - MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL); - mf->ismacro = FALSE; - mf->val.func.evaluator = EVAL; - mf->val.func.args = _nth(ast, 1); - mf->val.func.body = _nth(ast, 2); - mf->val.func.env = env; - return mf; - } else { - //g_print("eval apply\n"); - MalVal *el = eval_ast(ast, env); - if (!el || mal_error) { return NULL; } - MalVal *f = _first(el), - *args = _rest(el); - assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, - "cannot apply '%s'", _pr_str(f,1)); - if (f->type & MAL_FUNCTION_MAL) { - ast = f->val.func.body; - env = new_env(f->val.func.env, f->val.func.args, args); - // Continue loop - } else { - return _apply(f, args); - } - } - - } // TCO while loop -} - -// print -char *PRINT(MalVal *exp) { - if (mal_error) { - fprintf(stderr, "Error: %s\n", mal_error->val.string); - malval_free(mal_error); - mal_error = NULL; - return NULL; - } - return _pr_str(exp,1); -} - -// repl - -// read and eval -MalVal *RE(Env *env, char *prompt, char *str) { - MalVal *ast, *exp; - ast = READ(prompt, str); - if (!ast || mal_error) return NULL; - exp = EVAL(ast, env); - if (ast != exp) { - malval_free(ast); // Free input structure - } - return exp; -} - -// Setup the initial REPL environment -Env *repl_env; - -void init_repl_env(int argc, char *argv[]) { - repl_env = new_env(NULL, NULL, NULL); - - // core.c: defined using C - int i; - for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) { - env_set(repl_env, core_ns[i].name, - malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); - } - MalVal *do_eval(MalVal *ast) { return EVAL(ast, repl_env); } - env_set(repl_env, "eval", - malval_new_function((void*(*)(void *))do_eval, 1)); - - MalVal *_argv = _listX(0); - for (i=2; i < argc; i++) { - MalVal *arg = malval_new_string(argv[i]); - g_array_append_val(_argv->val.array, arg); - } - env_set(repl_env, "*ARGV*", _argv); - - // core.mal: defined using the language itself - RE(repl_env, "", "(def! *host-language* \"c\")"); - RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); - RE(repl_env, "", - "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); - RE(repl_env, "", "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); - RE(repl_env, "", "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); -} - -int main(int argc, char *argv[]) -{ - MalVal *exp; - char *output; - char prompt[100]; - - // Set the initial prompt and environment - snprintf(prompt, sizeof(prompt), "user> "); - init_repl_env(argc, argv); - - if (argc > 1) { - char *cmd = g_strdup_printf("(load-file \"%s\")", argv[1]); - RE(repl_env, "", cmd); - return 0; - } - - // repl loop - RE(repl_env, "", "(println (str \"Mal [\" *host-language* \"]\"))"); - for(;;) { - exp = RE(repl_env, prompt, NULL); - if (mal_error && strcmp("EOF", mal_error->val.string) == 0) { - return 0; - } - output = PRINT(exp); - - if (output) { - g_print("%s\n", output); - free(output); // Free output string - } - - //malval_free(exp); // Free evaluated expression - } -} diff --git a/c/tests/step9_interop.mal b/c/tests/step9_interop.mal deleted file mode 100644 index 657e3e7..0000000 --- a/c/tests/step9_interop.mal +++ /dev/null @@ -1,23 +0,0 @@ - -;; Testing FFI of "strlen" -(. nil "int32" "strlen" "string" "abcde") -;=>5 -(. nil "int32" "strlen" "string" "") -;=>0 - -;; Testing FFI of "strcmp" - -(. nil "int32" "strcmp" "string" "abc" "string" "abcA") -;=>-65 -(. nil "int32" "strcmp" "string" "abcA" "string" "abc") -;=>65 -(. nil "int32" "strcmp" "string" "abc" "string" "abc") -;=>0 - - -;; Testing FFI of "pow" (libm.so) - -(. "libm.so" "double" "pow" "double" 2.0 "double" 3.0) -;=>8.000000 -(. "libm.so" "double" "pow" "double" 3.0 "double" 2.0) -;=>9.000000 diff --git a/c/tests/stepA_interop.mal b/c/tests/stepA_interop.mal new file mode 100644 index 0000000..657e3e7 --- /dev/null +++ b/c/tests/stepA_interop.mal @@ -0,0 +1,23 @@ + +;; Testing FFI of "strlen" +(. nil "int32" "strlen" "string" "abcde") +;=>5 +(. nil "int32" "strlen" "string" "") +;=>0 + +;; Testing FFI of "strcmp" + +(. nil "int32" "strcmp" "string" "abc" "string" "abcA") +;=>-65 +(. nil "int32" "strcmp" "string" "abcA" "string" "abc") +;=>65 +(. nil "int32" "strcmp" "string" "abc" "string" "abc") +;=>0 + + +;; Testing FFI of "pow" (libm.so) + +(. "libm.so" "double" "pow" "double" 2.0 "double" 3.0) +;=>8.000000 +(. "libm.so" "double" "pow" "double" 3.0 "double" 2.0) +;=>9.000000 diff --git a/clojure/Makefile b/clojure/Makefile index 2ddfbcc..6d227a2 100644 --- a/clojure/Makefile +++ b/clojure/Makefile @@ -1,5 +1,5 @@ SOURCES_BASE = src/readline.clj src/reader.clj src/printer.clj -SOURCES_LISP = src/env.clj src/core.clj src/stepA_more.clj +SOURCES_LISP = src/env.clj src/core.clj src/stepA_interop.clj SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) all: diff --git a/clojure/project.clj b/clojure/project.clj index 4e7a15f..3d7ff2e 100644 --- a/clojure/project.clj +++ b/clojure/project.clj @@ -18,8 +18,8 @@ :step6 {:main step6-file} :step7 {:main step7-quote} :step8 {:main step8-macros} - :step9 {:main step9-interop} - :stepA {:main stepA-more}} + :step9 {:main step9-try} + :stepA {:main stepA-interop}} :main stepA-more) diff --git a/clojure/src/step9_interop.clj b/clojure/src/step9_interop.clj deleted file mode 100644 index c4d67e5..0000000 --- a/clojure/src/step9_interop.clj +++ /dev/null @@ -1,164 +0,0 @@ -(ns step9-interop - (:refer-clojure :exclude [macroexpand]) - (:require [clojure.repl] - [readline] - [reader] - [printer] - [env] - [core])) - -;; read -(defn READ [& [strng]] - (let [line (if strng strng (read-line))] - (reader/read-string strng))) - -;; eval -(declare EVAL) -(defn is-pair [x] - (and (sequential? x) (> (count x) 0))) - -(defn quasiquote [ast] - (cond - (not (is-pair ast)) - (list 'quote ast) - - (= 'unquote (first ast)) - (second ast) - - (and (is-pair (first ast)) (= 'splice-unquote (ffirst ast))) - (list 'concat (-> ast first second) (quasiquote (rest ast))) - - :else - (list 'cons (quasiquote (first ast)) (quasiquote (rest ast))))) - -(defn is-macro-call [ast env] - (and (seq? ast) - (symbol? (first ast)) - (env/env-find env (first ast)) - (:ismacro (meta (env/env-get env (first ast)))))) - -(defn macroexpand [ast env] - (loop [ast ast] - (if (is-macro-call ast env) - (let [mac (env/env-get env (first ast))] - (recur (apply mac (rest ast)))) - ast))) - -(defn eval-ast [ast env] - (cond - (symbol? ast) (env/env-get env ast) - - (seq? ast) (doall (map #(EVAL % env) ast)) - - (vector? ast) (vec (doall (map #(EVAL % env) ast))) - - (map? ast) (apply hash-map (doall (map #(EVAL % env) - (mapcat identity ast)))) - - :else ast)) - -(defn EVAL [ast env] - (loop [ast ast - env env] - ;;(prn "EVAL" ast (keys @env)) (flush) - (if (not (seq? ast)) - (eval-ast ast env) - - ;; apply list - (let [ast (macroexpand ast env)] - (if (not (seq? ast)) - ast - - (let [[a0 a1 a2 a3] ast] - (condp = a0 - 'def! - (env/env-set env a1 (EVAL a2 env)) - - 'let* - (let [let-env (env/env env)] - (doseq [[b e] (partition 2 a1)] - (env/env-set let-env b (EVAL e let-env))) - (recur a2 let-env)) - - 'quote - a1 - - 'quasiquote - (recur (quasiquote a1) env) - - 'defmacro! - (let [func (with-meta (EVAL a2 env) - {:ismacro true})] - (env/env-set env a1 func)) - - 'macroexpand - (macroexpand a1 env) - - 'clj* - (eval (reader/read-string a1)) - - 'do - (do (eval-ast (->> ast (drop-last) (drop 1)) env) - (recur (last ast) env)) - - 'if - (let [cond (EVAL a1 env)] - (if (or (= cond nil) (= cond false)) - (if (> (count ast) 2) - (recur a3 env) - nil) - (recur a2 env))) - - 'fn* - (with-meta - (fn [& args] - (EVAL a2 (env/env env a1 args))) - {:expression a2 - :environment env - :parameters a1}) - - ;; apply - (let [el (eval-ast ast env) - f (first el) - args (rest el) - {:keys [expression environment parameters]} (meta f)] - (if expression - (recur expression (env/env environment parameters args)) - (apply f args)))))))))) - -;; print -(defn PRINT [exp] (pr-str exp)) - -;; repl -(def repl-env (env/env)) -(defn rep - [strng] - (PRINT (EVAL (READ strng) repl-env))) - -;; core.clj: defined using Clojure -(doseq [[k v] core/core_ns] (env/env-set repl-env k v)) -(env/env-set repl-env 'eval (fn [ast] (EVAL ast repl-env))) -(env/env-set repl-env '*ARGV* ()) - -;; core.mal: defined using the language itself -(rep "(def! not (fn* [a] (if a false true)))") -(rep "(def! load-file (fn* [f] (eval (read-string (str \"(do \" (slurp f) \")\")))))") -(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") -(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") - -;; repl loop -(defn repl-loop [] - (let [line (readline/readline "user> ")] - (when line - (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment - (try - (println (rep line)) - (catch Throwable e - (clojure.repl/pst e)))) - (recur)))) - -(defn -main [& args] - (env/env-set repl-env '*ARGV* (rest args)) - (if args - (rep (str "(load-file \"" (first args) "\")")) - (repl-loop))) diff --git a/clojure/src/step9_try.clj b/clojure/src/step9_try.clj new file mode 100644 index 0000000..4990d75 --- /dev/null +++ b/clojure/src/step9_try.clj @@ -0,0 +1,178 @@ +(ns step9-try + (:refer-clojure :exclude [macroexpand]) + (:require [clojure.repl] + [readline] + [reader] + [printer] + [env] + [core])) + +;; read +(defn READ [& [strng]] + (let [line (if strng strng (read-line))] + (reader/read-string strng))) + +;; eval +(declare EVAL) +(defn is-pair [x] + (and (sequential? x) (> (count x) 0))) + +(defn quasiquote [ast] + (cond + (not (is-pair ast)) + (list 'quote ast) + + (= 'unquote (first ast)) + (second ast) + + (and (is-pair (first ast)) (= 'splice-unquote (ffirst ast))) + (list 'concat (-> ast first second) (quasiquote (rest ast))) + + :else + (list 'cons (quasiquote (first ast)) (quasiquote (rest ast))))) + +(defn is-macro-call [ast env] + (and (seq? ast) + (symbol? (first ast)) + (env/env-find env (first ast)) + (:ismacro (meta (env/env-get env (first ast)))))) + +(defn macroexpand [ast env] + (loop [ast ast] + (if (is-macro-call ast env) + (let [mac (env/env-get env (first ast))] + (recur (apply mac (rest ast)))) + ast))) + +(defn eval-ast [ast env] + (cond + (symbol? ast) (env/env-get env ast) + + (seq? ast) (doall (map #(EVAL % env) ast)) + + (vector? ast) (vec (doall (map #(EVAL % env) ast))) + + (map? ast) (apply hash-map (doall (map #(EVAL % env) + (mapcat identity ast)))) + + :else ast)) + +(defn EVAL [ast env] + (loop [ast ast + env env] + ;;(prn "EVAL" ast (keys @env)) (flush) + (if (not (seq? ast)) + (eval-ast ast env) + + ;; apply list + (let [ast (macroexpand ast env)] + (if (not (seq? ast)) + ast + + (let [[a0 a1 a2 a3] ast] + (condp = a0 + 'def! + (env/env-set env a1 (EVAL a2 env)) + + 'let* + (let [let-env (env/env env)] + (doseq [[b e] (partition 2 a1)] + (env/env-set let-env b (EVAL e let-env))) + (recur a2 let-env)) + + 'quote + a1 + + 'quasiquote + (recur (quasiquote a1) env) + + 'defmacro! + (let [func (with-meta (EVAL a2 env) + {:ismacro true})] + (env/env-set env a1 func)) + + 'macroexpand + (macroexpand a1 env) + + 'try* + (if (= 'catch* (nth a2 0)) + (try + (EVAL a1 env) + (catch clojure.lang.ExceptionInfo ei + (EVAL (nth a2 2) (env/env env + [(nth a2 1)] + [(:data (ex-data ei))]))) + (catch Throwable t + (EVAL (nth a2 2) (env/env env + [(nth a2 1)] + [(.getMessage t)])))) + (EVAL a1 env)) + + 'do + (do (eval-ast (->> ast (drop-last) (drop 1)) env) + (recur (last ast) env)) + + 'if + (let [cond (EVAL a1 env)] + (if (or (= cond nil) (= cond false)) + (if (> (count ast) 2) + (recur a3 env) + nil) + (recur a2 env))) + + 'fn* + (with-meta + (fn [& args] + (EVAL a2 (env/env env a1 args))) + {:expression a2 + :environment env + :parameters a1}) + + ;; apply + (let [el (eval-ast ast env) + f (first el) + args (rest el) + {:keys [expression environment parameters]} (meta f)] + (if expression + (recur expression (env/env environment parameters args)) + (apply f args)))))))))) + +;; print +(defn PRINT [exp] (pr-str exp)) + +;; repl +(def repl-env (env/env)) +(defn rep + [strng] + (PRINT (EVAL (READ strng) repl-env))) + +;; core.clj: defined using Clojure +(doseq [[k v] core/core_ns] (env/env-set repl-env k v)) +(env/env-set repl-env 'eval (fn [ast] (EVAL ast repl-env))) +(env/env-set repl-env '*ARGV* ()) + +;; core.mal: defined using the language itself +(rep "(def! *host-language* \"clojure\")") +(rep "(def! not (fn* [a] (if a false true)))") +(rep "(def! load-file (fn* [f] (eval (read-string (str \"(do \" (slurp f) \")\")))))") +(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") +(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") + +;; repl loop +(defn repl-loop [] + (let [line (readline/readline "user> ")] + (when line + (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment + (try + (println (rep line)) + (catch Throwable e + (clojure.repl/pst e)))) + (recur)))) + +(defn -main [& args] + (env/env-set repl-env '*ARGV* (rest args)) + (if args + (rep (str "(load-file \"" (first args) "\")")) + (do + (rep "(println (str \"Mal [\" *host-language* \"]\"))") + (repl-loop)))) diff --git a/clojure/src/stepA_interop.clj b/clojure/src/stepA_interop.clj new file mode 100644 index 0000000..6ed9964 --- /dev/null +++ b/clojure/src/stepA_interop.clj @@ -0,0 +1,181 @@ +(ns stepA-interop + (:refer-clojure :exclude [macroexpand]) + (:require [clojure.repl] + [readline] + [reader] + [printer] + [env] + [core])) + +;; read +(defn READ [& [strng]] + (let [line (if strng strng (read-line))] + (reader/read-string strng))) + +;; eval +(declare EVAL) +(defn is-pair [x] + (and (sequential? x) (> (count x) 0))) + +(defn quasiquote [ast] + (cond + (not (is-pair ast)) + (list 'quote ast) + + (= 'unquote (first ast)) + (second ast) + + (and (is-pair (first ast)) (= 'splice-unquote (ffirst ast))) + (list 'concat (-> ast first second) (quasiquote (rest ast))) + + :else + (list 'cons (quasiquote (first ast)) (quasiquote (rest ast))))) + +(defn is-macro-call [ast env] + (and (seq? ast) + (symbol? (first ast)) + (env/env-find env (first ast)) + (:ismacro (meta (env/env-get env (first ast)))))) + +(defn macroexpand [ast env] + (loop [ast ast] + (if (is-macro-call ast env) + (let [mac (env/env-get env (first ast))] + (recur (apply mac (rest ast)))) + ast))) + +(defn eval-ast [ast env] + (cond + (symbol? ast) (env/env-get env ast) + + (seq? ast) (doall (map #(EVAL % env) ast)) + + (vector? ast) (vec (doall (map #(EVAL % env) ast))) + + (map? ast) (apply hash-map (doall (map #(EVAL % env) + (mapcat identity ast)))) + + :else ast)) + +(defn EVAL [ast env] + (loop [ast ast + env env] + ;;(prn "EVAL" ast (keys @env)) (flush) + (if (not (seq? ast)) + (eval-ast ast env) + + ;; apply list + (let [ast (macroexpand ast env)] + (if (not (seq? ast)) + ast + + (let [[a0 a1 a2 a3] ast] + (condp = a0 + 'def! + (env/env-set env a1 (EVAL a2 env)) + + 'let* + (let [let-env (env/env env)] + (doseq [[b e] (partition 2 a1)] + (env/env-set let-env b (EVAL e let-env))) + (recur a2 let-env)) + + 'quote + a1 + + 'quasiquote + (recur (quasiquote a1) env) + + 'defmacro! + (let [func (with-meta (EVAL a2 env) + {:ismacro true})] + (env/env-set env a1 func)) + + 'macroexpand + (macroexpand a1 env) + + 'clj* + (eval (reader/read-string a1)) + + 'try* + (if (= 'catch* (nth a2 0)) + (try + (EVAL a1 env) + (catch clojure.lang.ExceptionInfo ei + (EVAL (nth a2 2) (env/env env + [(nth a2 1)] + [(:data (ex-data ei))]))) + (catch Throwable t + (EVAL (nth a2 2) (env/env env + [(nth a2 1)] + [(.getMessage t)])))) + (EVAL a1 env)) + + 'do + (do (eval-ast (->> ast (drop-last) (drop 1)) env) + (recur (last ast) env)) + + 'if + (let [cond (EVAL a1 env)] + (if (or (= cond nil) (= cond false)) + (if (> (count ast) 2) + (recur a3 env) + nil) + (recur a2 env))) + + 'fn* + (with-meta + (fn [& args] + (EVAL a2 (env/env env a1 args))) + {:expression a2 + :environment env + :parameters a1}) + + ;; apply + (let [el (eval-ast ast env) + f (first el) + args (rest el) + {:keys [expression environment parameters]} (meta f)] + (if expression + (recur expression (env/env environment parameters args)) + (apply f args)))))))))) + +;; print +(defn PRINT [exp] (pr-str exp)) + +;; repl +(def repl-env (env/env)) +(defn rep + [strng] + (PRINT (EVAL (READ strng) repl-env))) + +;; core.clj: defined using Clojure +(doseq [[k v] core/core_ns] (env/env-set repl-env k v)) +(env/env-set repl-env 'eval (fn [ast] (EVAL ast repl-env))) +(env/env-set repl-env '*ARGV* ()) + +;; core.mal: defined using the language itself +(rep "(def! *host-language* \"clojure\")") +(rep "(def! not (fn* [a] (if a false true)))") +(rep "(def! load-file (fn* [f] (eval (read-string (str \"(do \" (slurp f) \")\")))))") +(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") +(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") + +;; repl loop +(defn repl-loop [] + (let [line (readline/readline "user> ")] + (when line + (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment + (try + (println (rep line)) + (catch Throwable e + (clojure.repl/pst e)))) + (recur)))) + +(defn -main [& args] + (env/env-set repl-env '*ARGV* (rest args)) + (if args + (rep (str "(load-file \"" (first args) "\")")) + (do + (rep "(println (str \"Mal [\" *host-language* \"]\"))") + (repl-loop)))) diff --git a/clojure/src/stepA_more.clj b/clojure/src/stepA_more.clj deleted file mode 100644 index fc7451f..0000000 --- a/clojure/src/stepA_more.clj +++ /dev/null @@ -1,181 +0,0 @@ -(ns stepA-more - (:refer-clojure :exclude [macroexpand]) - (:require [clojure.repl] - [readline] - [reader] - [printer] - [env] - [core])) - -;; read -(defn READ [& [strng]] - (let [line (if strng strng (read-line))] - (reader/read-string strng))) - -;; eval -(declare EVAL) -(defn is-pair [x] - (and (sequential? x) (> (count x) 0))) - -(defn quasiquote [ast] - (cond - (not (is-pair ast)) - (list 'quote ast) - - (= 'unquote (first ast)) - (second ast) - - (and (is-pair (first ast)) (= 'splice-unquote (ffirst ast))) - (list 'concat (-> ast first second) (quasiquote (rest ast))) - - :else - (list 'cons (quasiquote (first ast)) (quasiquote (rest ast))))) - -(defn is-macro-call [ast env] - (and (seq? ast) - (symbol? (first ast)) - (env/env-find env (first ast)) - (:ismacro (meta (env/env-get env (first ast)))))) - -(defn macroexpand [ast env] - (loop [ast ast] - (if (is-macro-call ast env) - (let [mac (env/env-get env (first ast))] - (recur (apply mac (rest ast)))) - ast))) - -(defn eval-ast [ast env] - (cond - (symbol? ast) (env/env-get env ast) - - (seq? ast) (doall (map #(EVAL % env) ast)) - - (vector? ast) (vec (doall (map #(EVAL % env) ast))) - - (map? ast) (apply hash-map (doall (map #(EVAL % env) - (mapcat identity ast)))) - - :else ast)) - -(defn EVAL [ast env] - (loop [ast ast - env env] - ;;(prn "EVAL" ast (keys @env)) (flush) - (if (not (seq? ast)) - (eval-ast ast env) - - ;; apply list - (let [ast (macroexpand ast env)] - (if (not (seq? ast)) - ast - - (let [[a0 a1 a2 a3] ast] - (condp = a0 - 'def! - (env/env-set env a1 (EVAL a2 env)) - - 'let* - (let [let-env (env/env env)] - (doseq [[b e] (partition 2 a1)] - (env/env-set let-env b (EVAL e let-env))) - (recur a2 let-env)) - - 'quote - a1 - - 'quasiquote - (recur (quasiquote a1) env) - - 'defmacro! - (let [func (with-meta (EVAL a2 env) - {:ismacro true})] - (env/env-set env a1 func)) - - 'macroexpand - (macroexpand a1 env) - - 'clj* - (eval (reader/read-string a1)) - - 'try* - (if (= 'catch* (nth a2 0)) - (try - (EVAL a1 env) - (catch clojure.lang.ExceptionInfo ei - (EVAL (nth a2 2) (env/env env - [(nth a2 1)] - [(:data (ex-data ei))]))) - (catch Throwable t - (EVAL (nth a2 2) (env/env env - [(nth a2 1)] - [(.getMessage t)])))) - (EVAL a1 env)) - - 'do - (do (eval-ast (->> ast (drop-last) (drop 1)) env) - (recur (last ast) env)) - - 'if - (let [cond (EVAL a1 env)] - (if (or (= cond nil) (= cond false)) - (if (> (count ast) 2) - (recur a3 env) - nil) - (recur a2 env))) - - 'fn* - (with-meta - (fn [& args] - (EVAL a2 (env/env env a1 args))) - {:expression a2 - :environment env - :parameters a1}) - - ;; apply - (let [el (eval-ast ast env) - f (first el) - args (rest el) - {:keys [expression environment parameters]} (meta f)] - (if expression - (recur expression (env/env environment parameters args)) - (apply f args)))))))))) - -;; print -(defn PRINT [exp] (pr-str exp)) - -;; repl -(def repl-env (env/env)) -(defn rep - [strng] - (PRINT (EVAL (READ strng) repl-env))) - -;; core.clj: defined using Clojure -(doseq [[k v] core/core_ns] (env/env-set repl-env k v)) -(env/env-set repl-env 'eval (fn [ast] (EVAL ast repl-env))) -(env/env-set repl-env '*ARGV* ()) - -;; core.mal: defined using the language itself -(rep "(def! *host-language* \"clojure\")") -(rep "(def! not (fn* [a] (if a false true)))") -(rep "(def! load-file (fn* [f] (eval (read-string (str \"(do \" (slurp f) \")\")))))") -(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") -(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") - -;; repl loop -(defn repl-loop [] - (let [line (readline/readline "user> ")] - (when line - (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment - (try - (println (rep line)) - (catch Throwable e - (clojure.repl/pst e)))) - (recur)))) - -(defn -main [& args] - (env/env-set repl-env '*ARGV* (rest args)) - (if args - (rep (str "(load-file \"" (first args) "\")")) - (do - (rep "(println (str \"Mal [\" *host-language* \"]\"))") - (repl-loop)))) diff --git a/clojure/tests/step9_interop.mal b/clojure/tests/step9_interop.mal deleted file mode 100644 index b323222..0000000 --- a/clojure/tests/step9_interop.mal +++ /dev/null @@ -1,17 +0,0 @@ -;; Testing basic clojure interop - -(clj* "7") -;=>7 - -(clj* "\"abc\"") -;=>"abc" - -(clj* "{\"abc\" 123}") -;=>{"abc" 123} - -(clj* "(prn \"foo\")") -; "foo" -;=>nil - -(clj* "(for [x [1 2 3]] (+ 1 x))") -;=>(2 3 4) diff --git a/clojure/tests/stepA_interop.mal b/clojure/tests/stepA_interop.mal new file mode 100644 index 0000000..b323222 --- /dev/null +++ b/clojure/tests/stepA_interop.mal @@ -0,0 +1,17 @@ +;; Testing basic clojure interop + +(clj* "7") +;=>7 + +(clj* "\"abc\"") +;=>"abc" + +(clj* "{\"abc\" 123}") +;=>{"abc" 123} + +(clj* "(prn \"foo\")") +; "foo" +;=>nil + +(clj* "(for [x [1 2 3]] (+ 1 x))") +;=>(2 3 4) diff --git a/cs/Makefile b/cs/Makefile index b7eb023..1fd1f7a 100644 --- a/cs/Makefile +++ b/cs/Makefile @@ -5,7 +5,7 @@ DEBUG = TESTS = SOURCES_BASE = readline.cs types.cs reader.cs printer.cs -SOURCES_LISP = env.cs core.cs stepA_more.cs +SOURCES_LISP = env.cs core.cs stepA_interop.cs SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) OTHER_SOURCES = getline.cs @@ -14,7 +14,7 @@ OTHER_SOURCES = getline.cs SRCS = step0_repl.cs step1_read_print.cs step2_eval.cs step3_env.cs \ step4_if_fn_do.cs step5_tco.cs step6_file.cs step7_quote.cs \ - step8_macros.cs stepA_more.cs + step8_macros.cs step9_try.cs stepA_interop.cs LIB_SRCS = $(filter-out step%,$(OTHER_SOURCES) $(SOURCES)) diff --git a/cs/interop.cs b/cs/interop.cs new file mode 100644 index 0000000..e383280 --- /dev/null +++ b/cs/interop.cs @@ -0,0 +1,66 @@ +using System; +using System.CodeDom.Compiler; +using System.Collections.Generic; +using System.Linq; +using System.Text; +using Microsoft.CSharp; + +public static class EvalProvider +{ + public static Func CreateEvalMethod(string code, string[] usingStatements = null, string[] assemblies = null) + { + Type returnType = typeof(TResult); + Type inputType = typeof(T); + + var includeUsings = new HashSet(new[] { "System" }); + includeUsings.Add(returnType.Namespace); + includeUsings.Add(inputType.Namespace); + if (usingStatements != null) + foreach (var usingStatement in usingStatements) + includeUsings.Add(usingStatement); + + using (CSharpCodeProvider compiler = new CSharpCodeProvider()) + { + var name = "F" + Guid.NewGuid().ToString().Replace("-", string.Empty); + var includeAssemblies = new HashSet(new[] { "system.dll" }); + if (assemblies != null) + foreach (var assembly in assemblies) + includeAssemblies.Add(assembly); + + var parameters = new CompilerParameters(includeAssemblies.ToArray()) + { + GenerateInMemory = true + }; + + string source = string.Format(@" +{0} +namespace {1} +{{ + public static class EvalClass + {{ + public static {2} Eval({3} arg) + {{ + {4} + }} + }} +}}", GetUsing(includeUsings), name, returnType.Name, inputType.Name, code); + + var compilerResult = compiler.CompileAssemblyFromSource(parameters, source); + var compiledAssembly = compilerResult.CompiledAssembly; + var type = compiledAssembly.GetType(string.Format("{0}.EvalClass", name)); + var method = type.GetMethod("Eval"); + return (Func)Delegate.CreateDelegate(typeof(Func), method); + } + } + + private static string GetUsing(HashSet usingStatements) + { + StringBuilder result = new StringBuilder(); + foreach (string usingStatement in usingStatements) + { + result.AppendLine(string.Format("using {0};", usingStatement)); + } + return result.ToString(); + } +} + diff --git a/cs/step9_try.cs b/cs/step9_try.cs new file mode 100644 index 0000000..ed3417c --- /dev/null +++ b/cs/step9_try.cs @@ -0,0 +1,288 @@ +using System; +using System.IO; +using System.Collections; +using System.Collections.Generic; +using Mal; +using MalVal = Mal.types.MalVal; +using MalString = Mal.types.MalString; +using MalSymbol = Mal.types.MalSymbol; +using MalInteger = Mal.types.MalInteger; +using MalList = Mal.types.MalList; +using MalVector = Mal.types.MalVector; +using MalHashMap = Mal.types.MalHashMap; +using MalFunction = Mal.types.MalFunction; +using Env = Mal.env.Env; + +namespace Mal { + class step9_try { + // read + static MalVal READ(string str) { + return reader.read_str(str); + } + + // eval + public static bool is_pair(MalVal x) { + return x is MalList && ((MalList)x).size() > 0; + } + + public static MalVal quasiquote(MalVal ast) { + if (!is_pair(ast)) { + return new MalList(new MalSymbol("quote"), ast); + } else { + MalVal a0 = ((MalList)ast)[0]; + if ((a0 is MalSymbol) && + (((MalSymbol)a0).getName() == "unquote")) { + return ((MalList)ast)[1]; + } else if (is_pair(a0)) { + MalVal a00 = ((MalList)a0)[0]; + if ((a00 is MalSymbol) && + (((MalSymbol)a00).getName() == "splice-unquote")) { + return new MalList(new MalSymbol("concat"), + ((MalList)a0)[1], + quasiquote(((MalList)ast).rest())); + } + } + return new MalList(new MalSymbol("cons"), + quasiquote(a0), + quasiquote(((MalList)ast).rest())); + } + } + + public static bool is_macro_call(MalVal ast, Env env) { + if (ast is MalList) { + MalVal a0 = ((MalList)ast)[0]; + if (a0 is MalSymbol && + env.find(((MalSymbol)a0).getName()) != null) { + MalVal mac = env.get(((MalSymbol)a0).getName()); + if (mac is MalFunction && + ((MalFunction)mac).isMacro()) { + return true; + } + } + } + return false; + } + + public static MalVal macroexpand(MalVal ast, Env env) { + while (is_macro_call(ast, env)) { + MalSymbol a0 = (MalSymbol)((MalList)ast)[0]; + MalFunction mac = (MalFunction) env.get(a0.getName()); + ast = mac.apply(((MalList)ast).rest()); + } + return ast; + } + + static MalVal eval_ast(MalVal ast, Env env) { + if (ast is MalSymbol) { + MalSymbol sym = (MalSymbol)ast; + return env.get(sym.getName()); + } else if (ast is MalList) { + MalList old_lst = (MalList)ast; + MalList new_lst = ast.list_Q() ? new MalList() + : (MalList)new MalVector(); + foreach (MalVal mv in old_lst.getValue()) { + new_lst.conj_BANG(EVAL(mv, env)); + } + return new_lst; + } else if (ast is MalHashMap) { + var new_dict = new Dictionary(); + foreach (var entry in ((MalHashMap)ast).getValue()) { + new_dict.Add(entry.Key, EVAL((MalVal)entry.Value, env)); + } + return new MalHashMap(new_dict); + } else { + return ast; + } + } + + + static MalVal EVAL(MalVal orig_ast, Env env) { + MalVal a0, a1, a2, res; + MalList el; + + while (true) { + + //System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); + if (!orig_ast.list_Q()) { + return eval_ast(orig_ast, env); + } + + // apply list + MalVal expanded = macroexpand(orig_ast, env); + if (!expanded.list_Q()) { return expanded; } + MalList ast = (MalList) expanded; + + if (ast.size() == 0) { return ast; } + a0 = ast[0]; + + String a0sym = a0 is MalSymbol ? ((MalSymbol)a0).getName() + : "__<*fn*>__"; + + switch (a0sym) { + case "def!": + a1 = ast[1]; + a2 = ast[2]; + res = EVAL(a2, env); + env.set(((MalSymbol)a1).getName(), res); + return res; + case "let*": + a1 = ast[1]; + a2 = ast[2]; + MalSymbol key; + MalVal val; + Env let_env = new Env(env); + for(int i=0; i<((MalList)a1).size(); i+=2) { + key = (MalSymbol)((MalList)a1)[i]; + val = ((MalList)a1)[i+1]; + let_env.set(key.getName(), EVAL(val, let_env)); + } + orig_ast = a2; + env = let_env; + break; + case "quote": + return ast[1]; + case "quasiquote": + orig_ast = quasiquote(ast[1]); + break; + case "defmacro!": + a1 = ast[1]; + a2 = ast[2]; + res = EVAL(a2, env); + ((MalFunction)res).setMacro(); + env.set(((MalSymbol)a1).getName(), res); + return res; + case "macroexpand": + a1 = ast[1]; + return macroexpand(a1, env); + case "try*": + try { + return EVAL(ast[1], env); + } catch (Exception e) { + if (ast.size() > 2) { + MalVal exc; + a2 = ast[2]; + MalVal a20 = ((MalList)a2)[0]; + if (((MalSymbol)a20).getName() == "catch*") { + if (e is Mal.types.MalException) { + exc = ((Mal.types.MalException)e).getValue(); + } else { + exc = new MalString(e.StackTrace); + } + return EVAL(((MalList)a2)[2], + new Env(env, ((MalList)a2).slice(1,2), + new MalList(exc))); + } + } + throw e; + } + case "do": + eval_ast(ast.slice(1, ast.size()-1), env); + orig_ast = ast[ast.size()-1]; + break; + case "if": + a1 = ast[1]; + MalVal cond = EVAL(a1, env); + if (cond == Mal.types.Nil || cond == Mal.types.False) { + // eval false slot form + if (ast.size() > 3) { + orig_ast = ast[3]; + } else { + return Mal.types.Nil; + } + } else { + // eval true slot form + orig_ast = ast[2]; + } + break; + case "fn*": + MalList a1f = (MalList)ast[1]; + MalVal a2f = ast[2]; + Env cur_env = env; + return new MalFunction(a2f, env, a1f, + args => EVAL(a2f, new Env(cur_env, a1f, args)) ); + default: + el = (MalList)eval_ast(ast, env); + var f = (MalFunction)el[0]; + MalVal fnast = f.getAst(); + if (fnast != null) { + orig_ast = fnast; + env = f.genEnv(el.rest()); + } else { + return f.apply(el.rest()); + } + break; + } + + } + } + + // print + static string PRINT(MalVal exp) { + return printer._pr_str(exp, true); + } + + // repl + static MalVal RE(Env env, string str) { + return EVAL(READ(str), env); + } + + static void Main(string[] args) { + string prompt = "user> "; + + // core.cs: defined using C# + var repl_env = new env.Env(null); + foreach (var entry in core.ns) { + repl_env.set(entry.Key, entry.Value); + } + repl_env.set("eval", new MalFunction(a => EVAL(a[0], repl_env))); + MalList _argv = new MalList(); + for (int i=1; i < args.Length; i++) { + _argv.conj_BANG(new MalString(args[i])); + } + repl_env.set("*ARGV*", _argv); + + // core.mal: defined using the language itself + RE(repl_env, "(def! *host-language* \"c#\")"); + RE(repl_env, "(def! not (fn* (a) (if a false true)))"); + RE(repl_env, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); + RE(repl_env, "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); + RE(repl_env, "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); + + int fileIdx = 0; + if (args.Length > 0 && args[0] == "--raw") { + Mal.readline.mode = Mal.readline.Mode.Raw; + fileIdx = 1; + } + if (args.Length > fileIdx) { + RE(repl_env, "(load-file \"" + args[fileIdx] + "\")"); + return; + } + + // repl loop + RE(repl_env, "(println (str \"Mal [\" *host-language* \"]\"))"); + while (true) { + string line; + try { + line = Mal.readline.Readline(prompt); + if (line == null) { break; } + } catch (IOException e) { + Console.WriteLine("IOException: " + e.Message); + break; + } + try { + Console.WriteLine(PRINT(RE(repl_env, line))); + } catch (Mal.types.MalContinue) { + continue; + } catch (Mal.types.MalException e) { + Console.WriteLine("Error: " + + printer._pr_str(e.getValue(), false)); + continue; + } catch (Exception e) { + Console.WriteLine("Error: " + e.Message); + Console.WriteLine(e.StackTrace); + continue; + } + } + } + } +} diff --git a/cs/stepA_interop.cs b/cs/stepA_interop.cs new file mode 100644 index 0000000..632d18d --- /dev/null +++ b/cs/stepA_interop.cs @@ -0,0 +1,288 @@ +using System; +using System.IO; +using System.Collections; +using System.Collections.Generic; +using Mal; +using MalVal = Mal.types.MalVal; +using MalString = Mal.types.MalString; +using MalSymbol = Mal.types.MalSymbol; +using MalInteger = Mal.types.MalInteger; +using MalList = Mal.types.MalList; +using MalVector = Mal.types.MalVector; +using MalHashMap = Mal.types.MalHashMap; +using MalFunction = Mal.types.MalFunction; +using Env = Mal.env.Env; + +namespace Mal { + class stepA_interop { + // read + static MalVal READ(string str) { + return reader.read_str(str); + } + + // eval + public static bool is_pair(MalVal x) { + return x is MalList && ((MalList)x).size() > 0; + } + + public static MalVal quasiquote(MalVal ast) { + if (!is_pair(ast)) { + return new MalList(new MalSymbol("quote"), ast); + } else { + MalVal a0 = ((MalList)ast)[0]; + if ((a0 is MalSymbol) && + (((MalSymbol)a0).getName() == "unquote")) { + return ((MalList)ast)[1]; + } else if (is_pair(a0)) { + MalVal a00 = ((MalList)a0)[0]; + if ((a00 is MalSymbol) && + (((MalSymbol)a00).getName() == "splice-unquote")) { + return new MalList(new MalSymbol("concat"), + ((MalList)a0)[1], + quasiquote(((MalList)ast).rest())); + } + } + return new MalList(new MalSymbol("cons"), + quasiquote(a0), + quasiquote(((MalList)ast).rest())); + } + } + + public static bool is_macro_call(MalVal ast, Env env) { + if (ast is MalList) { + MalVal a0 = ((MalList)ast)[0]; + if (a0 is MalSymbol && + env.find(((MalSymbol)a0).getName()) != null) { + MalVal mac = env.get(((MalSymbol)a0).getName()); + if (mac is MalFunction && + ((MalFunction)mac).isMacro()) { + return true; + } + } + } + return false; + } + + public static MalVal macroexpand(MalVal ast, Env env) { + while (is_macro_call(ast, env)) { + MalSymbol a0 = (MalSymbol)((MalList)ast)[0]; + MalFunction mac = (MalFunction) env.get(a0.getName()); + ast = mac.apply(((MalList)ast).rest()); + } + return ast; + } + + static MalVal eval_ast(MalVal ast, Env env) { + if (ast is MalSymbol) { + MalSymbol sym = (MalSymbol)ast; + return env.get(sym.getName()); + } else if (ast is MalList) { + MalList old_lst = (MalList)ast; + MalList new_lst = ast.list_Q() ? new MalList() + : (MalList)new MalVector(); + foreach (MalVal mv in old_lst.getValue()) { + new_lst.conj_BANG(EVAL(mv, env)); + } + return new_lst; + } else if (ast is MalHashMap) { + var new_dict = new Dictionary(); + foreach (var entry in ((MalHashMap)ast).getValue()) { + new_dict.Add(entry.Key, EVAL((MalVal)entry.Value, env)); + } + return new MalHashMap(new_dict); + } else { + return ast; + } + } + + + static MalVal EVAL(MalVal orig_ast, Env env) { + MalVal a0, a1, a2, res; + MalList el; + + while (true) { + + //System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); + if (!orig_ast.list_Q()) { + return eval_ast(orig_ast, env); + } + + // apply list + MalVal expanded = macroexpand(orig_ast, env); + if (!expanded.list_Q()) { return expanded; } + MalList ast = (MalList) expanded; + + if (ast.size() == 0) { return ast; } + a0 = ast[0]; + + String a0sym = a0 is MalSymbol ? ((MalSymbol)a0).getName() + : "__<*fn*>__"; + + switch (a0sym) { + case "def!": + a1 = ast[1]; + a2 = ast[2]; + res = EVAL(a2, env); + env.set(((MalSymbol)a1).getName(), res); + return res; + case "let*": + a1 = ast[1]; + a2 = ast[2]; + MalSymbol key; + MalVal val; + Env let_env = new Env(env); + for(int i=0; i<((MalList)a1).size(); i+=2) { + key = (MalSymbol)((MalList)a1)[i]; + val = ((MalList)a1)[i+1]; + let_env.set(key.getName(), EVAL(val, let_env)); + } + orig_ast = a2; + env = let_env; + break; + case "quote": + return ast[1]; + case "quasiquote": + orig_ast = quasiquote(ast[1]); + break; + case "defmacro!": + a1 = ast[1]; + a2 = ast[2]; + res = EVAL(a2, env); + ((MalFunction)res).setMacro(); + env.set(((MalSymbol)a1).getName(), res); + return res; + case "macroexpand": + a1 = ast[1]; + return macroexpand(a1, env); + case "try*": + try { + return EVAL(ast[1], env); + } catch (Exception e) { + if (ast.size() > 2) { + MalVal exc; + a2 = ast[2]; + MalVal a20 = ((MalList)a2)[0]; + if (((MalSymbol)a20).getName() == "catch*") { + if (e is Mal.types.MalException) { + exc = ((Mal.types.MalException)e).getValue(); + } else { + exc = new MalString(e.StackTrace); + } + return EVAL(((MalList)a2)[2], + new Env(env, ((MalList)a2).slice(1,2), + new MalList(exc))); + } + } + throw e; + } + case "do": + eval_ast(ast.slice(1, ast.size()-1), env); + orig_ast = ast[ast.size()-1]; + break; + case "if": + a1 = ast[1]; + MalVal cond = EVAL(a1, env); + if (cond == Mal.types.Nil || cond == Mal.types.False) { + // eval false slot form + if (ast.size() > 3) { + orig_ast = ast[3]; + } else { + return Mal.types.Nil; + } + } else { + // eval true slot form + orig_ast = ast[2]; + } + break; + case "fn*": + MalList a1f = (MalList)ast[1]; + MalVal a2f = ast[2]; + Env cur_env = env; + return new MalFunction(a2f, env, a1f, + args => EVAL(a2f, new Env(cur_env, a1f, args)) ); + default: + el = (MalList)eval_ast(ast, env); + var f = (MalFunction)el[0]; + MalVal fnast = f.getAst(); + if (fnast != null) { + orig_ast = fnast; + env = f.genEnv(el.rest()); + } else { + return f.apply(el.rest()); + } + break; + } + + } + } + + // print + static string PRINT(MalVal exp) { + return printer._pr_str(exp, true); + } + + // repl + static MalVal RE(Env env, string str) { + return EVAL(READ(str), env); + } + + static void Main(string[] args) { + string prompt = "user> "; + + // core.cs: defined using C# + var repl_env = new env.Env(null); + foreach (var entry in core.ns) { + repl_env.set(entry.Key, entry.Value); + } + repl_env.set("eval", new MalFunction(a => EVAL(a[0], repl_env))); + MalList _argv = new MalList(); + for (int i=1; i < args.Length; i++) { + _argv.conj_BANG(new MalString(args[i])); + } + repl_env.set("*ARGV*", _argv); + + // core.mal: defined using the language itself + RE(repl_env, "(def! *host-language* \"c#\")"); + RE(repl_env, "(def! not (fn* (a) (if a false true)))"); + RE(repl_env, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); + RE(repl_env, "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); + RE(repl_env, "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); + + int fileIdx = 0; + if (args.Length > 0 && args[0] == "--raw") { + Mal.readline.mode = Mal.readline.Mode.Raw; + fileIdx = 1; + } + if (args.Length > fileIdx) { + RE(repl_env, "(load-file \"" + args[fileIdx] + "\")"); + return; + } + + // repl loop + RE(repl_env, "(println (str \"Mal [\" *host-language* \"]\"))"); + while (true) { + string line; + try { + line = Mal.readline.Readline(prompt); + if (line == null) { break; } + } catch (IOException e) { + Console.WriteLine("IOException: " + e.Message); + break; + } + try { + Console.WriteLine(PRINT(RE(repl_env, line))); + } catch (Mal.types.MalContinue) { + continue; + } catch (Mal.types.MalException e) { + Console.WriteLine("Error: " + + printer._pr_str(e.getValue(), false)); + continue; + } catch (Exception e) { + Console.WriteLine("Error: " + e.Message); + Console.WriteLine(e.StackTrace); + continue; + } + } + } + } +} diff --git a/cs/stepA_more.cs b/cs/stepA_more.cs deleted file mode 100644 index 486c344..0000000 --- a/cs/stepA_more.cs +++ /dev/null @@ -1,288 +0,0 @@ -using System; -using System.IO; -using System.Collections; -using System.Collections.Generic; -using Mal; -using MalVal = Mal.types.MalVal; -using MalString = Mal.types.MalString; -using MalSymbol = Mal.types.MalSymbol; -using MalInteger = Mal.types.MalInteger; -using MalList = Mal.types.MalList; -using MalVector = Mal.types.MalVector; -using MalHashMap = Mal.types.MalHashMap; -using MalFunction = Mal.types.MalFunction; -using Env = Mal.env.Env; - -namespace Mal { - class stepA_more { - // read - static MalVal READ(string str) { - return reader.read_str(str); - } - - // eval - public static bool is_pair(MalVal x) { - return x is MalList && ((MalList)x).size() > 0; - } - - public static MalVal quasiquote(MalVal ast) { - if (!is_pair(ast)) { - return new MalList(new MalSymbol("quote"), ast); - } else { - MalVal a0 = ((MalList)ast)[0]; - if ((a0 is MalSymbol) && - (((MalSymbol)a0).getName() == "unquote")) { - return ((MalList)ast)[1]; - } else if (is_pair(a0)) { - MalVal a00 = ((MalList)a0)[0]; - if ((a00 is MalSymbol) && - (((MalSymbol)a00).getName() == "splice-unquote")) { - return new MalList(new MalSymbol("concat"), - ((MalList)a0)[1], - quasiquote(((MalList)ast).rest())); - } - } - return new MalList(new MalSymbol("cons"), - quasiquote(a0), - quasiquote(((MalList)ast).rest())); - } - } - - public static bool is_macro_call(MalVal ast, Env env) { - if (ast is MalList) { - MalVal a0 = ((MalList)ast)[0]; - if (a0 is MalSymbol && - env.find(((MalSymbol)a0).getName()) != null) { - MalVal mac = env.get(((MalSymbol)a0).getName()); - if (mac is MalFunction && - ((MalFunction)mac).isMacro()) { - return true; - } - } - } - return false; - } - - public static MalVal macroexpand(MalVal ast, Env env) { - while (is_macro_call(ast, env)) { - MalSymbol a0 = (MalSymbol)((MalList)ast)[0]; - MalFunction mac = (MalFunction) env.get(a0.getName()); - ast = mac.apply(((MalList)ast).rest()); - } - return ast; - } - - static MalVal eval_ast(MalVal ast, Env env) { - if (ast is MalSymbol) { - MalSymbol sym = (MalSymbol)ast; - return env.get(sym.getName()); - } else if (ast is MalList) { - MalList old_lst = (MalList)ast; - MalList new_lst = ast.list_Q() ? new MalList() - : (MalList)new MalVector(); - foreach (MalVal mv in old_lst.getValue()) { - new_lst.conj_BANG(EVAL(mv, env)); - } - return new_lst; - } else if (ast is MalHashMap) { - var new_dict = new Dictionary(); - foreach (var entry in ((MalHashMap)ast).getValue()) { - new_dict.Add(entry.Key, EVAL((MalVal)entry.Value, env)); - } - return new MalHashMap(new_dict); - } else { - return ast; - } - } - - - static MalVal EVAL(MalVal orig_ast, Env env) { - MalVal a0, a1, a2, res; - MalList el; - - while (true) { - - //System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); - if (!orig_ast.list_Q()) { - return eval_ast(orig_ast, env); - } - - // apply list - MalVal expanded = macroexpand(orig_ast, env); - if (!expanded.list_Q()) { return expanded; } - MalList ast = (MalList) expanded; - - if (ast.size() == 0) { return ast; } - a0 = ast[0]; - - String a0sym = a0 is MalSymbol ? ((MalSymbol)a0).getName() - : "__<*fn*>__"; - - switch (a0sym) { - case "def!": - a1 = ast[1]; - a2 = ast[2]; - res = EVAL(a2, env); - env.set(((MalSymbol)a1).getName(), res); - return res; - case "let*": - a1 = ast[1]; - a2 = ast[2]; - MalSymbol key; - MalVal val; - Env let_env = new Env(env); - for(int i=0; i<((MalList)a1).size(); i+=2) { - key = (MalSymbol)((MalList)a1)[i]; - val = ((MalList)a1)[i+1]; - let_env.set(key.getName(), EVAL(val, let_env)); - } - orig_ast = a2; - env = let_env; - break; - case "quote": - return ast[1]; - case "quasiquote": - orig_ast = quasiquote(ast[1]); - break; - case "defmacro!": - a1 = ast[1]; - a2 = ast[2]; - res = EVAL(a2, env); - ((MalFunction)res).setMacro(); - env.set(((MalSymbol)a1).getName(), res); - return res; - case "macroexpand": - a1 = ast[1]; - return macroexpand(a1, env); - case "try*": - try { - return EVAL(ast[1], env); - } catch (Exception e) { - if (ast.size() > 2) { - MalVal exc; - a2 = ast[2]; - MalVal a20 = ((MalList)a2)[0]; - if (((MalSymbol)a20).getName() == "catch*") { - if (e is Mal.types.MalException) { - exc = ((Mal.types.MalException)e).getValue(); - } else { - exc = new MalString(e.StackTrace); - } - return EVAL(((MalList)a2)[2], - new Env(env, ((MalList)a2).slice(1,2), - new MalList(exc))); - } - } - throw e; - } - case "do": - eval_ast(ast.slice(1, ast.size()-1), env); - orig_ast = ast[ast.size()-1]; - break; - case "if": - a1 = ast[1]; - MalVal cond = EVAL(a1, env); - if (cond == Mal.types.Nil || cond == Mal.types.False) { - // eval false slot form - if (ast.size() > 3) { - orig_ast = ast[3]; - } else { - return Mal.types.Nil; - } - } else { - // eval true slot form - orig_ast = ast[2]; - } - break; - case "fn*": - MalList a1f = (MalList)ast[1]; - MalVal a2f = ast[2]; - Env cur_env = env; - return new MalFunction(a2f, env, a1f, - args => EVAL(a2f, new Env(cur_env, a1f, args)) ); - default: - el = (MalList)eval_ast(ast, env); - var f = (MalFunction)el[0]; - MalVal fnast = f.getAst(); - if (fnast != null) { - orig_ast = fnast; - env = f.genEnv(el.rest()); - } else { - return f.apply(el.rest()); - } - break; - } - - } - } - - // print - static string PRINT(MalVal exp) { - return printer._pr_str(exp, true); - } - - // repl - static MalVal RE(Env env, string str) { - return EVAL(READ(str), env); - } - - static void Main(string[] args) { - string prompt = "user> "; - - // core.cs: defined using C# - var repl_env = new env.Env(null); - foreach (var entry in core.ns) { - repl_env.set(entry.Key, entry.Value); - } - repl_env.set("eval", new MalFunction(a => EVAL(a[0], repl_env))); - MalList _argv = new MalList(); - for (int i=1; i < args.Length; i++) { - _argv.conj_BANG(new MalString(args[i])); - } - repl_env.set("*ARGV*", _argv); - - // core.mal: defined using the language itself - RE(repl_env, "(def! *host-language* \"c#\")"); - RE(repl_env, "(def! not (fn* (a) (if a false true)))"); - RE(repl_env, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); - RE(repl_env, "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); - RE(repl_env, "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); - - int fileIdx = 0; - if (args.Length > 0 && args[0] == "--raw") { - Mal.readline.mode = Mal.readline.Mode.Raw; - fileIdx = 1; - } - if (args.Length > fileIdx) { - RE(repl_env, "(load-file \"" + args[fileIdx] + "\")"); - return; - } - - // repl loop - RE(repl_env, "(println (str \"Mal [\" *host-language* \"]\"))"); - while (true) { - string line; - try { - line = Mal.readline.Readline(prompt); - if (line == null) { break; } - } catch (IOException e) { - Console.WriteLine("IOException: " + e.Message); - break; - } - try { - Console.WriteLine(PRINT(RE(repl_env, line))); - } catch (Mal.types.MalContinue) { - continue; - } catch (Mal.types.MalException e) { - Console.WriteLine("Error: " + - printer._pr_str(e.getValue(), false)); - continue; - } catch (Exception e) { - Console.WriteLine("Error: " + e.Message); - Console.WriteLine(e.StackTrace); - continue; - } - } - } - } -} diff --git a/docs/TODO b/docs/TODO index 2464293..6f0b2d0 100644 --- a/docs/TODO +++ b/docs/TODO @@ -6,7 +6,7 @@ All: - keyword type - gensym reader inside quasiquote - - per impl tests for step5_tco, step9_interop (if possible) + - per impl tests for step5_tco (if possible) - regular expression matching in runtest - Print full exception when test gets EOF from expect @@ -17,6 +17,8 @@ All: - Move try* to step6 - Remove macros from mal + - Implement/fix interop: C#, Java, Mal, PHP, Postscript, Ruby + --------------------------------------------- Bash: @@ -28,7 +30,6 @@ C: - GC C#: - - step9_interop Clojure: @@ -37,7 +38,6 @@ Go: https://gobyexample.com/variadic-functions Java: - - step9_interop - Use gradle instead of mvn http://blog.paralleluniverse.co/2014/05/01/modern-java/ @@ -51,7 +51,6 @@ Make: Mal: - line numbers in errors - step5_tco - - step9_interop Perl: - fix metadata on native functions @@ -62,7 +61,8 @@ Postscript: - add negative numbers Python: - - error: python ../python/stepA_more.py ../mal/stepA_more.mal ../mal/stepA_more.mal + - error: python ../python/stepA_interop.py ../mal/stepA_interop.mal ../mal/stepA_interop.mal + - interop tests Ruby: diff --git a/go/Makefile b/go/Makefile index 18faa4f..4b32a0b 100644 --- a/go/Makefile +++ b/go/Makefile @@ -5,14 +5,14 @@ export GOPATH := $(dir $(abspath $(lastword $(MAKEFILE_LIST)))) SOURCES_BASE = src/types/types.go src/readline/readline.go \ src/reader/reader.go src/printer/printer.go \ src/env/env.go src/core/core.go -SOURCES_LISP = src/stepA_more/stepA_more.go +SOURCES_LISP = src/stepA_interop/stepA_interop.go SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) ##################### SRCS = step0_repl.go step1_read_print.go step2_eval.go step3_env.go \ step4_if_fn_do.go step5_tco.go step6_file.go step7_quote.go \ - step8_macros.go stepA_more.go + step8_macros.go step9_try.go stepA_interop.go BINS = $(SRCS:%.go=%) ##################### diff --git a/go/src/step9_try/step9_try.go b/go/src/step9_try/step9_try.go new file mode 100644 index 0000000..322ee36 --- /dev/null +++ b/go/src/step9_try/step9_try.go @@ -0,0 +1,306 @@ +package main + +import ( + "fmt" + "strings" + "errors" + "os" +) + +import ( + "readline" + . "types" + "reader" + "printer" + . "env" + "core" +) + +// read +func READ(str string) (MalType, error) { + return reader.Read_str(str) +} + +// eval +func is_pair(x MalType) bool { + slc, e := GetSlice(x) + if e != nil { return false } + return len(slc) > 0 +} + +func quasiquote(ast MalType) MalType { + if !is_pair(ast) { + return List{[]MalType{Symbol{"quote"}, ast},nil} + } else { + slc, _ := GetSlice(ast) + a0 := slc[0] + if Symbol_Q(a0) && (a0.(Symbol).Val == "unquote") { + return slc[1] + } else if is_pair(a0) { + slc0, _ := GetSlice(a0) + a00 := slc0[0] + if Symbol_Q(a00) && (a00.(Symbol).Val == "splice-unquote") { + return List{[]MalType{Symbol{"concat"}, + slc0[1], + quasiquote(List{slc[1:],nil})},nil} + } + } + return List{[]MalType{Symbol{"cons"}, + quasiquote(a0), + quasiquote(List{slc[1:],nil})},nil} + } +} + +func is_macro_call(ast MalType, env EnvType) bool { + if List_Q(ast) { + slc, _ := GetSlice(ast) + a0 := slc[0] + if Symbol_Q(a0) && env.Find(a0.(Symbol).Val) != nil { + mac, e := env.Get(a0.(Symbol).Val) + if e != nil { return false } + if MalFunc_Q(mac) { + return mac.(MalFunc).GetMacro() + } + } + } + return false +} + +func macroexpand(ast MalType, env EnvType) (MalType, error) { + var mac MalType + var e error + for ; is_macro_call(ast, env) ; { + slc, _ := GetSlice(ast) + a0 := slc[0] + mac, e = env.Get(a0.(Symbol).Val); if e != nil { return nil, e } + fn := mac.(MalFunc) + ast, e = Apply(fn, slc[1:]); if e != nil { return nil, e } + } + return ast, nil +} + +func eval_ast(ast MalType, env EnvType) (MalType, error) { + //fmt.Printf("eval_ast: %#v\n", ast) + if Symbol_Q(ast) { + return env.Get(ast.(Symbol).Val) + } else if List_Q(ast) { + lst := []MalType{} + for _, a := range ast.(List).Val { + exp, e := EVAL(a, env) + if e != nil { return nil, e } + lst = append(lst, exp) + } + return List{lst,nil}, nil + } else if Vector_Q(ast) { + lst := []MalType{} + for _, a := range ast.(Vector).Val { + exp, e := EVAL(a, env) + if e != nil { return nil, e } + lst = append(lst, exp) + } + return Vector{lst,nil}, nil + } else if HashMap_Q(ast) { + m := ast.(HashMap) + new_hm := HashMap{map[string]MalType{},nil} + for k, v := range m.Val { + ke, e1 := EVAL(k, env) + if e1 != nil { return nil, e1 } + if _, ok := ke.(string); !ok { + return nil, errors.New("non string hash-map key") + } + kv, e2 := EVAL(v, env) + if e2 != nil { return nil, e2 } + new_hm.Val[ke.(string)] = kv + } + return new_hm, nil + } else { + return ast, nil + } +} + +func EVAL(ast MalType, env EnvType) (MalType, error) { + var e error + for { + + //fmt.Printf("EVAL: %v\n", printer.Pr_str(ast, true)) + switch ast.(type) { + case List: // continue + default: return eval_ast(ast, env) + } + + // apply list + ast, e = macroexpand(ast, env); if e != nil { return nil, e } + if (!List_Q(ast)) { return ast, nil } + + a0 := ast.(List).Val[0] + var a1 MalType = nil; var a2 MalType = nil + switch len(ast.(List).Val) { + case 1: + a1 = nil; a2 = nil + case 2: + a1 = ast.(List).Val[1]; a2 = nil + default: + a1 = ast.(List).Val[1]; a2 = ast.(List).Val[2] + } + a0sym := "__<*fn*>__" + if Symbol_Q(a0) { a0sym = a0.(Symbol).Val } + switch a0sym { + case "def!": + res, e := EVAL(a2, env) + if e != nil { return nil, e } + return env.Set(a1.(Symbol).Val, res), nil + case "let*": + let_env, e := NewEnv(env, nil, nil) + if e != nil { return nil, e } + arr1, e := GetSlice(a1) + if e != nil { return nil, e } + for i := 0; i < len(arr1); i+=2 { + if !Symbol_Q(arr1[i]) { + return nil, errors.New("non-symbol bind value") + } + exp, e := EVAL(arr1[i+1], let_env) + if e != nil { return nil, e } + let_env.Set(arr1[i].(Symbol).Val, exp) + } + ast = a2 + env = let_env + case "quote": + return a1, nil + case "quasiquote": + ast = quasiquote(a1) + case "defmacro!": + fn, e := EVAL(a2, env) + fn = fn.(MalFunc).SetMacro() + if e != nil { return nil, e } + return env.Set(a1.(Symbol).Val, fn), nil + case "macroexpand": + return macroexpand(a1, env) + case "try*": + var exc MalType + exp, e := EVAL(a1, env) + if e == nil { + return exp, nil + } else { + if a2 != nil && List_Q(a2) { + a2s, _ := GetSlice(a2) + if Symbol_Q(a2s[0]) && (a2s[0].(Symbol).Val == "catch*") { + switch e.(type) { + case MalError: exc = e.(MalError).Obj + default: exc = e.Error() + } + binds := NewList(a2s[1]) + new_env, e := NewEnv(env, binds, NewList(exc)) + if e != nil { return nil, e } + exp, e = EVAL(a2s[2], new_env) + if e == nil { return exp, nil } + } + } + return nil, e + } + case "do": + lst := ast.(List).Val + _, e := eval_ast(List{lst[1:len(lst)-1],nil}, env) + if e != nil { return nil, e } + if len(lst) == 1 { return nil, nil } + ast = lst[len(lst)-1] + case "if": + cond, e := EVAL(a1, env) + if e != nil { return nil, e } + if cond == nil || cond == false { + if len(ast.(List).Val) >= 4 { + ast = ast.(List).Val[3] + } else { + return nil, nil + } + } else { + ast = a2 + } + case "fn*": + fn := MalFunc{EVAL, a2, env, a1, false, NewEnv, nil} + return fn, nil + default: + el, e := eval_ast(ast, env) + if e != nil { return nil, e } + f := el.(List).Val[0] + if MalFunc_Q(f) { + fn := f.(MalFunc) + ast = fn.Exp + env, e = NewEnv(fn.Env, fn.Params, List{el.(List).Val[1:],nil}) + if e != nil { return nil, e } + } else { + fn, ok := f.(Func) + if !ok { return nil, errors.New("attempt to call non-function") } + return fn.Fn(el.(List).Val[1:]) + } + } + + } // TCO loop +} + +// print +func PRINT(exp MalType) (string, error) { + return printer.Pr_str(exp, true), nil +} + + +var repl_env, _ = NewEnv(nil, nil, nil) + +// repl +func rep(str string) (MalType, error) { + var exp MalType + var res string + var e error + if exp, e = READ(str); e != nil { return nil, e } + if exp, e = EVAL(exp, repl_env); e != nil { return nil, e } + if res, e = PRINT(exp); e != nil { return nil, e } + return res, nil +} + +func main() { + // core.go: defined using go + for k, v := range core.NS { + repl_env.Set(k, Func{v.(func([]MalType)(MalType,error)),nil}) + } + repl_env.Set("eval", Func{func(a []MalType) (MalType, error) { + return EVAL(a[0], repl_env) },nil}) + repl_env.Set("*ARGV*", List{}) + + // core.mal: defined using the language itself + rep("(def! *host-language* \"go\")") + rep("(def! not (fn* (a) (if a false true)))") + rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") + rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") + + // called with mal script to load and eval + if len(os.Args) > 1 { + args := make([]MalType, 0, len(os.Args)-2) + for _,a := range os.Args[2:] { + args = append(args, a) + } + repl_env.Set("*ARGV*", List{args,nil}) + if _,e := rep("(load-file \"" + os.Args[1] + "\")"); e != nil { + fmt.Printf("Error: %v\n", e) + os.Exit(1) + } + os.Exit(0) + } + + // repl loop + rep("(println (str \"Mal [\" *host-language* \"]\"))") + for { + text, err := readline.Readline("user> ") + text = strings.TrimRight(text, "\n"); + if (err != nil) { + return + } + var out MalType + var e error + if out, e = rep(text); e != nil { + if e.Error() == "" { continue } + fmt.Printf("Error: %v\n", e) + continue + } + fmt.Printf("%v\n", out) + } +} diff --git a/go/src/stepA_interop/stepA_interop.go b/go/src/stepA_interop/stepA_interop.go new file mode 100644 index 0000000..322ee36 --- /dev/null +++ b/go/src/stepA_interop/stepA_interop.go @@ -0,0 +1,306 @@ +package main + +import ( + "fmt" + "strings" + "errors" + "os" +) + +import ( + "readline" + . "types" + "reader" + "printer" + . "env" + "core" +) + +// read +func READ(str string) (MalType, error) { + return reader.Read_str(str) +} + +// eval +func is_pair(x MalType) bool { + slc, e := GetSlice(x) + if e != nil { return false } + return len(slc) > 0 +} + +func quasiquote(ast MalType) MalType { + if !is_pair(ast) { + return List{[]MalType{Symbol{"quote"}, ast},nil} + } else { + slc, _ := GetSlice(ast) + a0 := slc[0] + if Symbol_Q(a0) && (a0.(Symbol).Val == "unquote") { + return slc[1] + } else if is_pair(a0) { + slc0, _ := GetSlice(a0) + a00 := slc0[0] + if Symbol_Q(a00) && (a00.(Symbol).Val == "splice-unquote") { + return List{[]MalType{Symbol{"concat"}, + slc0[1], + quasiquote(List{slc[1:],nil})},nil} + } + } + return List{[]MalType{Symbol{"cons"}, + quasiquote(a0), + quasiquote(List{slc[1:],nil})},nil} + } +} + +func is_macro_call(ast MalType, env EnvType) bool { + if List_Q(ast) { + slc, _ := GetSlice(ast) + a0 := slc[0] + if Symbol_Q(a0) && env.Find(a0.(Symbol).Val) != nil { + mac, e := env.Get(a0.(Symbol).Val) + if e != nil { return false } + if MalFunc_Q(mac) { + return mac.(MalFunc).GetMacro() + } + } + } + return false +} + +func macroexpand(ast MalType, env EnvType) (MalType, error) { + var mac MalType + var e error + for ; is_macro_call(ast, env) ; { + slc, _ := GetSlice(ast) + a0 := slc[0] + mac, e = env.Get(a0.(Symbol).Val); if e != nil { return nil, e } + fn := mac.(MalFunc) + ast, e = Apply(fn, slc[1:]); if e != nil { return nil, e } + } + return ast, nil +} + +func eval_ast(ast MalType, env EnvType) (MalType, error) { + //fmt.Printf("eval_ast: %#v\n", ast) + if Symbol_Q(ast) { + return env.Get(ast.(Symbol).Val) + } else if List_Q(ast) { + lst := []MalType{} + for _, a := range ast.(List).Val { + exp, e := EVAL(a, env) + if e != nil { return nil, e } + lst = append(lst, exp) + } + return List{lst,nil}, nil + } else if Vector_Q(ast) { + lst := []MalType{} + for _, a := range ast.(Vector).Val { + exp, e := EVAL(a, env) + if e != nil { return nil, e } + lst = append(lst, exp) + } + return Vector{lst,nil}, nil + } else if HashMap_Q(ast) { + m := ast.(HashMap) + new_hm := HashMap{map[string]MalType{},nil} + for k, v := range m.Val { + ke, e1 := EVAL(k, env) + if e1 != nil { return nil, e1 } + if _, ok := ke.(string); !ok { + return nil, errors.New("non string hash-map key") + } + kv, e2 := EVAL(v, env) + if e2 != nil { return nil, e2 } + new_hm.Val[ke.(string)] = kv + } + return new_hm, nil + } else { + return ast, nil + } +} + +func EVAL(ast MalType, env EnvType) (MalType, error) { + var e error + for { + + //fmt.Printf("EVAL: %v\n", printer.Pr_str(ast, true)) + switch ast.(type) { + case List: // continue + default: return eval_ast(ast, env) + } + + // apply list + ast, e = macroexpand(ast, env); if e != nil { return nil, e } + if (!List_Q(ast)) { return ast, nil } + + a0 := ast.(List).Val[0] + var a1 MalType = nil; var a2 MalType = nil + switch len(ast.(List).Val) { + case 1: + a1 = nil; a2 = nil + case 2: + a1 = ast.(List).Val[1]; a2 = nil + default: + a1 = ast.(List).Val[1]; a2 = ast.(List).Val[2] + } + a0sym := "__<*fn*>__" + if Symbol_Q(a0) { a0sym = a0.(Symbol).Val } + switch a0sym { + case "def!": + res, e := EVAL(a2, env) + if e != nil { return nil, e } + return env.Set(a1.(Symbol).Val, res), nil + case "let*": + let_env, e := NewEnv(env, nil, nil) + if e != nil { return nil, e } + arr1, e := GetSlice(a1) + if e != nil { return nil, e } + for i := 0; i < len(arr1); i+=2 { + if !Symbol_Q(arr1[i]) { + return nil, errors.New("non-symbol bind value") + } + exp, e := EVAL(arr1[i+1], let_env) + if e != nil { return nil, e } + let_env.Set(arr1[i].(Symbol).Val, exp) + } + ast = a2 + env = let_env + case "quote": + return a1, nil + case "quasiquote": + ast = quasiquote(a1) + case "defmacro!": + fn, e := EVAL(a2, env) + fn = fn.(MalFunc).SetMacro() + if e != nil { return nil, e } + return env.Set(a1.(Symbol).Val, fn), nil + case "macroexpand": + return macroexpand(a1, env) + case "try*": + var exc MalType + exp, e := EVAL(a1, env) + if e == nil { + return exp, nil + } else { + if a2 != nil && List_Q(a2) { + a2s, _ := GetSlice(a2) + if Symbol_Q(a2s[0]) && (a2s[0].(Symbol).Val == "catch*") { + switch e.(type) { + case MalError: exc = e.(MalError).Obj + default: exc = e.Error() + } + binds := NewList(a2s[1]) + new_env, e := NewEnv(env, binds, NewList(exc)) + if e != nil { return nil, e } + exp, e = EVAL(a2s[2], new_env) + if e == nil { return exp, nil } + } + } + return nil, e + } + case "do": + lst := ast.(List).Val + _, e := eval_ast(List{lst[1:len(lst)-1],nil}, env) + if e != nil { return nil, e } + if len(lst) == 1 { return nil, nil } + ast = lst[len(lst)-1] + case "if": + cond, e := EVAL(a1, env) + if e != nil { return nil, e } + if cond == nil || cond == false { + if len(ast.(List).Val) >= 4 { + ast = ast.(List).Val[3] + } else { + return nil, nil + } + } else { + ast = a2 + } + case "fn*": + fn := MalFunc{EVAL, a2, env, a1, false, NewEnv, nil} + return fn, nil + default: + el, e := eval_ast(ast, env) + if e != nil { return nil, e } + f := el.(List).Val[0] + if MalFunc_Q(f) { + fn := f.(MalFunc) + ast = fn.Exp + env, e = NewEnv(fn.Env, fn.Params, List{el.(List).Val[1:],nil}) + if e != nil { return nil, e } + } else { + fn, ok := f.(Func) + if !ok { return nil, errors.New("attempt to call non-function") } + return fn.Fn(el.(List).Val[1:]) + } + } + + } // TCO loop +} + +// print +func PRINT(exp MalType) (string, error) { + return printer.Pr_str(exp, true), nil +} + + +var repl_env, _ = NewEnv(nil, nil, nil) + +// repl +func rep(str string) (MalType, error) { + var exp MalType + var res string + var e error + if exp, e = READ(str); e != nil { return nil, e } + if exp, e = EVAL(exp, repl_env); e != nil { return nil, e } + if res, e = PRINT(exp); e != nil { return nil, e } + return res, nil +} + +func main() { + // core.go: defined using go + for k, v := range core.NS { + repl_env.Set(k, Func{v.(func([]MalType)(MalType,error)),nil}) + } + repl_env.Set("eval", Func{func(a []MalType) (MalType, error) { + return EVAL(a[0], repl_env) },nil}) + repl_env.Set("*ARGV*", List{}) + + // core.mal: defined using the language itself + rep("(def! *host-language* \"go\")") + rep("(def! not (fn* (a) (if a false true)))") + rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") + rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") + + // called with mal script to load and eval + if len(os.Args) > 1 { + args := make([]MalType, 0, len(os.Args)-2) + for _,a := range os.Args[2:] { + args = append(args, a) + } + repl_env.Set("*ARGV*", List{args,nil}) + if _,e := rep("(load-file \"" + os.Args[1] + "\")"); e != nil { + fmt.Printf("Error: %v\n", e) + os.Exit(1) + } + os.Exit(0) + } + + // repl loop + rep("(println (str \"Mal [\" *host-language* \"]\"))") + for { + text, err := readline.Readline("user> ") + text = strings.TrimRight(text, "\n"); + if (err != nil) { + return + } + var out MalType + var e error + if out, e = rep(text); e != nil { + if e.Error() == "" { continue } + fmt.Printf("Error: %v\n", e) + continue + } + fmt.Printf("%v\n", out) + } +} diff --git a/go/src/stepA_more/stepA_more.go b/go/src/stepA_more/stepA_more.go deleted file mode 100644 index 322ee36..0000000 --- a/go/src/stepA_more/stepA_more.go +++ /dev/null @@ -1,306 +0,0 @@ -package main - -import ( - "fmt" - "strings" - "errors" - "os" -) - -import ( - "readline" - . "types" - "reader" - "printer" - . "env" - "core" -) - -// read -func READ(str string) (MalType, error) { - return reader.Read_str(str) -} - -// eval -func is_pair(x MalType) bool { - slc, e := GetSlice(x) - if e != nil { return false } - return len(slc) > 0 -} - -func quasiquote(ast MalType) MalType { - if !is_pair(ast) { - return List{[]MalType{Symbol{"quote"}, ast},nil} - } else { - slc, _ := GetSlice(ast) - a0 := slc[0] - if Symbol_Q(a0) && (a0.(Symbol).Val == "unquote") { - return slc[1] - } else if is_pair(a0) { - slc0, _ := GetSlice(a0) - a00 := slc0[0] - if Symbol_Q(a00) && (a00.(Symbol).Val == "splice-unquote") { - return List{[]MalType{Symbol{"concat"}, - slc0[1], - quasiquote(List{slc[1:],nil})},nil} - } - } - return List{[]MalType{Symbol{"cons"}, - quasiquote(a0), - quasiquote(List{slc[1:],nil})},nil} - } -} - -func is_macro_call(ast MalType, env EnvType) bool { - if List_Q(ast) { - slc, _ := GetSlice(ast) - a0 := slc[0] - if Symbol_Q(a0) && env.Find(a0.(Symbol).Val) != nil { - mac, e := env.Get(a0.(Symbol).Val) - if e != nil { return false } - if MalFunc_Q(mac) { - return mac.(MalFunc).GetMacro() - } - } - } - return false -} - -func macroexpand(ast MalType, env EnvType) (MalType, error) { - var mac MalType - var e error - for ; is_macro_call(ast, env) ; { - slc, _ := GetSlice(ast) - a0 := slc[0] - mac, e = env.Get(a0.(Symbol).Val); if e != nil { return nil, e } - fn := mac.(MalFunc) - ast, e = Apply(fn, slc[1:]); if e != nil { return nil, e } - } - return ast, nil -} - -func eval_ast(ast MalType, env EnvType) (MalType, error) { - //fmt.Printf("eval_ast: %#v\n", ast) - if Symbol_Q(ast) { - return env.Get(ast.(Symbol).Val) - } else if List_Q(ast) { - lst := []MalType{} - for _, a := range ast.(List).Val { - exp, e := EVAL(a, env) - if e != nil { return nil, e } - lst = append(lst, exp) - } - return List{lst,nil}, nil - } else if Vector_Q(ast) { - lst := []MalType{} - for _, a := range ast.(Vector).Val { - exp, e := EVAL(a, env) - if e != nil { return nil, e } - lst = append(lst, exp) - } - return Vector{lst,nil}, nil - } else if HashMap_Q(ast) { - m := ast.(HashMap) - new_hm := HashMap{map[string]MalType{},nil} - for k, v := range m.Val { - ke, e1 := EVAL(k, env) - if e1 != nil { return nil, e1 } - if _, ok := ke.(string); !ok { - return nil, errors.New("non string hash-map key") - } - kv, e2 := EVAL(v, env) - if e2 != nil { return nil, e2 } - new_hm.Val[ke.(string)] = kv - } - return new_hm, nil - } else { - return ast, nil - } -} - -func EVAL(ast MalType, env EnvType) (MalType, error) { - var e error - for { - - //fmt.Printf("EVAL: %v\n", printer.Pr_str(ast, true)) - switch ast.(type) { - case List: // continue - default: return eval_ast(ast, env) - } - - // apply list - ast, e = macroexpand(ast, env); if e != nil { return nil, e } - if (!List_Q(ast)) { return ast, nil } - - a0 := ast.(List).Val[0] - var a1 MalType = nil; var a2 MalType = nil - switch len(ast.(List).Val) { - case 1: - a1 = nil; a2 = nil - case 2: - a1 = ast.(List).Val[1]; a2 = nil - default: - a1 = ast.(List).Val[1]; a2 = ast.(List).Val[2] - } - a0sym := "__<*fn*>__" - if Symbol_Q(a0) { a0sym = a0.(Symbol).Val } - switch a0sym { - case "def!": - res, e := EVAL(a2, env) - if e != nil { return nil, e } - return env.Set(a1.(Symbol).Val, res), nil - case "let*": - let_env, e := NewEnv(env, nil, nil) - if e != nil { return nil, e } - arr1, e := GetSlice(a1) - if e != nil { return nil, e } - for i := 0; i < len(arr1); i+=2 { - if !Symbol_Q(arr1[i]) { - return nil, errors.New("non-symbol bind value") - } - exp, e := EVAL(arr1[i+1], let_env) - if e != nil { return nil, e } - let_env.Set(arr1[i].(Symbol).Val, exp) - } - ast = a2 - env = let_env - case "quote": - return a1, nil - case "quasiquote": - ast = quasiquote(a1) - case "defmacro!": - fn, e := EVAL(a2, env) - fn = fn.(MalFunc).SetMacro() - if e != nil { return nil, e } - return env.Set(a1.(Symbol).Val, fn), nil - case "macroexpand": - return macroexpand(a1, env) - case "try*": - var exc MalType - exp, e := EVAL(a1, env) - if e == nil { - return exp, nil - } else { - if a2 != nil && List_Q(a2) { - a2s, _ := GetSlice(a2) - if Symbol_Q(a2s[0]) && (a2s[0].(Symbol).Val == "catch*") { - switch e.(type) { - case MalError: exc = e.(MalError).Obj - default: exc = e.Error() - } - binds := NewList(a2s[1]) - new_env, e := NewEnv(env, binds, NewList(exc)) - if e != nil { return nil, e } - exp, e = EVAL(a2s[2], new_env) - if e == nil { return exp, nil } - } - } - return nil, e - } - case "do": - lst := ast.(List).Val - _, e := eval_ast(List{lst[1:len(lst)-1],nil}, env) - if e != nil { return nil, e } - if len(lst) == 1 { return nil, nil } - ast = lst[len(lst)-1] - case "if": - cond, e := EVAL(a1, env) - if e != nil { return nil, e } - if cond == nil || cond == false { - if len(ast.(List).Val) >= 4 { - ast = ast.(List).Val[3] - } else { - return nil, nil - } - } else { - ast = a2 - } - case "fn*": - fn := MalFunc{EVAL, a2, env, a1, false, NewEnv, nil} - return fn, nil - default: - el, e := eval_ast(ast, env) - if e != nil { return nil, e } - f := el.(List).Val[0] - if MalFunc_Q(f) { - fn := f.(MalFunc) - ast = fn.Exp - env, e = NewEnv(fn.Env, fn.Params, List{el.(List).Val[1:],nil}) - if e != nil { return nil, e } - } else { - fn, ok := f.(Func) - if !ok { return nil, errors.New("attempt to call non-function") } - return fn.Fn(el.(List).Val[1:]) - } - } - - } // TCO loop -} - -// print -func PRINT(exp MalType) (string, error) { - return printer.Pr_str(exp, true), nil -} - - -var repl_env, _ = NewEnv(nil, nil, nil) - -// repl -func rep(str string) (MalType, error) { - var exp MalType - var res string - var e error - if exp, e = READ(str); e != nil { return nil, e } - if exp, e = EVAL(exp, repl_env); e != nil { return nil, e } - if res, e = PRINT(exp); e != nil { return nil, e } - return res, nil -} - -func main() { - // core.go: defined using go - for k, v := range core.NS { - repl_env.Set(k, Func{v.(func([]MalType)(MalType,error)),nil}) - } - repl_env.Set("eval", Func{func(a []MalType) (MalType, error) { - return EVAL(a[0], repl_env) },nil}) - repl_env.Set("*ARGV*", List{}) - - // core.mal: defined using the language itself - rep("(def! *host-language* \"go\")") - rep("(def! not (fn* (a) (if a false true)))") - rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") - rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") - rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") - - // called with mal script to load and eval - if len(os.Args) > 1 { - args := make([]MalType, 0, len(os.Args)-2) - for _,a := range os.Args[2:] { - args = append(args, a) - } - repl_env.Set("*ARGV*", List{args,nil}) - if _,e := rep("(load-file \"" + os.Args[1] + "\")"); e != nil { - fmt.Printf("Error: %v\n", e) - os.Exit(1) - } - os.Exit(0) - } - - // repl loop - rep("(println (str \"Mal [\" *host-language* \"]\"))") - for { - text, err := readline.Readline("user> ") - text = strings.TrimRight(text, "\n"); - if (err != nil) { - return - } - var out MalType - var e error - if out, e = rep(text); e != nil { - if e.Error() == "" { continue } - fmt.Printf("Error: %v\n", e) - continue - } - fmt.Printf("%v\n", out) - } -} diff --git a/java/Makefile b/java/Makefile index 2e168c4..eff6e6f 100644 --- a/java/Makefile +++ b/java/Makefile @@ -5,7 +5,7 @@ TESTS = SOURCES_BASE = src/main/java/mal/readline.java src/main/java/mal/types.java \ src/main/java/mal/reader.java src/main/java/mal/printer.java SOURCES_LISP = src/main/java/mal/env.java src/main/java/mal/core.java \ - src/main/java/mal/stepA_more.java + src/main/java/mal/stepA_interop.java SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) #.PHONY: stats tests $(TESTS) diff --git a/java/src/main/java/mal/step9_try.java b/java/src/main/java/mal/step9_try.java new file mode 100644 index 0000000..c3b0e9f --- /dev/null +++ b/java/src/main/java/mal/step9_try.java @@ -0,0 +1,302 @@ +package mal; + +import java.io.IOException; + +import java.io.StringWriter; +import java.io.PrintWriter; +import java.util.List; +import java.util.Map; +import java.util.HashMap; +import java.util.Iterator; +import mal.types.*; +import mal.readline; +import mal.reader; +import mal.printer; +import mal.env.Env; +import mal.core; + +public class step9_try { + // read + public static MalVal READ(String str) throws MalThrowable { + return reader.read_str(str); + } + + // eval + public static Boolean is_pair(MalVal x) { + return x instanceof MalList && ((MalList)x).size() > 0; + } + + public static MalVal quasiquote(MalVal ast) { + if (!is_pair(ast)) { + return new MalList(new MalSymbol("quote"), ast); + } else { + MalVal a0 = ((MalList)ast).nth(0); + if ((a0 instanceof MalSymbol) && + (((MalSymbol)a0).getName() == "unquote")) { + return ((MalList)ast).nth(1); + } else if (is_pair(a0)) { + MalVal a00 = ((MalList)a0).nth(0); + if ((a00 instanceof MalSymbol) && + (((MalSymbol)a00).getName() == "splice-unquote")) { + return new MalList(new MalSymbol("concat"), + ((MalList)a0).nth(1), + quasiquote(((MalList)ast).rest())); + } + } + return new MalList(new MalSymbol("cons"), + quasiquote(a0), + quasiquote(((MalList)ast).rest())); + } + } + + public static Boolean is_macro_call(MalVal ast, Env env) + throws MalThrowable { + if (ast instanceof MalList) { + MalVal a0 = ((MalList)ast).nth(0); + if (a0 instanceof MalSymbol && + env.find(((MalSymbol)a0).getName()) != null) { + MalVal mac = env.get(((MalSymbol)a0).getName()); + if (mac instanceof MalFunction && + ((MalFunction)mac).isMacro()) { + return true; + } + } + } + return false; + } + + public static MalVal macroexpand(MalVal ast, Env env) + throws MalThrowable { + while (is_macro_call(ast, env)) { + MalSymbol a0 = (MalSymbol)((MalList)ast).nth(0); + MalFunction mac = (MalFunction) env.get(a0.getName()); + ast = mac.apply(((MalList)ast).rest()); + } + return ast; + } + + public static MalVal eval_ast(MalVal ast, Env env) throws MalThrowable { + if (ast instanceof MalSymbol) { + MalSymbol sym = (MalSymbol)ast; + return env.get(sym.getName()); + } else if (ast instanceof MalList) { + MalList old_lst = (MalList)ast; + MalList new_lst = ast.list_Q() ? new MalList() + : (MalList)new MalVector(); + for (MalVal mv : (List)old_lst.value) { + new_lst.conj_BANG(EVAL(mv, env)); + } + return new_lst; + } else if (ast instanceof MalHashMap) { + MalHashMap new_hm = new MalHashMap(); + Iterator it = ((MalHashMap)ast).value.entrySet().iterator(); + while (it.hasNext()) { + Map.Entry entry = (Map.Entry)it.next(); + new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); + } + return new_hm; + } else { + return ast; + } + } + + public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { + MalVal a0, a1,a2, a3, res; + MalList el; + + while (true) { + + //System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); + if (!orig_ast.list_Q()) { + return eval_ast(orig_ast, env); + } + + // apply list + MalVal expanded = macroexpand(orig_ast, env); + if (!expanded.list_Q()) { return expanded; } + MalList ast = (MalList) expanded; + if (ast.size() == 0) { return ast; } + a0 = ast.nth(0); + String a0sym = a0 instanceof MalSymbol ? ((MalSymbol)a0).getName() + : "__<*fn*>__"; + switch (a0sym) { + case "def!": + a1 = ast.nth(1); + a2 = ast.nth(2); + res = EVAL(a2, env); + env.set(((MalSymbol)a1).getName(), res); + return res; + case "let*": + a1 = ast.nth(1); + a2 = ast.nth(2); + MalSymbol key; + MalVal val; + Env let_env = new Env(env); + for(int i=0; i<((MalList)a1).size(); i+=2) { + key = (MalSymbol)((MalList)a1).nth(i); + val = ((MalList)a1).nth(i+1); + let_env.set(key.getName(), EVAL(val, let_env)); + } + orig_ast = a2; + env = let_env; + break; + case "quote": + return ast.nth(1); + case "quasiquote": + orig_ast = quasiquote(ast.nth(1)); + break; + case "defmacro!": + a1 = ast.nth(1); + a2 = ast.nth(2); + res = EVAL(a2, env); + ((MalFunction)res).setMacro(); + env.set(((MalSymbol)a1).getName(), res); + return res; + case "macroexpand": + a1 = ast.nth(1); + return macroexpand(a1, env); + case "try*": + try { + return EVAL(ast.nth(1), env); + } catch (Throwable t) { + if (ast.size() > 2) { + MalVal exc; + a2 = ast.nth(2); + MalVal a20 = ((MalList)a2).nth(0); + if (((MalSymbol)a20).getName().equals("catch*")) { + if (t instanceof MalException) { + exc = ((MalException)t).getValue(); + } else { + StringWriter sw = new StringWriter(); + t.printStackTrace(new PrintWriter(sw)); + String tstr = sw.toString(); + exc = new MalString(t.getMessage() + ": " + tstr); + } + return EVAL(((MalList)a2).nth(2), + new Env(env, ((MalList)a2).slice(1,2), + new MalList(exc))); + } + } + throw t; + } + case "do": + eval_ast(ast.slice(1, ast.size()-1), env); + orig_ast = ast.nth(ast.size()-1); + break; + case "if": + a1 = ast.nth(1); + MalVal cond = EVAL(a1, env); + if (cond == types.Nil || cond == types.False) { + // eval false slot form + if (ast.size() > 3) { + orig_ast = ast.nth(3); + } else { + return types.Nil; + } + } else { + // eval true slot form + orig_ast = ast.nth(2); + } + break; + case "fn*": + final MalList a1f = (MalList)ast.nth(1); + final MalVal a2f = ast.nth(2); + final Env cur_env = env; + return new MalFunction (a2f, (mal.env.Env)env, a1f) { + public MalVal apply(MalList args) throws MalThrowable { + return EVAL(a2f, new Env(cur_env, a1f, args)); + } + }; + default: + el = (MalList)eval_ast(ast, env); + MalFunction f = (MalFunction)el.nth(0); + MalVal fnast = f.getAst(); + if (fnast != null) { + orig_ast = fnast; + env = f.genEnv(el.slice(1)); + } else { + return f.apply(el.rest()); + } + } + + } + } + + // print + public static String PRINT(MalVal exp) { + return printer._pr_str(exp, true); + } + + // repl + public static MalVal RE(Env env, String str) throws MalThrowable { + return EVAL(READ(str), env); + } + + public static void main(String[] args) throws MalThrowable { + String prompt = "user> "; + + final Env repl_env = new Env(null); + + // core.java: defined using Java + for (String key : core.ns.keySet()) { + repl_env.set(key, core.ns.get(key)); + } + repl_env.set("eval", new MalFunction() { + public MalVal apply(MalList args) throws MalThrowable { + return EVAL(args.nth(0), repl_env); + } + }); + MalList _argv = new MalList(); + for (Integer i=1; i < args.length; i++) { + _argv.conj_BANG(new MalString(args[i])); + } + repl_env.set("*ARGV*", _argv); + + + // core.mal: defined using the language itself + RE(repl_env, "(def! *host-language* \"java\")"); + RE(repl_env, "(def! not (fn* (a) (if a false true)))"); + RE(repl_env, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); + RE(repl_env, "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); + RE(repl_env, "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); + + Integer fileIdx = 0; + if (args.length > 0 && args[0].equals("--raw")) { + readline.mode = readline.Mode.JAVA; + fileIdx = 1; + } + if (args.length > fileIdx) { + RE(repl_env, "(load-file \"" + args[fileIdx] + "\")"); + return; + } + + // repl loop + RE(repl_env, "(println (str \"Mal [\" *host-language* \"]\"))"); + while (true) { + String line; + try { + line = readline.readline(prompt); + if (line == null) { continue; } + } catch (readline.EOFException e) { + break; + } catch (IOException e) { + System.out.println("IOException: " + e.getMessage()); + break; + } + try { + System.out.println(PRINT(RE(repl_env, line))); + } catch (MalContinue e) { + continue; + } catch (MalException e) { + System.out.println("Error: " + printer._pr_str(e.getValue(), false)); + continue; + } catch (MalThrowable t) { + System.out.println("Error: " + t.getMessage()); + continue; + } catch (Throwable t) { + System.out.println("Uncaught " + t + ": " + t.getMessage()); + continue; + } + } + } +} diff --git a/java/src/main/java/mal/stepA_interop.java b/java/src/main/java/mal/stepA_interop.java new file mode 100644 index 0000000..75c0402 --- /dev/null +++ b/java/src/main/java/mal/stepA_interop.java @@ -0,0 +1,302 @@ +package mal; + +import java.io.IOException; + +import java.io.StringWriter; +import java.io.PrintWriter; +import java.util.List; +import java.util.Map; +import java.util.HashMap; +import java.util.Iterator; +import mal.types.*; +import mal.readline; +import mal.reader; +import mal.printer; +import mal.env.Env; +import mal.core; + +public class stepA_interop { + // read + public static MalVal READ(String str) throws MalThrowable { + return reader.read_str(str); + } + + // eval + public static Boolean is_pair(MalVal x) { + return x instanceof MalList && ((MalList)x).size() > 0; + } + + public static MalVal quasiquote(MalVal ast) { + if (!is_pair(ast)) { + return new MalList(new MalSymbol("quote"), ast); + } else { + MalVal a0 = ((MalList)ast).nth(0); + if ((a0 instanceof MalSymbol) && + (((MalSymbol)a0).getName() == "unquote")) { + return ((MalList)ast).nth(1); + } else if (is_pair(a0)) { + MalVal a00 = ((MalList)a0).nth(0); + if ((a00 instanceof MalSymbol) && + (((MalSymbol)a00).getName() == "splice-unquote")) { + return new MalList(new MalSymbol("concat"), + ((MalList)a0).nth(1), + quasiquote(((MalList)ast).rest())); + } + } + return new MalList(new MalSymbol("cons"), + quasiquote(a0), + quasiquote(((MalList)ast).rest())); + } + } + + public static Boolean is_macro_call(MalVal ast, Env env) + throws MalThrowable { + if (ast instanceof MalList) { + MalVal a0 = ((MalList)ast).nth(0); + if (a0 instanceof MalSymbol && + env.find(((MalSymbol)a0).getName()) != null) { + MalVal mac = env.get(((MalSymbol)a0).getName()); + if (mac instanceof MalFunction && + ((MalFunction)mac).isMacro()) { + return true; + } + } + } + return false; + } + + public static MalVal macroexpand(MalVal ast, Env env) + throws MalThrowable { + while (is_macro_call(ast, env)) { + MalSymbol a0 = (MalSymbol)((MalList)ast).nth(0); + MalFunction mac = (MalFunction) env.get(a0.getName()); + ast = mac.apply(((MalList)ast).rest()); + } + return ast; + } + + public static MalVal eval_ast(MalVal ast, Env env) throws MalThrowable { + if (ast instanceof MalSymbol) { + MalSymbol sym = (MalSymbol)ast; + return env.get(sym.getName()); + } else if (ast instanceof MalList) { + MalList old_lst = (MalList)ast; + MalList new_lst = ast.list_Q() ? new MalList() + : (MalList)new MalVector(); + for (MalVal mv : (List)old_lst.value) { + new_lst.conj_BANG(EVAL(mv, env)); + } + return new_lst; + } else if (ast instanceof MalHashMap) { + MalHashMap new_hm = new MalHashMap(); + Iterator it = ((MalHashMap)ast).value.entrySet().iterator(); + while (it.hasNext()) { + Map.Entry entry = (Map.Entry)it.next(); + new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); + } + return new_hm; + } else { + return ast; + } + } + + public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { + MalVal a0, a1,a2, a3, res; + MalList el; + + while (true) { + + //System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); + if (!orig_ast.list_Q()) { + return eval_ast(orig_ast, env); + } + + // apply list + MalVal expanded = macroexpand(orig_ast, env); + if (!expanded.list_Q()) { return expanded; } + MalList ast = (MalList) expanded; + if (ast.size() == 0) { return ast; } + a0 = ast.nth(0); + String a0sym = a0 instanceof MalSymbol ? ((MalSymbol)a0).getName() + : "__<*fn*>__"; + switch (a0sym) { + case "def!": + a1 = ast.nth(1); + a2 = ast.nth(2); + res = EVAL(a2, env); + env.set(((MalSymbol)a1).getName(), res); + return res; + case "let*": + a1 = ast.nth(1); + a2 = ast.nth(2); + MalSymbol key; + MalVal val; + Env let_env = new Env(env); + for(int i=0; i<((MalList)a1).size(); i+=2) { + key = (MalSymbol)((MalList)a1).nth(i); + val = ((MalList)a1).nth(i+1); + let_env.set(key.getName(), EVAL(val, let_env)); + } + orig_ast = a2; + env = let_env; + break; + case "quote": + return ast.nth(1); + case "quasiquote": + orig_ast = quasiquote(ast.nth(1)); + break; + case "defmacro!": + a1 = ast.nth(1); + a2 = ast.nth(2); + res = EVAL(a2, env); + ((MalFunction)res).setMacro(); + env.set(((MalSymbol)a1).getName(), res); + return res; + case "macroexpand": + a1 = ast.nth(1); + return macroexpand(a1, env); + case "try*": + try { + return EVAL(ast.nth(1), env); + } catch (Throwable t) { + if (ast.size() > 2) { + MalVal exc; + a2 = ast.nth(2); + MalVal a20 = ((MalList)a2).nth(0); + if (((MalSymbol)a20).getName().equals("catch*")) { + if (t instanceof MalException) { + exc = ((MalException)t).getValue(); + } else { + StringWriter sw = new StringWriter(); + t.printStackTrace(new PrintWriter(sw)); + String tstr = sw.toString(); + exc = new MalString(t.getMessage() + ": " + tstr); + } + return EVAL(((MalList)a2).nth(2), + new Env(env, ((MalList)a2).slice(1,2), + new MalList(exc))); + } + } + throw t; + } + case "do": + eval_ast(ast.slice(1, ast.size()-1), env); + orig_ast = ast.nth(ast.size()-1); + break; + case "if": + a1 = ast.nth(1); + MalVal cond = EVAL(a1, env); + if (cond == types.Nil || cond == types.False) { + // eval false slot form + if (ast.size() > 3) { + orig_ast = ast.nth(3); + } else { + return types.Nil; + } + } else { + // eval true slot form + orig_ast = ast.nth(2); + } + break; + case "fn*": + final MalList a1f = (MalList)ast.nth(1); + final MalVal a2f = ast.nth(2); + final Env cur_env = env; + return new MalFunction (a2f, (mal.env.Env)env, a1f) { + public MalVal apply(MalList args) throws MalThrowable { + return EVAL(a2f, new Env(cur_env, a1f, args)); + } + }; + default: + el = (MalList)eval_ast(ast, env); + MalFunction f = (MalFunction)el.nth(0); + MalVal fnast = f.getAst(); + if (fnast != null) { + orig_ast = fnast; + env = f.genEnv(el.slice(1)); + } else { + return f.apply(el.rest()); + } + } + + } + } + + // print + public static String PRINT(MalVal exp) { + return printer._pr_str(exp, true); + } + + // repl + public static MalVal RE(Env env, String str) throws MalThrowable { + return EVAL(READ(str), env); + } + + public static void main(String[] args) throws MalThrowable { + String prompt = "user> "; + + final Env repl_env = new Env(null); + + // core.java: defined using Java + for (String key : core.ns.keySet()) { + repl_env.set(key, core.ns.get(key)); + } + repl_env.set("eval", new MalFunction() { + public MalVal apply(MalList args) throws MalThrowable { + return EVAL(args.nth(0), repl_env); + } + }); + MalList _argv = new MalList(); + for (Integer i=1; i < args.length; i++) { + _argv.conj_BANG(new MalString(args[i])); + } + repl_env.set("*ARGV*", _argv); + + + // core.mal: defined using the language itself + RE(repl_env, "(def! *host-language* \"java\")"); + RE(repl_env, "(def! not (fn* (a) (if a false true)))"); + RE(repl_env, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); + RE(repl_env, "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); + RE(repl_env, "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); + + Integer fileIdx = 0; + if (args.length > 0 && args[0].equals("--raw")) { + readline.mode = readline.Mode.JAVA; + fileIdx = 1; + } + if (args.length > fileIdx) { + RE(repl_env, "(load-file \"" + args[fileIdx] + "\")"); + return; + } + + // repl loop + RE(repl_env, "(println (str \"Mal [\" *host-language* \"]\"))"); + while (true) { + String line; + try { + line = readline.readline(prompt); + if (line == null) { continue; } + } catch (readline.EOFException e) { + break; + } catch (IOException e) { + System.out.println("IOException: " + e.getMessage()); + break; + } + try { + System.out.println(PRINT(RE(repl_env, line))); + } catch (MalContinue e) { + continue; + } catch (MalException e) { + System.out.println("Error: " + printer._pr_str(e.getValue(), false)); + continue; + } catch (MalThrowable t) { + System.out.println("Error: " + t.getMessage()); + continue; + } catch (Throwable t) { + System.out.println("Uncaught " + t + ": " + t.getMessage()); + continue; + } + } + } +} diff --git a/java/src/main/java/mal/stepA_more.java b/java/src/main/java/mal/stepA_more.java deleted file mode 100644 index 7e869e6..0000000 --- a/java/src/main/java/mal/stepA_more.java +++ /dev/null @@ -1,302 +0,0 @@ -package mal; - -import java.io.IOException; - -import java.io.StringWriter; -import java.io.PrintWriter; -import java.util.List; -import java.util.Map; -import java.util.HashMap; -import java.util.Iterator; -import mal.types.*; -import mal.readline; -import mal.reader; -import mal.printer; -import mal.env.Env; -import mal.core; - -public class stepA_more { - // read - public static MalVal READ(String str) throws MalThrowable { - return reader.read_str(str); - } - - // eval - public static Boolean is_pair(MalVal x) { - return x instanceof MalList && ((MalList)x).size() > 0; - } - - public static MalVal quasiquote(MalVal ast) { - if (!is_pair(ast)) { - return new MalList(new MalSymbol("quote"), ast); - } else { - MalVal a0 = ((MalList)ast).nth(0); - if ((a0 instanceof MalSymbol) && - (((MalSymbol)a0).getName() == "unquote")) { - return ((MalList)ast).nth(1); - } else if (is_pair(a0)) { - MalVal a00 = ((MalList)a0).nth(0); - if ((a00 instanceof MalSymbol) && - (((MalSymbol)a00).getName() == "splice-unquote")) { - return new MalList(new MalSymbol("concat"), - ((MalList)a0).nth(1), - quasiquote(((MalList)ast).rest())); - } - } - return new MalList(new MalSymbol("cons"), - quasiquote(a0), - quasiquote(((MalList)ast).rest())); - } - } - - public static Boolean is_macro_call(MalVal ast, Env env) - throws MalThrowable { - if (ast instanceof MalList) { - MalVal a0 = ((MalList)ast).nth(0); - if (a0 instanceof MalSymbol && - env.find(((MalSymbol)a0).getName()) != null) { - MalVal mac = env.get(((MalSymbol)a0).getName()); - if (mac instanceof MalFunction && - ((MalFunction)mac).isMacro()) { - return true; - } - } - } - return false; - } - - public static MalVal macroexpand(MalVal ast, Env env) - throws MalThrowable { - while (is_macro_call(ast, env)) { - MalSymbol a0 = (MalSymbol)((MalList)ast).nth(0); - MalFunction mac = (MalFunction) env.get(a0.getName()); - ast = mac.apply(((MalList)ast).rest()); - } - return ast; - } - - public static MalVal eval_ast(MalVal ast, Env env) throws MalThrowable { - if (ast instanceof MalSymbol) { - MalSymbol sym = (MalSymbol)ast; - return env.get(sym.getName()); - } else if (ast instanceof MalList) { - MalList old_lst = (MalList)ast; - MalList new_lst = ast.list_Q() ? new MalList() - : (MalList)new MalVector(); - for (MalVal mv : (List)old_lst.value) { - new_lst.conj_BANG(EVAL(mv, env)); - } - return new_lst; - } else if (ast instanceof MalHashMap) { - MalHashMap new_hm = new MalHashMap(); - Iterator it = ((MalHashMap)ast).value.entrySet().iterator(); - while (it.hasNext()) { - Map.Entry entry = (Map.Entry)it.next(); - new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); - } - return new_hm; - } else { - return ast; - } - } - - public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { - MalVal a0, a1,a2, a3, res; - MalList el; - - while (true) { - - //System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); - if (!orig_ast.list_Q()) { - return eval_ast(orig_ast, env); - } - - // apply list - MalVal expanded = macroexpand(orig_ast, env); - if (!expanded.list_Q()) { return expanded; } - MalList ast = (MalList) expanded; - if (ast.size() == 0) { return ast; } - a0 = ast.nth(0); - String a0sym = a0 instanceof MalSymbol ? ((MalSymbol)a0).getName() - : "__<*fn*>__"; - switch (a0sym) { - case "def!": - a1 = ast.nth(1); - a2 = ast.nth(2); - res = EVAL(a2, env); - env.set(((MalSymbol)a1).getName(), res); - return res; - case "let*": - a1 = ast.nth(1); - a2 = ast.nth(2); - MalSymbol key; - MalVal val; - Env let_env = new Env(env); - for(int i=0; i<((MalList)a1).size(); i+=2) { - key = (MalSymbol)((MalList)a1).nth(i); - val = ((MalList)a1).nth(i+1); - let_env.set(key.getName(), EVAL(val, let_env)); - } - orig_ast = a2; - env = let_env; - break; - case "quote": - return ast.nth(1); - case "quasiquote": - orig_ast = quasiquote(ast.nth(1)); - break; - case "defmacro!": - a1 = ast.nth(1); - a2 = ast.nth(2); - res = EVAL(a2, env); - ((MalFunction)res).setMacro(); - env.set(((MalSymbol)a1).getName(), res); - return res; - case "macroexpand": - a1 = ast.nth(1); - return macroexpand(a1, env); - case "try*": - try { - return EVAL(ast.nth(1), env); - } catch (Throwable t) { - if (ast.size() > 2) { - MalVal exc; - a2 = ast.nth(2); - MalVal a20 = ((MalList)a2).nth(0); - if (((MalSymbol)a20).getName().equals("catch*")) { - if (t instanceof MalException) { - exc = ((MalException)t).getValue(); - } else { - StringWriter sw = new StringWriter(); - t.printStackTrace(new PrintWriter(sw)); - String tstr = sw.toString(); - exc = new MalString(t.getMessage() + ": " + tstr); - } - return EVAL(((MalList)a2).nth(2), - new Env(env, ((MalList)a2).slice(1,2), - new MalList(exc))); - } - } - throw t; - } - case "do": - eval_ast(ast.slice(1, ast.size()-1), env); - orig_ast = ast.nth(ast.size()-1); - break; - case "if": - a1 = ast.nth(1); - MalVal cond = EVAL(a1, env); - if (cond == types.Nil || cond == types.False) { - // eval false slot form - if (ast.size() > 3) { - orig_ast = ast.nth(3); - } else { - return types.Nil; - } - } else { - // eval true slot form - orig_ast = ast.nth(2); - } - break; - case "fn*": - final MalList a1f = (MalList)ast.nth(1); - final MalVal a2f = ast.nth(2); - final Env cur_env = env; - return new MalFunction (a2f, (mal.env.Env)env, a1f) { - public MalVal apply(MalList args) throws MalThrowable { - return EVAL(a2f, new Env(cur_env, a1f, args)); - } - }; - default: - el = (MalList)eval_ast(ast, env); - MalFunction f = (MalFunction)el.nth(0); - MalVal fnast = f.getAst(); - if (fnast != null) { - orig_ast = fnast; - env = f.genEnv(el.slice(1)); - } else { - return f.apply(el.rest()); - } - } - - } - } - - // print - public static String PRINT(MalVal exp) { - return printer._pr_str(exp, true); - } - - // repl - public static MalVal RE(Env env, String str) throws MalThrowable { - return EVAL(READ(str), env); - } - - public static void main(String[] args) throws MalThrowable { - String prompt = "user> "; - - final Env repl_env = new Env(null); - - // core.java: defined using Java - for (String key : core.ns.keySet()) { - repl_env.set(key, core.ns.get(key)); - } - repl_env.set("eval", new MalFunction() { - public MalVal apply(MalList args) throws MalThrowable { - return EVAL(args.nth(0), repl_env); - } - }); - MalList _argv = new MalList(); - for (Integer i=1; i < args.length; i++) { - _argv.conj_BANG(new MalString(args[i])); - } - repl_env.set("*ARGV*", _argv); - - - // core.mal: defined using the language itself - RE(repl_env, "(def! *host-language* \"java\")"); - RE(repl_env, "(def! not (fn* (a) (if a false true)))"); - RE(repl_env, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); - RE(repl_env, "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); - RE(repl_env, "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); - - Integer fileIdx = 0; - if (args.length > 0 && args[0].equals("--raw")) { - readline.mode = readline.Mode.JAVA; - fileIdx = 1; - } - if (args.length > fileIdx) { - RE(repl_env, "(load-file \"" + args[fileIdx] + "\")"); - return; - } - - // repl loop - RE(repl_env, "(println (str \"Mal [\" *host-language* \"]\"))"); - while (true) { - String line; - try { - line = readline.readline(prompt); - if (line == null) { continue; } - } catch (readline.EOFException e) { - break; - } catch (IOException e) { - System.out.println("IOException: " + e.getMessage()); - break; - } - try { - System.out.println(PRINT(RE(repl_env, line))); - } catch (MalContinue e) { - continue; - } catch (MalException e) { - System.out.println("Error: " + printer._pr_str(e.getValue(), false)); - continue; - } catch (MalThrowable t) { - System.out.println("Error: " + t.getMessage()); - continue; - } catch (Throwable t) { - System.out.println("Uncaught " + t + ": " + t.getMessage()); - continue; - } - } - } -} diff --git a/js/Makefile b/js/Makefile index 454e481..09ed5a4 100644 --- a/js/Makefile +++ b/js/Makefile @@ -2,7 +2,7 @@ TESTS = tests/types.js tests/reader.js SOURCES_BASE = node_readline.js types.js reader.js printer.js -SOURCES_LISP = env.js core.js stepA_more.js +SOURCES_LISP = env.js core.js stepA_interop.js SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) WEB_SOURCES = $(SOURCES:node_readline.js=jq_readline.js) diff --git a/js/step9_interop.js b/js/step9_interop.js deleted file mode 100644 index 89d2ca4..0000000 --- a/js/step9_interop.js +++ /dev/null @@ -1,185 +0,0 @@ -if (typeof module !== 'undefined') { - var types = require('./types'); - var readline = require('./node_readline'); - var reader = require('./reader'); - var printer = require('./printer'); - var Env = require('./env').Env; - var core = require('./core'); -} - -// read -function READ(str) { - return reader.read_str(str); -} - -// eval -function is_pair(x) { - return types._sequential_Q(x) && x.length > 0; -} - -function quasiquote(ast) { - if (!is_pair(ast)) { - return [types._symbol("quote"), ast]; - } else if (ast[0].value === 'unquote') { - return ast[1]; - } else if (is_pair(ast[0]) && ast[0][0].value === 'splice-unquote') { - return [types._symbol("concat"), - ast[0][1], - quasiquote(ast.slice(1))]; - } else { - return [types._symbol("cons"), - quasiquote(ast[0]), - quasiquote(ast.slice(1))]; - } -} - -function is_macro_call(ast, env) { - return types._list_Q(ast) && - types._symbol_Q(ast[0]) && - env.find(ast[0].value) && - env.get(ast[0].value)._ismacro_; -} - -function macroexpand(ast, env) { - while (is_macro_call(ast, env)) { - var mac = env.get(ast[0]); - ast = mac.apply(mac, ast.slice(1)); - } - return ast; -} - -function eval_ast(ast, env) { - if (types._symbol_Q(ast)) { - return env.get(ast); - } else if (types._list_Q(ast)) { - return ast.map(function(a) { return EVAL(a, env); }); - } else if (types._vector_Q(ast)) { - var v = ast.map(function(a) { return EVAL(a, env); }); - v.__isvector__ = true; - return v; - } else if (types._hash_map_Q(ast)) { - var new_hm = {}; - for (k in ast) { - new_hm[EVAL(k, env)] = EVAL(ast[k], env); - } - return new_hm; - } else { - return ast; - } -} - -function _EVAL(ast, env) { - while (true) { - - //printer.println("EVAL:", printer._pr_str(ast, true)); - if (!types._list_Q(ast)) { - return eval_ast(ast, env); - } - - // apply list - ast = macroexpand(ast, env); - if (!types._list_Q(ast)) { return ast; } - - var a0 = ast[0], a1 = ast[1], a2 = ast[2], a3 = ast[3]; - switch (a0.value) { - case "def!": - var res = EVAL(a2, env); - return env.set(a1, res); - case "let*": - var let_env = new Env(env); - for (var i=0; i < a1.length; i+=2) { - let_env.set(a1[i].value, EVAL(a1[i+1], let_env)); - } - ast = a2; - env = let_env; - break; - case "quote": - return a1; - case "quasiquote": - ast = quasiquote(a1); - break; - case 'defmacro!': - var func = EVAL(a2, env); - func._ismacro_ = true; - return env.set(a1, func); - case 'macroexpand': - return macroexpand(a1, env); - case "js*": - return eval(a1.toString()); - case ".": - var el = eval_ast(ast.slice(2), env), - f = eval(a1.toString()); - return f.apply(f, el); - case "do": - eval_ast(ast.slice(1, -1), env); - ast = ast[ast.length-1]; - break; - case "if": - var cond = EVAL(a1, env); - if (cond === null || cond === false) { - ast = (typeof a3 !== "undefined") ? a3 : null; - } else { - ast = a2; - } - break; - case "fn*": - return types._function(EVAL, Env, a2, env, a1); - default: - var el = eval_ast(ast, env), f = el[0]; - if (f.__ast__) { - ast = f.__ast__; - env = f.__gen_env__(el.slice(1)); - } else { - return f.apply(f, el.slice(1)); - } - } - - } -} - -function EVAL(ast, env) { - var result = _EVAL(ast, env); - return (typeof result !== "undefined") ? result : null; -} - -// print -function PRINT(exp) { - return printer._pr_str(exp, true); -} - -// repl -var repl_env = new Env(); -var rep = function(str) { return PRINT(EVAL(READ(str), repl_env)); }; - -// core.js: defined using javascript -for (var n in core.ns) { repl_env.set(n, core.ns[n]); } -repl_env.set('eval', function(ast) { return EVAL(ast, repl_env); }); -repl_env.set('*ARGV*', []); - -// core.mal: defined using the language itself -rep("(def! not (fn* (a) (if a false true)))"); -rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); -rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); -rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); - -if (typeof process !== 'undefined' && process.argv.length > 2) { - repl_env.set('*ARGV*', process.argv.slice(3)); - rep('(load-file "' + process.argv[2] + '")'); - process.exit(0); -} - -// repl loop -if (typeof require !== 'undefined' && require.main === module) { - // Synchronous node.js commandline mode - while (true) { - var line = readline.readline("user> "); - if (line === null) { break; } - try { - if (line) { printer.println(rep(line)); } - } catch (exc) { - if (exc instanceof reader.BlankException) { continue; } - if (exc.stack) { printer.println(exc.stack); } - else { printer.println(exc); } - } - } -} diff --git a/js/step9_try.js b/js/step9_try.js new file mode 100644 index 0000000..ff02f72 --- /dev/null +++ b/js/step9_try.js @@ -0,0 +1,192 @@ +if (typeof module !== 'undefined') { + var types = require('./types'); + var readline = require('./node_readline'); + var reader = require('./reader'); + var printer = require('./printer'); + var Env = require('./env').Env; + var core = require('./core'); +} + +// read +function READ(str) { + return reader.read_str(str); +} + +// eval +function is_pair(x) { + return types._sequential_Q(x) && x.length > 0; +} + +function quasiquote(ast) { + if (!is_pair(ast)) { + return [types._symbol("quote"), ast]; + } else if (ast[0].value === 'unquote') { + return ast[1]; + } else if (is_pair(ast[0]) && ast[0][0].value === 'splice-unquote') { + return [types._symbol("concat"), + ast[0][1], + quasiquote(ast.slice(1))]; + } else { + return [types._symbol("cons"), + quasiquote(ast[0]), + quasiquote(ast.slice(1))]; + } +} + +function is_macro_call(ast, env) { + return types._list_Q(ast) && + types._symbol_Q(ast[0]) && + env.find(ast[0].value) && + env.get(ast[0].value)._ismacro_; +} + +function macroexpand(ast, env) { + while (is_macro_call(ast, env)) { + var mac = env.get(ast[0]); + ast = mac.apply(mac, ast.slice(1)); + } + return ast; +} + +function eval_ast(ast, env) { + if (types._symbol_Q(ast)) { + return env.get(ast); + } else if (types._list_Q(ast)) { + return ast.map(function(a) { return EVAL(a, env); }); + } else if (types._vector_Q(ast)) { + var v = ast.map(function(a) { return EVAL(a, env); }); + v.__isvector__ = true; + return v; + } else if (types._hash_map_Q(ast)) { + var new_hm = {}; + for (k in ast) { + new_hm[EVAL(k, env)] = EVAL(ast[k], env); + } + return new_hm; + } else { + return ast; + } +} + +function _EVAL(ast, env) { + while (true) { + + //printer.println("EVAL:", printer._pr_str(ast, true)); + if (!types._list_Q(ast)) { + return eval_ast(ast, env); + } + + // apply list + ast = macroexpand(ast, env); + if (!types._list_Q(ast)) { return ast; } + + var a0 = ast[0], a1 = ast[1], a2 = ast[2], a3 = ast[3]; + switch (a0.value) { + case "def!": + var res = EVAL(a2, env); + return env.set(a1, res); + case "let*": + var let_env = new Env(env); + for (var i=0; i < a1.length; i+=2) { + let_env.set(a1[i].value, EVAL(a1[i+1], let_env)); + } + ast = a2; + env = let_env; + break; + case "quote": + return a1; + case "quasiquote": + ast = quasiquote(a1); + break; + case 'defmacro!': + var func = EVAL(a2, env); + func._ismacro_ = true; + return env.set(a1, func); + case 'macroexpand': + return macroexpand(a1, env); + case "try*": + try { + return EVAL(a1, env); + } catch (exc) { + if (a2 && a2[0].value === "catch*") { + if (exc instanceof Error) { exc = exc.message; } + return EVAL(a2[2], new Env(env, [a2[1]], [exc])); + } else { + throw exc; + } + } + case "do": + eval_ast(ast.slice(1, -1), env); + ast = ast[ast.length-1]; + break; + case "if": + var cond = EVAL(a1, env); + if (cond === null || cond === false) { + ast = (typeof a3 !== "undefined") ? a3 : null; + } else { + ast = a2; + } + break; + case "fn*": + return types._function(EVAL, Env, a2, env, a1); + default: + var el = eval_ast(ast, env), f = el[0]; + if (f.__ast__) { + ast = f.__ast__; + env = f.__gen_env__(el.slice(1)); + } else { + return f.apply(f, el.slice(1)); + } + } + + } +} + +function EVAL(ast, env) { + var result = _EVAL(ast, env); + return (typeof result !== "undefined") ? result : null; +} + +// print +function PRINT(exp) { + return printer._pr_str(exp, true); +} + +// repl +var repl_env = new Env(); +var rep = function(str) { return PRINT(EVAL(READ(str), repl_env)); }; + +// core.js: defined using javascript +for (var n in core.ns) { repl_env.set(n, core.ns[n]); } +repl_env.set('eval', function(ast) { return EVAL(ast, repl_env); }); +repl_env.set('*ARGV*', []); + +// core.mal: defined using the language itself +rep("(def! *host-language* \"javascript\")") +rep("(def! not (fn* (a) (if a false true)))"); +rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); +rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); +rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); + +if (typeof process !== 'undefined' && process.argv.length > 2) { + repl_env.set('*ARGV*', process.argv.slice(3)); + rep('(load-file "' + process.argv[2] + '")'); + process.exit(0); +} + +// repl loop +if (typeof require !== 'undefined' && require.main === module) { + // Synchronous node.js commandline mode + rep("(println (str \"Mal [\" *host-language* \"]\"))"); + while (true) { + var line = readline.readline("user> "); + if (line === null) { break; } + try { + if (line) { printer.println(rep(line)); } + } catch (exc) { + if (exc instanceof reader.BlankException) { continue; } + if (exc.stack) { printer.println(exc.stack); } + else { printer.println(exc); } + } + } +} diff --git a/js/stepA_interop.js b/js/stepA_interop.js new file mode 100644 index 0000000..0955b7f --- /dev/null +++ b/js/stepA_interop.js @@ -0,0 +1,198 @@ +if (typeof module !== 'undefined') { + var types = require('./types'); + var readline = require('./node_readline'); + var reader = require('./reader'); + var printer = require('./printer'); + var Env = require('./env').Env; + var core = require('./core'); +} + +// read +function READ(str) { + return reader.read_str(str); +} + +// eval +function is_pair(x) { + return types._sequential_Q(x) && x.length > 0; +} + +function quasiquote(ast) { + if (!is_pair(ast)) { + return [types._symbol("quote"), ast]; + } else if (ast[0].value === 'unquote') { + return ast[1]; + } else if (is_pair(ast[0]) && ast[0][0].value === 'splice-unquote') { + return [types._symbol("concat"), + ast[0][1], + quasiquote(ast.slice(1))]; + } else { + return [types._symbol("cons"), + quasiquote(ast[0]), + quasiquote(ast.slice(1))]; + } +} + +function is_macro_call(ast, env) { + return types._list_Q(ast) && + types._symbol_Q(ast[0]) && + env.find(ast[0].value) && + env.get(ast[0].value)._ismacro_; +} + +function macroexpand(ast, env) { + while (is_macro_call(ast, env)) { + var mac = env.get(ast[0]); + ast = mac.apply(mac, ast.slice(1)); + } + return ast; +} + +function eval_ast(ast, env) { + if (types._symbol_Q(ast)) { + return env.get(ast); + } else if (types._list_Q(ast)) { + return ast.map(function(a) { return EVAL(a, env); }); + } else if (types._vector_Q(ast)) { + var v = ast.map(function(a) { return EVAL(a, env); }); + v.__isvector__ = true; + return v; + } else if (types._hash_map_Q(ast)) { + var new_hm = {}; + for (k in ast) { + new_hm[EVAL(k, env)] = EVAL(ast[k], env); + } + return new_hm; + } else { + return ast; + } +} + +function _EVAL(ast, env) { + while (true) { + + //printer.println("EVAL:", printer._pr_str(ast, true)); + if (!types._list_Q(ast)) { + return eval_ast(ast, env); + } + + // apply list + ast = macroexpand(ast, env); + if (!types._list_Q(ast)) { return ast; } + + var a0 = ast[0], a1 = ast[1], a2 = ast[2], a3 = ast[3]; + switch (a0.value) { + case "def!": + var res = EVAL(a2, env); + return env.set(a1, res); + case "let*": + var let_env = new Env(env); + for (var i=0; i < a1.length; i+=2) { + let_env.set(a1[i].value, EVAL(a1[i+1], let_env)); + } + ast = a2; + env = let_env; + break; + case "quote": + return a1; + case "quasiquote": + ast = quasiquote(a1); + break; + case 'defmacro!': + var func = EVAL(a2, env); + func._ismacro_ = true; + return env.set(a1, func); + case 'macroexpand': + return macroexpand(a1, env); + case "js*": + return eval(a1.toString()); + case ".": + var el = eval_ast(ast.slice(2), env), + f = eval(a1.toString()); + return f.apply(f, el); + case "try*": + try { + return EVAL(a1, env); + } catch (exc) { + if (a2 && a2[0].value === "catch*") { + if (exc instanceof Error) { exc = exc.message; } + return EVAL(a2[2], new Env(env, [a2[1]], [exc])); + } else { + throw exc; + } + } + case "do": + eval_ast(ast.slice(1, -1), env); + ast = ast[ast.length-1]; + break; + case "if": + var cond = EVAL(a1, env); + if (cond === null || cond === false) { + ast = (typeof a3 !== "undefined") ? a3 : null; + } else { + ast = a2; + } + break; + case "fn*": + return types._function(EVAL, Env, a2, env, a1); + default: + var el = eval_ast(ast, env), f = el[0]; + if (f.__ast__) { + ast = f.__ast__; + env = f.__gen_env__(el.slice(1)); + } else { + return f.apply(f, el.slice(1)); + } + } + + } +} + +function EVAL(ast, env) { + var result = _EVAL(ast, env); + return (typeof result !== "undefined") ? result : null; +} + +// print +function PRINT(exp) { + return printer._pr_str(exp, true); +} + +// repl +var repl_env = new Env(); +var rep = function(str) { return PRINT(EVAL(READ(str), repl_env)); }; + +// core.js: defined using javascript +for (var n in core.ns) { repl_env.set(n, core.ns[n]); } +repl_env.set('eval', function(ast) { return EVAL(ast, repl_env); }); +repl_env.set('*ARGV*', []); + +// core.mal: defined using the language itself +rep("(def! *host-language* \"javascript\")") +rep("(def! not (fn* (a) (if a false true)))"); +rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); +rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); +rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); + +if (typeof process !== 'undefined' && process.argv.length > 2) { + repl_env.set('*ARGV*', process.argv.slice(3)); + rep('(load-file "' + process.argv[2] + '")'); + process.exit(0); +} + +// repl loop +if (typeof require !== 'undefined' && require.main === module) { + // Synchronous node.js commandline mode + rep("(println (str \"Mal [\" *host-language* \"]\"))"); + while (true) { + var line = readline.readline("user> "); + if (line === null) { break; } + try { + if (line) { printer.println(rep(line)); } + } catch (exc) { + if (exc instanceof reader.BlankException) { continue; } + if (exc.stack) { printer.println(exc.stack); } + else { printer.println(exc); } + } + } +} diff --git a/js/stepA_more.js b/js/stepA_more.js deleted file mode 100644 index 0955b7f..0000000 --- a/js/stepA_more.js +++ /dev/null @@ -1,198 +0,0 @@ -if (typeof module !== 'undefined') { - var types = require('./types'); - var readline = require('./node_readline'); - var reader = require('./reader'); - var printer = require('./printer'); - var Env = require('./env').Env; - var core = require('./core'); -} - -// read -function READ(str) { - return reader.read_str(str); -} - -// eval -function is_pair(x) { - return types._sequential_Q(x) && x.length > 0; -} - -function quasiquote(ast) { - if (!is_pair(ast)) { - return [types._symbol("quote"), ast]; - } else if (ast[0].value === 'unquote') { - return ast[1]; - } else if (is_pair(ast[0]) && ast[0][0].value === 'splice-unquote') { - return [types._symbol("concat"), - ast[0][1], - quasiquote(ast.slice(1))]; - } else { - return [types._symbol("cons"), - quasiquote(ast[0]), - quasiquote(ast.slice(1))]; - } -} - -function is_macro_call(ast, env) { - return types._list_Q(ast) && - types._symbol_Q(ast[0]) && - env.find(ast[0].value) && - env.get(ast[0].value)._ismacro_; -} - -function macroexpand(ast, env) { - while (is_macro_call(ast, env)) { - var mac = env.get(ast[0]); - ast = mac.apply(mac, ast.slice(1)); - } - return ast; -} - -function eval_ast(ast, env) { - if (types._symbol_Q(ast)) { - return env.get(ast); - } else if (types._list_Q(ast)) { - return ast.map(function(a) { return EVAL(a, env); }); - } else if (types._vector_Q(ast)) { - var v = ast.map(function(a) { return EVAL(a, env); }); - v.__isvector__ = true; - return v; - } else if (types._hash_map_Q(ast)) { - var new_hm = {}; - for (k in ast) { - new_hm[EVAL(k, env)] = EVAL(ast[k], env); - } - return new_hm; - } else { - return ast; - } -} - -function _EVAL(ast, env) { - while (true) { - - //printer.println("EVAL:", printer._pr_str(ast, true)); - if (!types._list_Q(ast)) { - return eval_ast(ast, env); - } - - // apply list - ast = macroexpand(ast, env); - if (!types._list_Q(ast)) { return ast; } - - var a0 = ast[0], a1 = ast[1], a2 = ast[2], a3 = ast[3]; - switch (a0.value) { - case "def!": - var res = EVAL(a2, env); - return env.set(a1, res); - case "let*": - var let_env = new Env(env); - for (var i=0; i < a1.length; i+=2) { - let_env.set(a1[i].value, EVAL(a1[i+1], let_env)); - } - ast = a2; - env = let_env; - break; - case "quote": - return a1; - case "quasiquote": - ast = quasiquote(a1); - break; - case 'defmacro!': - var func = EVAL(a2, env); - func._ismacro_ = true; - return env.set(a1, func); - case 'macroexpand': - return macroexpand(a1, env); - case "js*": - return eval(a1.toString()); - case ".": - var el = eval_ast(ast.slice(2), env), - f = eval(a1.toString()); - return f.apply(f, el); - case "try*": - try { - return EVAL(a1, env); - } catch (exc) { - if (a2 && a2[0].value === "catch*") { - if (exc instanceof Error) { exc = exc.message; } - return EVAL(a2[2], new Env(env, [a2[1]], [exc])); - } else { - throw exc; - } - } - case "do": - eval_ast(ast.slice(1, -1), env); - ast = ast[ast.length-1]; - break; - case "if": - var cond = EVAL(a1, env); - if (cond === null || cond === false) { - ast = (typeof a3 !== "undefined") ? a3 : null; - } else { - ast = a2; - } - break; - case "fn*": - return types._function(EVAL, Env, a2, env, a1); - default: - var el = eval_ast(ast, env), f = el[0]; - if (f.__ast__) { - ast = f.__ast__; - env = f.__gen_env__(el.slice(1)); - } else { - return f.apply(f, el.slice(1)); - } - } - - } -} - -function EVAL(ast, env) { - var result = _EVAL(ast, env); - return (typeof result !== "undefined") ? result : null; -} - -// print -function PRINT(exp) { - return printer._pr_str(exp, true); -} - -// repl -var repl_env = new Env(); -var rep = function(str) { return PRINT(EVAL(READ(str), repl_env)); }; - -// core.js: defined using javascript -for (var n in core.ns) { repl_env.set(n, core.ns[n]); } -repl_env.set('eval', function(ast) { return EVAL(ast, repl_env); }); -repl_env.set('*ARGV*', []); - -// core.mal: defined using the language itself -rep("(def! *host-language* \"javascript\")") -rep("(def! not (fn* (a) (if a false true)))"); -rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); -rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); -rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); - -if (typeof process !== 'undefined' && process.argv.length > 2) { - repl_env.set('*ARGV*', process.argv.slice(3)); - rep('(load-file "' + process.argv[2] + '")'); - process.exit(0); -} - -// repl loop -if (typeof require !== 'undefined' && require.main === module) { - // Synchronous node.js commandline mode - rep("(println (str \"Mal [\" *host-language* \"]\"))"); - while (true) { - var line = readline.readline("user> "); - if (line === null) { break; } - try { - if (line) { printer.println(rep(line)); } - } catch (exc) { - if (exc instanceof reader.BlankException) { continue; } - if (exc.stack) { printer.println(exc.stack); } - else { printer.println(exc); } - } - } -} diff --git a/js/tests/step9_interop.mal b/js/tests/step9_interop.mal deleted file mode 100644 index f785292..0000000 --- a/js/tests/step9_interop.mal +++ /dev/null @@ -1,24 +0,0 @@ -;; Testing basic bash interop - -(js* "7") -;=>7 - -(js* "'7'") -;=>"7" - -(js* "[7,8,9]") -;=>(7 8 9) - -(js* "console.log('hello');") -; hello -;=>nil - -(js* "foo=8;") -(js* "foo;") -;=>8 - -(js* "['a','b','c'].map(function(x){return 'X'+x+'Y'}).join(' ')") -;=>"XaY XbY XcY" - -(js* "[1,2,3].map(function(x){return 1+x})") -;=>(2 3 4) diff --git a/js/tests/stepA_interop.mal b/js/tests/stepA_interop.mal new file mode 100644 index 0000000..f785292 --- /dev/null +++ b/js/tests/stepA_interop.mal @@ -0,0 +1,24 @@ +;; Testing basic bash interop + +(js* "7") +;=>7 + +(js* "'7'") +;=>"7" + +(js* "[7,8,9]") +;=>(7 8 9) + +(js* "console.log('hello');") +; hello +;=>nil + +(js* "foo=8;") +(js* "foo;") +;=>8 + +(js* "['a','b','c'].map(function(x){return 'X'+x+'Y'}).join(' ')") +;=>"XaY XbY XcY" + +(js* "[1,2,3].map(function(x){return 1+x})") +;=>(2 3 4) diff --git a/make/Makefile b/make/Makefile index 52a7a7d..bd19020 100644 --- a/make/Makefile +++ b/make/Makefile @@ -1,8 +1,8 @@ -TESTS = tests/types.mk tests/reader.mk tests/step9_interop.mk +TESTS = tests/types.mk tests/reader.mk tests/stepA_interop.mk SOURCES_BASE = util.mk readline.mk gmsl.mk types.mk reader.mk printer.mk -SOURCES_LISP = env.mk core.mk stepA_more.mk +SOURCES_LISP = env.mk core.mk stepA_interop.mk SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) mal.mk: $(SOURCES) diff --git a/make/step9_interop.mk b/make/step9_interop.mk deleted file mode 100644 index 984740a..0000000 --- a/make/step9_interop.mk +++ /dev/null @@ -1,174 +0,0 @@ -# -# mal (Make Lisp) -# -_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) -include $(_TOP_DIR)types.mk -include $(_TOP_DIR)reader.mk -include $(_TOP_DIR)printer.mk -include $(_TOP_DIR)env.mk -include $(_TOP_DIR)core.mk - -SHELL := /bin/bash -INTERACTIVE ?= yes -EVAL_DEBUG ?= - -# READ: read and parse input -define READ -$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) -endef - -# EVAL: evaluate the parameter -IS_PAIR = $(if $(call _sequential?,$(1)),$(if $(call _EQ,0,$(call _count,$(1))),,true),) - -define QUASIQUOTE -$(strip \ - $(if $(call _NOT,$(call IS_PAIR,$(1))),\ - $(call _list,$(call _symbol,quote) $(1)),\ - $(if $(call _EQ,unquote,$($(call _nth,$(1),0)_value)),\ - $(call _nth,$(1),1),\ - $(if $(and $(call IS_PAIR,$(call _nth,$(1),0)),$(call _EQ,splice-unquote,$($(call _nth,$(call _nth,$(1),0),0)_value))),\ - $(call _list,$(call _symbol,concat) $(call _nth,$(call _nth,$(1),0),1) $(call QUASIQUOTE,$(call srest,$(1)))),\ - $(call _list,$(call _symbol,cons) $(call QUASIQUOTE,$(call _nth,$(1),0)) $(call QUASIQUOTE,$(call srest,$(1)))))))) -endef - -define IS_MACRO_CALL -$(if $(call _list?,$(1)),$(call ENV_FIND,$(2),_macro_$($(call _nth,$(1),0)_value)),) -endef - -define MACROEXPAND -$(strip $(if $(__ERROR),,\ - $(if $(call IS_MACRO_CALL,$(1),$(2)),\ - $(foreach mac,$(call ENV_GET,$(2),$($(call _nth,$(1),0)_value)),\ - $(call MACROEXPAND,$(call apply,$(mac),$(call srest,$(1))),$(2))),\ - $(1)))) -endef - -define LET -$(strip \ - $(word 1,$(2) \ - $(foreach var,$(call _nth,$(1),0),\ - $(foreach val,$(call _nth,$(1),1),\ - $(call ENV_SET,$(2),$($(var)_value),$(call EVAL,$(val),$(2)))\ - $(foreach left,$(call srest,$(call srest,$(1))), - $(if $(call _EQ,0,$(call _count,$(left))),\ - ,\ - $(call LET,$(left),$(2)))))))) -endef - -define EVAL_AST -$(strip \ - $(and $(EVAL_DEBUG),$(info EVAL_AST: $(call _pr_str,$(1))))\ - $(if $(call _symbol?,$(1)),\ - $(foreach key,$($(1)_value),\ - $(call ENV_GET,$(2),$(key))),\ - $(if $(call _list?,$(1)),\ - $(call _smap,EVAL,$(1),$(2)),\ - $(if $(call _vector?,$(1)),\ - $(call _smap_vec,EVAL,$(1),$(2)),\ - $(if $(call _hash_map?,$(1)),\ - $(foreach new_hmap,$(call __new_obj,hmap),\ - $(foreach v,$(call __get_obj_values,$(1)),\ - $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ - $(eval $(new_hmap)_size := $($(1)_size))\ - $(new_hmap)),\ - $(1)))))) -endef - -define EVAL_INVOKE -$(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1)))) - $(foreach a0,$(call _nth,$(1),0),\ - $(if $(call _EQ,def!,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call EVAL,$(a2),$(2)),\ - $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),)))),\ - $(if $(call _EQ,let*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ - $(if $(call _EQ,quote,$($(a0)_value)),\ - $(call _nth,$(1),1),\ - $(if $(call _EQ,quasiquote,$($(a0)_value)),\ - $(call EVAL,$(call QUASIQUOTE,$(call _nth,$(1),1)),$(2)),\ - $(if $(call _EQ,defmacro!,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call EVAL,$(a2),$(2)),\ - $(if $(call ENV_SET,$(2),_macro_$($(a1)_value),true),,)\ - $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),)))),\ - $(if $(call _EQ,macroexpand,$($(a0)_value)),\ - $(call MACROEXPAND,$(call _nth,$(1),1),$(2)),\ - $(if $(call _EQ,make*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(and $(EVAL_DEBUG),$(info make*: $$(eval __result := $(call str_decode,$(value $(a1)_value)))))\ - $(eval __result := $(call str_decode,$(value $(a1)_value)))$(call _string,$(__result))),\ - $(if $(call _EQ,do,$($(a0)_value)),\ - $(call slast,$(call EVAL_AST,$(call srest,$(1)),$(2))),\ - $(if $(call _EQ,if,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach cond,$(call EVAL,$(a1),$(2)),\ - $(if $(or $(call _EQ,$(__nil),$(cond)),$(call _EQ,$(__false),$(cond))),\ - $(foreach a3,$(call _nth,$(1),3),$(call EVAL,$(a3),$(2))),\ - $(call EVAL,$(a2),$(2)))))),\ - $(if $(call _EQ,fn*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call _function,$$(call EVAL,$(a2),$$(call ENV,$(2),$(a1),$$1))))),\ - $(foreach el,$(call EVAL_AST,$(1),$(2)),\ - $(and $(EVAL_DEBUG),$(info invoke: $(call _pr_str,$(el))))\ - $(foreach f,$(call sfirst,$(el)),\ - $(foreach args,$(call srest,$(el)),\ - $(call apply,$(f),$(args))))))))))))))))) -endef - -define EVAL -$(strip $(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL: $(call _pr_str,$(1))))\ - $(if $(call _list?,$(1)),\ - $(foreach ast,$(call MACROEXPAND,$(1),$(2)), - $(if $(call _list?,$(ast)),\ - $(word 1,$(strip $(call EVAL_INVOKE,$(ast),$(2)) $(__nil))),\ - $(ast))),\ - $(call EVAL_AST,$(1),$(2))))) -endef - - -# PRINT: -define PRINT -$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) -endef - -# REPL: -REPL_ENV := $(call ENV) -REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) -REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) - -# core.mk: defined using Make -_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call _function,$$(call $(2),$$1)))) -_import_core = $(if $(strip $(1)),$(call _fref,$(word 1,$(1)),$(word 2,$(1)))$(call _import_core,$(wordlist 3,$(words $(1)),$(1))),) -$(call _import_core,$(core_ns)) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),eval,$(call _function,$$(call EVAL,$$(1),$$(REPL_ENV)))) -_argv := $(call _list) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),*ARGV*,$(_argv)) - -# core.mal: defined in terms of the language itself -$(call do,$(call REP, (def! not (fn* (a) (if a false true))) )) -$(call do,$(call REP, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")"))))) )) -$(call do,$(call REP, (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs))))))) )) -$(call do,$(call REP, (defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs)))))))) )) - -# Load and eval any files specified on the command line -$(if $(MAKECMDGOALS),\ - $(foreach arg,$(wordlist 2,$(words $(MAKECMDGOALS)),$(MAKECMDGOALS)),\ - $(call do,$(call _conj!,$(_argv),$(call _string,$(arg)))))\ - $(call do,$(call REP, (load-file "$(word 1,$(MAKECMDGOALS))") )) \ - $(eval INTERACTIVE :=),) - -# repl loop -$(if $(strip $(INTERACTIVE)),$(call REPL)) - -.PHONY: none $(MAKECMDGOALS) -none $(MAKECMDGOALS): - @true diff --git a/make/step9_try.mk b/make/step9_try.mk new file mode 100644 index 0000000..4c5b8c1 --- /dev/null +++ b/make/step9_try.mk @@ -0,0 +1,188 @@ +# +# mal (Make Lisp) +# +_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)types.mk +include $(_TOP_DIR)reader.mk +include $(_TOP_DIR)printer.mk +include $(_TOP_DIR)env.mk +include $(_TOP_DIR)core.mk + +SHELL := /bin/bash +INTERACTIVE ?= yes +EVAL_DEBUG ?= + +# READ: read and parse input +define READ +$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) +endef + +# EVAL: evaluate the parameter +IS_PAIR = $(if $(call _sequential?,$(1)),$(if $(call _EQ,0,$(call _count,$(1))),,true),) + +define QUASIQUOTE +$(strip \ + $(if $(call _NOT,$(call IS_PAIR,$(1))),\ + $(call _list,$(call _symbol,quote) $(1)),\ + $(if $(call _EQ,unquote,$($(call _nth,$(1),0)_value)),\ + $(call _nth,$(1),1),\ + $(if $(and $(call IS_PAIR,$(call _nth,$(1),0)),$(call _EQ,splice-unquote,$($(call _nth,$(call _nth,$(1),0),0)_value))),\ + $(call _list,$(call _symbol,concat) $(call _nth,$(call _nth,$(1),0),1) $(call QUASIQUOTE,$(call srest,$(1)))),\ + $(call _list,$(call _symbol,cons) $(call QUASIQUOTE,$(call _nth,$(1),0)) $(call QUASIQUOTE,$(call srest,$(1)))))))) +endef + +define IS_MACRO_CALL +$(if $(call _list?,$(1)),$(call ENV_FIND,$(2),_macro_$($(call _nth,$(1),0)_value)),) +endef + +define MACROEXPAND +$(strip $(if $(__ERROR),,\ + $(if $(call IS_MACRO_CALL,$(1),$(2)),\ + $(foreach mac,$(call ENV_GET,$(2),$($(call _nth,$(1),0)_value)),\ + $(call MACROEXPAND,$(call apply,$(mac),$(call srest,$(1))),$(2))),\ + $(1)))) +endef + +define LET +$(strip \ + $(word 1,$(2) \ + $(foreach var,$(call _nth,$(1),0),\ + $(foreach val,$(call _nth,$(1),1),\ + $(call ENV_SET,$(2),$($(var)_value),$(call EVAL,$(val),$(2)))\ + $(foreach left,$(call srest,$(call srest,$(1))), + $(if $(call _EQ,0,$(call _count,$(left))),\ + ,\ + $(call LET,$(left),$(2)))))))) +endef + +define EVAL_AST +$(strip \ + $(and $(EVAL_DEBUG),$(info EVAL_AST: $(call _pr_str,$(1))))\ + $(if $(call _symbol?,$(1)),\ + $(foreach key,$($(1)_value),\ + $(call ENV_GET,$(2),$(key))),\ + $(if $(call _list?,$(1)),\ + $(call _smap,EVAL,$(1),$(2)),\ + $(if $(call _vector?,$(1)),\ + $(call _smap_vec,EVAL,$(1),$(2)),\ + $(if $(call _hash_map?,$(1)),\ + $(foreach new_hmap,$(call __new_obj,hmap),\ + $(foreach v,$(call __get_obj_values,$(1)),\ + $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ + $(eval $(new_hmap)_size := $($(1)_size))\ + $(new_hmap)),\ + $(1)))))) +endef + +define EVAL_INVOKE +$(if $(__ERROR),,\ + $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1)))) + $(foreach a0,$(call _nth,$(1),0),\ + $(if $(call _EQ,def!,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(foreach res,$(call EVAL,$(a2),$(2)),\ + $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),)))),\ + $(if $(call _EQ,let*,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ + $(if $(call _EQ,quote,$($(a0)_value)),\ + $(call _nth,$(1),1),\ + $(if $(call _EQ,quasiquote,$($(a0)_value)),\ + $(call EVAL,$(call QUASIQUOTE,$(call _nth,$(1),1)),$(2)),\ + $(if $(call _EQ,defmacro!,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(foreach res,$(call EVAL,$(a2),$(2)),\ + $(if $(call ENV_SET,$(2),_macro_$($(a1)_value),true),,)\ + $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),)))),\ + $(if $(call _EQ,macroexpand,$($(a0)_value)),\ + $(call MACROEXPAND,$(call _nth,$(1),1),$(2)),\ + $(if $(call _EQ,try*,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach res,$(call EVAL,$(a1),$(2)),\ + $(if $(__ERROR),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(foreach a20,$(call _nth,$(a2),0),\ + $(if $(call _EQ,catch*,$($(a20)_value)),\ + $(foreach a21,$(call _nth,$(a2),1),\ + $(foreach a22,$(call _nth,$(a2),2),\ + $(foreach binds,$(call _list,$(a21)),\ + $(foreach catch_env,$(call ENV,$(2),$(binds),$(__ERROR)),\ + $(eval __ERROR :=)\ + $(call EVAL,$(a22),$(catch_env)))))),\ + $(res)))),\ + $(res)))),\ + $(if $(call _EQ,do,$($(a0)_value)),\ + $(call slast,$(call EVAL_AST,$(call srest,$(1)),$(2))),\ + $(if $(call _EQ,if,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(foreach cond,$(call EVAL,$(a1),$(2)),\ + $(if $(or $(call _EQ,$(__nil),$(cond)),$(call _EQ,$(__false),$(cond))),\ + $(foreach a3,$(call _nth,$(1),3),$(call EVAL,$(a3),$(2))),\ + $(call EVAL,$(a2),$(2)))))),\ + $(if $(call _EQ,fn*,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(call _function,$$(call EVAL,$(a2),$$(call ENV,$(2),$(a1),$$1))))),\ + $(foreach el,$(call EVAL_AST,$(1),$(2)),\ + $(and $(EVAL_DEBUG),$(info invoke: $(call _pr_str,$(el))))\ + $(foreach f,$(call sfirst,$(el)),\ + $(foreach args,$(call srest,$(el)),\ + $(call apply,$(f),$(args))))))))))))))))) +endef + +define EVAL +$(strip $(if $(__ERROR),,\ + $(and $(EVAL_DEBUG),$(info EVAL: $(call _pr_str,$(1))))\ + $(if $(call _list?,$(1)),\ + $(foreach ast,$(call MACROEXPAND,$(1),$(2)), + $(if $(call _list?,$(ast)),\ + $(word 1,$(strip $(call EVAL_INVOKE,$(ast),$(2)) $(__nil))),\ + $(ast))),\ + $(call EVAL_AST,$(1),$(2))))) +endef + + +# PRINT: +define PRINT +$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) +endef + +# REPL: +REPL_ENV := $(call ENV) +REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) +REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) + +# core.mk: defined using Make +_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call _function,$$(call $(2),$$1)))) +_import_core = $(if $(strip $(1)),$(call _fref,$(word 1,$(1)),$(word 2,$(1)))$(call _import_core,$(wordlist 3,$(words $(1)),$(1))),) +$(call _import_core,$(core_ns)) +REPL_ENV := $(call ENV_SET,$(REPL_ENV),eval,$(call _function,$$(call EVAL,$$(1),$$(REPL_ENV)))) +_argv := $(call _list) +REPL_ENV := $(call ENV_SET,$(REPL_ENV),*ARGV*,$(_argv)) + +# core.mal: defined in terms of the language itself +$(call do,$(call REP, (def! *host-language* "make") )) +$(call do,$(call REP, (def! not (fn* (a) (if a false true))) )) +$(call do,$(call REP, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")"))))) )) +$(call do,$(call REP, (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs))))))) )) +$(call do,$(call REP, (defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs)))))))) )) + +# Load and eval any files specified on the command line +$(if $(MAKECMDGOALS),\ + $(foreach arg,$(wordlist 2,$(words $(MAKECMDGOALS)),$(MAKECMDGOALS)),\ + $(call do,$(call _conj!,$(_argv),$(call _string,$(arg)))))\ + $(call do,$(call REP, (load-file "$(word 1,$(MAKECMDGOALS))") )) \ + $(eval INTERACTIVE :=),) + +# repl loop +$(if $(strip $(INTERACTIVE)),\ + $(call do,$(call REP, (println (str "Mal [" *host-language* "]")) )) \ + $(call REPL)) + +.PHONY: none $(MAKECMDGOALS) +none $(MAKECMDGOALS): + @true diff --git a/make/stepA_interop.mk b/make/stepA_interop.mk new file mode 100644 index 0000000..050366c --- /dev/null +++ b/make/stepA_interop.mk @@ -0,0 +1,192 @@ +# +# mal (Make Lisp) +# +_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)types.mk +include $(_TOP_DIR)reader.mk +include $(_TOP_DIR)printer.mk +include $(_TOP_DIR)env.mk +include $(_TOP_DIR)core.mk + +SHELL := /bin/bash +INTERACTIVE ?= yes +EVAL_DEBUG ?= + +# READ: read and parse input +define READ +$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) +endef + +# EVAL: evaluate the parameter +IS_PAIR = $(if $(call _sequential?,$(1)),$(if $(call _EQ,0,$(call _count,$(1))),,true),) + +define QUASIQUOTE +$(strip \ + $(if $(call _NOT,$(call IS_PAIR,$(1))),\ + $(call _list,$(call _symbol,quote) $(1)),\ + $(if $(call _EQ,unquote,$($(call _nth,$(1),0)_value)),\ + $(call _nth,$(1),1),\ + $(if $(and $(call IS_PAIR,$(call _nth,$(1),0)),$(call _EQ,splice-unquote,$($(call _nth,$(call _nth,$(1),0),0)_value))),\ + $(call _list,$(call _symbol,concat) $(call _nth,$(call _nth,$(1),0),1) $(call QUASIQUOTE,$(call srest,$(1)))),\ + $(call _list,$(call _symbol,cons) $(call QUASIQUOTE,$(call _nth,$(1),0)) $(call QUASIQUOTE,$(call srest,$(1)))))))) +endef + +define IS_MACRO_CALL +$(if $(call _list?,$(1)),$(call ENV_FIND,$(2),_macro_$($(call _nth,$(1),0)_value)),) +endef + +define MACROEXPAND +$(strip $(if $(__ERROR),,\ + $(if $(call IS_MACRO_CALL,$(1),$(2)),\ + $(foreach mac,$(call ENV_GET,$(2),$($(call _nth,$(1),0)_value)),\ + $(call MACROEXPAND,$(call apply,$(mac),$(call srest,$(1))),$(2))),\ + $(1)))) +endef + +define LET +$(strip \ + $(word 1,$(2) \ + $(foreach var,$(call _nth,$(1),0),\ + $(foreach val,$(call _nth,$(1),1),\ + $(call ENV_SET,$(2),$($(var)_value),$(call EVAL,$(val),$(2)))\ + $(foreach left,$(call srest,$(call srest,$(1))), + $(if $(call _EQ,0,$(call _count,$(left))),\ + ,\ + $(call LET,$(left),$(2)))))))) +endef + +define EVAL_AST +$(strip \ + $(and $(EVAL_DEBUG),$(info EVAL_AST: $(call _pr_str,$(1))))\ + $(if $(call _symbol?,$(1)),\ + $(foreach key,$($(1)_value),\ + $(call ENV_GET,$(2),$(key))),\ + $(if $(call _list?,$(1)),\ + $(call _smap,EVAL,$(1),$(2)),\ + $(if $(call _vector?,$(1)),\ + $(call _smap_vec,EVAL,$(1),$(2)),\ + $(if $(call _hash_map?,$(1)),\ + $(foreach new_hmap,$(call __new_obj,hmap),\ + $(foreach v,$(call __get_obj_values,$(1)),\ + $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ + $(eval $(new_hmap)_size := $($(1)_size))\ + $(new_hmap)),\ + $(1)))))) +endef + +define EVAL_INVOKE +$(if $(__ERROR),,\ + $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1)))) + $(foreach a0,$(call _nth,$(1),0),\ + $(if $(call _EQ,def!,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(foreach res,$(call EVAL,$(a2),$(2)),\ + $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),)))),\ + $(if $(call _EQ,let*,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ + $(if $(call _EQ,quote,$($(a0)_value)),\ + $(call _nth,$(1),1),\ + $(if $(call _EQ,quasiquote,$($(a0)_value)),\ + $(call EVAL,$(call QUASIQUOTE,$(call _nth,$(1),1)),$(2)),\ + $(if $(call _EQ,defmacro!,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(foreach res,$(call EVAL,$(a2),$(2)),\ + $(if $(call ENV_SET,$(2),_macro_$($(a1)_value),true),,)\ + $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),)))),\ + $(if $(call _EQ,macroexpand,$($(a0)_value)),\ + $(call MACROEXPAND,$(call _nth,$(1),1),$(2)),\ + $(if $(call _EQ,make*,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(and $(EVAL_DEBUG),$(info make*: $$(eval __result := $(call str_decode,$(value $(a1)_value)))))\ + $(eval __result := $(call str_decode,$(value $(a1)_value)))$(call _string,$(__result))),\ + $(if $(call _EQ,try*,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach res,$(call EVAL,$(a1),$(2)),\ + $(if $(__ERROR),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(foreach a20,$(call _nth,$(a2),0),\ + $(if $(call _EQ,catch*,$($(a20)_value)),\ + $(foreach a21,$(call _nth,$(a2),1),\ + $(foreach a22,$(call _nth,$(a2),2),\ + $(foreach binds,$(call _list,$(a21)),\ + $(foreach catch_env,$(call ENV,$(2),$(binds),$(__ERROR)),\ + $(eval __ERROR :=)\ + $(call EVAL,$(a22),$(catch_env)))))),\ + $(res)))),\ + $(res)))),\ + $(if $(call _EQ,do,$($(a0)_value)),\ + $(call slast,$(call EVAL_AST,$(call srest,$(1)),$(2))),\ + $(if $(call _EQ,if,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(foreach cond,$(call EVAL,$(a1),$(2)),\ + $(if $(or $(call _EQ,$(__nil),$(cond)),$(call _EQ,$(__false),$(cond))),\ + $(foreach a3,$(call _nth,$(1),3),$(call EVAL,$(a3),$(2))),\ + $(call EVAL,$(a2),$(2)))))),\ + $(if $(call _EQ,fn*,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(call _function,$$(call EVAL,$(a2),$$(call ENV,$(2),$(a1),$$1))))),\ + $(foreach el,$(call EVAL_AST,$(1),$(2)),\ + $(and $(EVAL_DEBUG),$(info invoke: $(call _pr_str,$(el))))\ + $(foreach f,$(call sfirst,$(el)),\ + $(foreach args,$(call srest,$(el)),\ + $(call apply,$(f),$(args)))))))))))))))))) +endef + +define EVAL +$(strip $(if $(__ERROR),,\ + $(and $(EVAL_DEBUG),$(info EVAL: $(call _pr_str,$(1))))\ + $(if $(call _list?,$(1)),\ + $(foreach ast,$(call MACROEXPAND,$(1),$(2)), + $(if $(call _list?,$(ast)),\ + $(word 1,$(strip $(call EVAL_INVOKE,$(ast),$(2)) $(__nil))),\ + $(ast))),\ + $(call EVAL_AST,$(1),$(2))))) +endef + + +# PRINT: +define PRINT +$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) +endef + +# REPL: +REPL_ENV := $(call ENV) +REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) +REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) + +# core.mk: defined using Make +_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call _function,$$(call $(2),$$1)))) +_import_core = $(if $(strip $(1)),$(call _fref,$(word 1,$(1)),$(word 2,$(1)))$(call _import_core,$(wordlist 3,$(words $(1)),$(1))),) +$(call _import_core,$(core_ns)) +REPL_ENV := $(call ENV_SET,$(REPL_ENV),eval,$(call _function,$$(call EVAL,$$(1),$$(REPL_ENV)))) +_argv := $(call _list) +REPL_ENV := $(call ENV_SET,$(REPL_ENV),*ARGV*,$(_argv)) + +# core.mal: defined in terms of the language itself +$(call do,$(call REP, (def! *host-language* "make") )) +$(call do,$(call REP, (def! not (fn* (a) (if a false true))) )) +$(call do,$(call REP, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")"))))) )) +$(call do,$(call REP, (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs))))))) )) +$(call do,$(call REP, (defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs)))))))) )) + +# Load and eval any files specified on the command line +$(if $(MAKECMDGOALS),\ + $(foreach arg,$(wordlist 2,$(words $(MAKECMDGOALS)),$(MAKECMDGOALS)),\ + $(call do,$(call _conj!,$(_argv),$(call _string,$(arg)))))\ + $(call do,$(call REP, (load-file "$(word 1,$(MAKECMDGOALS))") )) \ + $(eval INTERACTIVE :=),) + +# repl loop +$(if $(strip $(INTERACTIVE)),\ + $(call do,$(call REP, (println (str "Mal [" *host-language* "]")) )) \ + $(call REPL)) + +.PHONY: none $(MAKECMDGOALS) +none $(MAKECMDGOALS): + @true diff --git a/make/stepA_more.mk b/make/stepA_more.mk deleted file mode 100644 index 050366c..0000000 --- a/make/stepA_more.mk +++ /dev/null @@ -1,192 +0,0 @@ -# -# mal (Make Lisp) -# -_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) -include $(_TOP_DIR)types.mk -include $(_TOP_DIR)reader.mk -include $(_TOP_DIR)printer.mk -include $(_TOP_DIR)env.mk -include $(_TOP_DIR)core.mk - -SHELL := /bin/bash -INTERACTIVE ?= yes -EVAL_DEBUG ?= - -# READ: read and parse input -define READ -$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) -endef - -# EVAL: evaluate the parameter -IS_PAIR = $(if $(call _sequential?,$(1)),$(if $(call _EQ,0,$(call _count,$(1))),,true),) - -define QUASIQUOTE -$(strip \ - $(if $(call _NOT,$(call IS_PAIR,$(1))),\ - $(call _list,$(call _symbol,quote) $(1)),\ - $(if $(call _EQ,unquote,$($(call _nth,$(1),0)_value)),\ - $(call _nth,$(1),1),\ - $(if $(and $(call IS_PAIR,$(call _nth,$(1),0)),$(call _EQ,splice-unquote,$($(call _nth,$(call _nth,$(1),0),0)_value))),\ - $(call _list,$(call _symbol,concat) $(call _nth,$(call _nth,$(1),0),1) $(call QUASIQUOTE,$(call srest,$(1)))),\ - $(call _list,$(call _symbol,cons) $(call QUASIQUOTE,$(call _nth,$(1),0)) $(call QUASIQUOTE,$(call srest,$(1)))))))) -endef - -define IS_MACRO_CALL -$(if $(call _list?,$(1)),$(call ENV_FIND,$(2),_macro_$($(call _nth,$(1),0)_value)),) -endef - -define MACROEXPAND -$(strip $(if $(__ERROR),,\ - $(if $(call IS_MACRO_CALL,$(1),$(2)),\ - $(foreach mac,$(call ENV_GET,$(2),$($(call _nth,$(1),0)_value)),\ - $(call MACROEXPAND,$(call apply,$(mac),$(call srest,$(1))),$(2))),\ - $(1)))) -endef - -define LET -$(strip \ - $(word 1,$(2) \ - $(foreach var,$(call _nth,$(1),0),\ - $(foreach val,$(call _nth,$(1),1),\ - $(call ENV_SET,$(2),$($(var)_value),$(call EVAL,$(val),$(2)))\ - $(foreach left,$(call srest,$(call srest,$(1))), - $(if $(call _EQ,0,$(call _count,$(left))),\ - ,\ - $(call LET,$(left),$(2)))))))) -endef - -define EVAL_AST -$(strip \ - $(and $(EVAL_DEBUG),$(info EVAL_AST: $(call _pr_str,$(1))))\ - $(if $(call _symbol?,$(1)),\ - $(foreach key,$($(1)_value),\ - $(call ENV_GET,$(2),$(key))),\ - $(if $(call _list?,$(1)),\ - $(call _smap,EVAL,$(1),$(2)),\ - $(if $(call _vector?,$(1)),\ - $(call _smap_vec,EVAL,$(1),$(2)),\ - $(if $(call _hash_map?,$(1)),\ - $(foreach new_hmap,$(call __new_obj,hmap),\ - $(foreach v,$(call __get_obj_values,$(1)),\ - $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ - $(eval $(new_hmap)_size := $($(1)_size))\ - $(new_hmap)),\ - $(1)))))) -endef - -define EVAL_INVOKE -$(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1)))) - $(foreach a0,$(call _nth,$(1),0),\ - $(if $(call _EQ,def!,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call EVAL,$(a2),$(2)),\ - $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),)))),\ - $(if $(call _EQ,let*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ - $(if $(call _EQ,quote,$($(a0)_value)),\ - $(call _nth,$(1),1),\ - $(if $(call _EQ,quasiquote,$($(a0)_value)),\ - $(call EVAL,$(call QUASIQUOTE,$(call _nth,$(1),1)),$(2)),\ - $(if $(call _EQ,defmacro!,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call EVAL,$(a2),$(2)),\ - $(if $(call ENV_SET,$(2),_macro_$($(a1)_value),true),,)\ - $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),)))),\ - $(if $(call _EQ,macroexpand,$($(a0)_value)),\ - $(call MACROEXPAND,$(call _nth,$(1),1),$(2)),\ - $(if $(call _EQ,make*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(and $(EVAL_DEBUG),$(info make*: $$(eval __result := $(call str_decode,$(value $(a1)_value)))))\ - $(eval __result := $(call str_decode,$(value $(a1)_value)))$(call _string,$(__result))),\ - $(if $(call _EQ,try*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach res,$(call EVAL,$(a1),$(2)),\ - $(if $(__ERROR),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach a20,$(call _nth,$(a2),0),\ - $(if $(call _EQ,catch*,$($(a20)_value)),\ - $(foreach a21,$(call _nth,$(a2),1),\ - $(foreach a22,$(call _nth,$(a2),2),\ - $(foreach binds,$(call _list,$(a21)),\ - $(foreach catch_env,$(call ENV,$(2),$(binds),$(__ERROR)),\ - $(eval __ERROR :=)\ - $(call EVAL,$(a22),$(catch_env)))))),\ - $(res)))),\ - $(res)))),\ - $(if $(call _EQ,do,$($(a0)_value)),\ - $(call slast,$(call EVAL_AST,$(call srest,$(1)),$(2))),\ - $(if $(call _EQ,if,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach cond,$(call EVAL,$(a1),$(2)),\ - $(if $(or $(call _EQ,$(__nil),$(cond)),$(call _EQ,$(__false),$(cond))),\ - $(foreach a3,$(call _nth,$(1),3),$(call EVAL,$(a3),$(2))),\ - $(call EVAL,$(a2),$(2)))))),\ - $(if $(call _EQ,fn*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call _function,$$(call EVAL,$(a2),$$(call ENV,$(2),$(a1),$$1))))),\ - $(foreach el,$(call EVAL_AST,$(1),$(2)),\ - $(and $(EVAL_DEBUG),$(info invoke: $(call _pr_str,$(el))))\ - $(foreach f,$(call sfirst,$(el)),\ - $(foreach args,$(call srest,$(el)),\ - $(call apply,$(f),$(args)))))))))))))))))) -endef - -define EVAL -$(strip $(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL: $(call _pr_str,$(1))))\ - $(if $(call _list?,$(1)),\ - $(foreach ast,$(call MACROEXPAND,$(1),$(2)), - $(if $(call _list?,$(ast)),\ - $(word 1,$(strip $(call EVAL_INVOKE,$(ast),$(2)) $(__nil))),\ - $(ast))),\ - $(call EVAL_AST,$(1),$(2))))) -endef - - -# PRINT: -define PRINT -$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) -endef - -# REPL: -REPL_ENV := $(call ENV) -REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) -REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) - -# core.mk: defined using Make -_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call _function,$$(call $(2),$$1)))) -_import_core = $(if $(strip $(1)),$(call _fref,$(word 1,$(1)),$(word 2,$(1)))$(call _import_core,$(wordlist 3,$(words $(1)),$(1))),) -$(call _import_core,$(core_ns)) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),eval,$(call _function,$$(call EVAL,$$(1),$$(REPL_ENV)))) -_argv := $(call _list) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),*ARGV*,$(_argv)) - -# core.mal: defined in terms of the language itself -$(call do,$(call REP, (def! *host-language* "make") )) -$(call do,$(call REP, (def! not (fn* (a) (if a false true))) )) -$(call do,$(call REP, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")"))))) )) -$(call do,$(call REP, (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs))))))) )) -$(call do,$(call REP, (defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs)))))))) )) - -# Load and eval any files specified on the command line -$(if $(MAKECMDGOALS),\ - $(foreach arg,$(wordlist 2,$(words $(MAKECMDGOALS)),$(MAKECMDGOALS)),\ - $(call do,$(call _conj!,$(_argv),$(call _string,$(arg)))))\ - $(call do,$(call REP, (load-file "$(word 1,$(MAKECMDGOALS))") )) \ - $(eval INTERACTIVE :=),) - -# repl loop -$(if $(strip $(INTERACTIVE)),\ - $(call do,$(call REP, (println (str "Mal [" *host-language* "]")) )) \ - $(call REPL)) - -.PHONY: none $(MAKECMDGOALS) -none $(MAKECMDGOALS): - @true diff --git a/make/tests/step9_interop.mal b/make/tests/step9_interop.mal deleted file mode 100644 index 9b1a2f9..0000000 --- a/make/tests/step9_interop.mal +++ /dev/null @@ -1,19 +0,0 @@ -;; Testing basic make interop - -(make* "7") -;=>"7" - -(make* "$(info foo)") -; foo -;=>"" - -(make* "$(eval foo := 8)") -(make* "$(foo)") -;=>"8" - -(make* "$(foreach v,a b c,X$(v)Y)") -;=>"XaY XbY XcY" - -(read-string (make* "($(foreach v,1 2 3,$(call gmsl_plus,1,$(v))))")) -;=>(2 3 4) - diff --git a/make/tests/stepA_interop.mal b/make/tests/stepA_interop.mal new file mode 100644 index 0000000..9b1a2f9 --- /dev/null +++ b/make/tests/stepA_interop.mal @@ -0,0 +1,19 @@ +;; Testing basic make interop + +(make* "7") +;=>"7" + +(make* "$(info foo)") +; foo +;=>"" + +(make* "$(eval foo := 8)") +(make* "$(foo)") +;=>"8" + +(make* "$(foreach v,a b c,X$(v)Y)") +;=>"XaY XbY XcY" + +(read-string (make* "($(foreach v,1 2 3,$(call gmsl_plus,1,$(v))))")) +;=>(2 3 4) + diff --git a/mal/Makefile b/mal/Makefile index 7e45ad4..1990b6b 100644 --- a/mal/Makefile +++ b/mal/Makefile @@ -2,7 +2,7 @@ TESTS = SOURCES_BASE = -SOURCES_LISP = env.mal core.mal stepA_more.mal +SOURCES_LISP = env.mal core.mal stepA_interop.mal SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) #.PHONY: stats tests $(TESTS) diff --git a/mal/step9_try.mal b/mal/step9_try.mal new file mode 100644 index 0000000..3e2a258 --- /dev/null +++ b/mal/step9_try.mal @@ -0,0 +1,181 @@ +(load-file "../mal/env.mal") +(load-file "../mal/core.mal") + +;; read +(def! READ (fn* [strng] + (read-string strng))) + + +;; eval +(def! is-pair (fn* [x] + (if (sequential? x) + (if (> (count x) 0) + true)))) + +(def! QUASIQUOTE (fn* [ast] + (cond + (not (is-pair ast)) + (list 'quote ast) + + (= 'unquote (first ast)) + (nth ast 1) + + (if (is-pair (first ast)) + (if (= 'splice-unquote (first (first ast))) + true)) + (list 'concat (nth (first ast) 1) (QUASIQUOTE (rest ast))) + + "else" + (list 'cons (QUASIQUOTE (first ast)) (QUASIQUOTE (rest ast)))))) + +(def! is-macro-call (fn* [ast env] + (if (list? ast) + (let* [a0 (first ast)] + (if (symbol? a0) + (if (env-find env a0) + (let* [m (meta (env-get env a0))] + (if m + (if (get m "ismacro") + true))))))))) + +(def! MACROEXPAND (fn* [ast env] + (if (is-macro-call ast env) + (let* [mac (env-get env (first ast))] + (MACROEXPAND (apply mac (rest ast)) env)) + ast))) + +(def! eval-ast (fn* [ast env] (do + ;;(do (prn "eval-ast" ast "/" (keys env)) ) + (cond + (symbol? ast) (env-get env ast) + + (list? ast) (map (fn* [exp] (EVAL exp env)) ast) + + (vector? ast) (apply vector (map (fn* [exp] (EVAL exp env)) ast)) + + (map? ast) (apply hash-map + (apply concat + (map (fn* [k] [k (EVAL (get ast k) env)]) + (keys ast)))) + + "else" ast)))) + +(def! LET (fn* [env args] + (if (> (count args) 0) + (do + (env-set env (nth args 0) (EVAL (nth args 1) env)) + (LET env (rest (rest args))))))) + +(def! EVAL (fn* [ast env] (do + ;;(do (prn "EVAL" ast "/" (keys @env)) ) + (if (not (list? ast)) + (eval-ast ast env) + + ;; apply list + (let* [ast (MACROEXPAND ast env)] + (if (not (list? ast)) + ast + + (let* [a0 (first ast)] + (cond + (= 'def! a0) + (env-set env (nth ast 1) (EVAL (nth ast 2) env)) + + (= 'let* a0) + (let* [let-env (new-env env)] + (do + (LET let-env (nth ast 1)) + (EVAL (nth ast 2) let-env))) + + (= 'quote a0) + (nth ast 1) + + (= 'quasiquote a0) + (let* [a1 (nth ast 1)] + (EVAL (QUASIQUOTE a1) env)) + + (= 'defmacro! a0) + (let* [a1 (nth ast 1) + a2 (nth ast 2) + f (EVAL a2 env) + m (or (meta f) {}) + mac (with-meta f (assoc m "ismacro" true))] + (env-set env a1 mac)) + + (= 'macroexpand a0) + (let* [a1 (nth ast 1)] + (MACROEXPAND a1 env)) + + (= 'try* a0) + (if (= 'catch* (nth (nth ast 2) 0)) + (try* + (EVAL (nth ast 1) env) + (catch* exc + (EVAL (nth (nth ast 2) 2) + (new-env env + [(nth (nth ast 2)1)] + [exc])))) + (EVAL (nth ast 1) env)) + + (= 'do a0) + (let* [el (eval-ast (rest ast) env)] + (nth el (- (count el) 1))) + + (= 'if a0) + (let* [cond (EVAL (nth ast 1) env)] + (if (or (= cond nil) (= cond false)) + (if (> (count ast) 3) + (EVAL (nth ast 3) env) + nil) + (EVAL (nth ast 2) env))) + + (= 'fn* a0) + (fn* [& args] + (EVAL (nth ast 2) (new-env env (nth ast 1) args))) + + "else" + (let* [el (eval-ast ast env) + f (first el) + args (rest el)] + (apply f args)))))))))) + + +;; print +(def! PRINT (fn* [exp] (pr-str exp))) + +;; repl +(def! repl-env (new-env)) +(def! rep (fn* [strng] + (PRINT (EVAL (READ strng) repl-env)))) + +;; core.mal: defined directly using mal +(map (fn* [data] (env-set repl-env (nth data 0) (nth data 1))) core_ns) +(env-set repl-env 'eval (fn* [ast] (EVAL ast repl-env))) +(env-set repl-env '*ARGV* (rest *ARGV*)) + +;; core.mal: defined using the new language itself +(rep (str "(def! *host-language* \"" *host-language* "-mal\")")) +(rep "(def! not (fn* [a] (if a false true)))") +(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") +(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") +(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") + +;; repl loop +(def! repl-loop (fn* [] + (let* [line (readline "mal-user> ")] + (if line + (do + (if (not (= "" line)) + (try* + (println (rep line)) + (catch* exc + (println "Uncaught exception:" exc)))) + (repl-loop)))))) + +(def! -main (fn* [& args] + (if (> (count args) 0) + (rep (str "(load-file \"" (first args) "\")")) + (do + (rep "(println (str \"Mal [\" *host-language* \"]\"))") + (repl-loop))))) +(apply -main *ARGV*) diff --git a/mal/stepA_interop.mal b/mal/stepA_interop.mal new file mode 100644 index 0000000..3e2a258 --- /dev/null +++ b/mal/stepA_interop.mal @@ -0,0 +1,181 @@ +(load-file "../mal/env.mal") +(load-file "../mal/core.mal") + +;; read +(def! READ (fn* [strng] + (read-string strng))) + + +;; eval +(def! is-pair (fn* [x] + (if (sequential? x) + (if (> (count x) 0) + true)))) + +(def! QUASIQUOTE (fn* [ast] + (cond + (not (is-pair ast)) + (list 'quote ast) + + (= 'unquote (first ast)) + (nth ast 1) + + (if (is-pair (first ast)) + (if (= 'splice-unquote (first (first ast))) + true)) + (list 'concat (nth (first ast) 1) (QUASIQUOTE (rest ast))) + + "else" + (list 'cons (QUASIQUOTE (first ast)) (QUASIQUOTE (rest ast)))))) + +(def! is-macro-call (fn* [ast env] + (if (list? ast) + (let* [a0 (first ast)] + (if (symbol? a0) + (if (env-find env a0) + (let* [m (meta (env-get env a0))] + (if m + (if (get m "ismacro") + true))))))))) + +(def! MACROEXPAND (fn* [ast env] + (if (is-macro-call ast env) + (let* [mac (env-get env (first ast))] + (MACROEXPAND (apply mac (rest ast)) env)) + ast))) + +(def! eval-ast (fn* [ast env] (do + ;;(do (prn "eval-ast" ast "/" (keys env)) ) + (cond + (symbol? ast) (env-get env ast) + + (list? ast) (map (fn* [exp] (EVAL exp env)) ast) + + (vector? ast) (apply vector (map (fn* [exp] (EVAL exp env)) ast)) + + (map? ast) (apply hash-map + (apply concat + (map (fn* [k] [k (EVAL (get ast k) env)]) + (keys ast)))) + + "else" ast)))) + +(def! LET (fn* [env args] + (if (> (count args) 0) + (do + (env-set env (nth args 0) (EVAL (nth args 1) env)) + (LET env (rest (rest args))))))) + +(def! EVAL (fn* [ast env] (do + ;;(do (prn "EVAL" ast "/" (keys @env)) ) + (if (not (list? ast)) + (eval-ast ast env) + + ;; apply list + (let* [ast (MACROEXPAND ast env)] + (if (not (list? ast)) + ast + + (let* [a0 (first ast)] + (cond + (= 'def! a0) + (env-set env (nth ast 1) (EVAL (nth ast 2) env)) + + (= 'let* a0) + (let* [let-env (new-env env)] + (do + (LET let-env (nth ast 1)) + (EVAL (nth ast 2) let-env))) + + (= 'quote a0) + (nth ast 1) + + (= 'quasiquote a0) + (let* [a1 (nth ast 1)] + (EVAL (QUASIQUOTE a1) env)) + + (= 'defmacro! a0) + (let* [a1 (nth ast 1) + a2 (nth ast 2) + f (EVAL a2 env) + m (or (meta f) {}) + mac (with-meta f (assoc m "ismacro" true))] + (env-set env a1 mac)) + + (= 'macroexpand a0) + (let* [a1 (nth ast 1)] + (MACROEXPAND a1 env)) + + (= 'try* a0) + (if (= 'catch* (nth (nth ast 2) 0)) + (try* + (EVAL (nth ast 1) env) + (catch* exc + (EVAL (nth (nth ast 2) 2) + (new-env env + [(nth (nth ast 2)1)] + [exc])))) + (EVAL (nth ast 1) env)) + + (= 'do a0) + (let* [el (eval-ast (rest ast) env)] + (nth el (- (count el) 1))) + + (= 'if a0) + (let* [cond (EVAL (nth ast 1) env)] + (if (or (= cond nil) (= cond false)) + (if (> (count ast) 3) + (EVAL (nth ast 3) env) + nil) + (EVAL (nth ast 2) env))) + + (= 'fn* a0) + (fn* [& args] + (EVAL (nth ast 2) (new-env env (nth ast 1) args))) + + "else" + (let* [el (eval-ast ast env) + f (first el) + args (rest el)] + (apply f args)))))))))) + + +;; print +(def! PRINT (fn* [exp] (pr-str exp))) + +;; repl +(def! repl-env (new-env)) +(def! rep (fn* [strng] + (PRINT (EVAL (READ strng) repl-env)))) + +;; core.mal: defined directly using mal +(map (fn* [data] (env-set repl-env (nth data 0) (nth data 1))) core_ns) +(env-set repl-env 'eval (fn* [ast] (EVAL ast repl-env))) +(env-set repl-env '*ARGV* (rest *ARGV*)) + +;; core.mal: defined using the new language itself +(rep (str "(def! *host-language* \"" *host-language* "-mal\")")) +(rep "(def! not (fn* [a] (if a false true)))") +(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") +(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") +(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") + +;; repl loop +(def! repl-loop (fn* [] + (let* [line (readline "mal-user> ")] + (if line + (do + (if (not (= "" line)) + (try* + (println (rep line)) + (catch* exc + (println "Uncaught exception:" exc)))) + (repl-loop)))))) + +(def! -main (fn* [& args] + (if (> (count args) 0) + (rep (str "(load-file \"" (first args) "\")")) + (do + (rep "(println (str \"Mal [\" *host-language* \"]\"))") + (repl-loop))))) +(apply -main *ARGV*) diff --git a/mal/stepA_more.mal b/mal/stepA_more.mal deleted file mode 100644 index 3e2a258..0000000 --- a/mal/stepA_more.mal +++ /dev/null @@ -1,181 +0,0 @@ -(load-file "../mal/env.mal") -(load-file "../mal/core.mal") - -;; read -(def! READ (fn* [strng] - (read-string strng))) - - -;; eval -(def! is-pair (fn* [x] - (if (sequential? x) - (if (> (count x) 0) - true)))) - -(def! QUASIQUOTE (fn* [ast] - (cond - (not (is-pair ast)) - (list 'quote ast) - - (= 'unquote (first ast)) - (nth ast 1) - - (if (is-pair (first ast)) - (if (= 'splice-unquote (first (first ast))) - true)) - (list 'concat (nth (first ast) 1) (QUASIQUOTE (rest ast))) - - "else" - (list 'cons (QUASIQUOTE (first ast)) (QUASIQUOTE (rest ast)))))) - -(def! is-macro-call (fn* [ast env] - (if (list? ast) - (let* [a0 (first ast)] - (if (symbol? a0) - (if (env-find env a0) - (let* [m (meta (env-get env a0))] - (if m - (if (get m "ismacro") - true))))))))) - -(def! MACROEXPAND (fn* [ast env] - (if (is-macro-call ast env) - (let* [mac (env-get env (first ast))] - (MACROEXPAND (apply mac (rest ast)) env)) - ast))) - -(def! eval-ast (fn* [ast env] (do - ;;(do (prn "eval-ast" ast "/" (keys env)) ) - (cond - (symbol? ast) (env-get env ast) - - (list? ast) (map (fn* [exp] (EVAL exp env)) ast) - - (vector? ast) (apply vector (map (fn* [exp] (EVAL exp env)) ast)) - - (map? ast) (apply hash-map - (apply concat - (map (fn* [k] [k (EVAL (get ast k) env)]) - (keys ast)))) - - "else" ast)))) - -(def! LET (fn* [env args] - (if (> (count args) 0) - (do - (env-set env (nth args 0) (EVAL (nth args 1) env)) - (LET env (rest (rest args))))))) - -(def! EVAL (fn* [ast env] (do - ;;(do (prn "EVAL" ast "/" (keys @env)) ) - (if (not (list? ast)) - (eval-ast ast env) - - ;; apply list - (let* [ast (MACROEXPAND ast env)] - (if (not (list? ast)) - ast - - (let* [a0 (first ast)] - (cond - (= 'def! a0) - (env-set env (nth ast 1) (EVAL (nth ast 2) env)) - - (= 'let* a0) - (let* [let-env (new-env env)] - (do - (LET let-env (nth ast 1)) - (EVAL (nth ast 2) let-env))) - - (= 'quote a0) - (nth ast 1) - - (= 'quasiquote a0) - (let* [a1 (nth ast 1)] - (EVAL (QUASIQUOTE a1) env)) - - (= 'defmacro! a0) - (let* [a1 (nth ast 1) - a2 (nth ast 2) - f (EVAL a2 env) - m (or (meta f) {}) - mac (with-meta f (assoc m "ismacro" true))] - (env-set env a1 mac)) - - (= 'macroexpand a0) - (let* [a1 (nth ast 1)] - (MACROEXPAND a1 env)) - - (= 'try* a0) - (if (= 'catch* (nth (nth ast 2) 0)) - (try* - (EVAL (nth ast 1) env) - (catch* exc - (EVAL (nth (nth ast 2) 2) - (new-env env - [(nth (nth ast 2)1)] - [exc])))) - (EVAL (nth ast 1) env)) - - (= 'do a0) - (let* [el (eval-ast (rest ast) env)] - (nth el (- (count el) 1))) - - (= 'if a0) - (let* [cond (EVAL (nth ast 1) env)] - (if (or (= cond nil) (= cond false)) - (if (> (count ast) 3) - (EVAL (nth ast 3) env) - nil) - (EVAL (nth ast 2) env))) - - (= 'fn* a0) - (fn* [& args] - (EVAL (nth ast 2) (new-env env (nth ast 1) args))) - - "else" - (let* [el (eval-ast ast env) - f (first el) - args (rest el)] - (apply f args)))))))))) - - -;; print -(def! PRINT (fn* [exp] (pr-str exp))) - -;; repl -(def! repl-env (new-env)) -(def! rep (fn* [strng] - (PRINT (EVAL (READ strng) repl-env)))) - -;; core.mal: defined directly using mal -(map (fn* [data] (env-set repl-env (nth data 0) (nth data 1))) core_ns) -(env-set repl-env 'eval (fn* [ast] (EVAL ast repl-env))) -(env-set repl-env '*ARGV* (rest *ARGV*)) - -;; core.mal: defined using the new language itself -(rep (str "(def! *host-language* \"" *host-language* "-mal\")")) -(rep "(def! not (fn* [a] (if a false true)))") -(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") -(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") -(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") - -;; repl loop -(def! repl-loop (fn* [] - (let* [line (readline "mal-user> ")] - (if line - (do - (if (not (= "" line)) - (try* - (println (rep line)) - (catch* exc - (println "Uncaught exception:" exc)))) - (repl-loop)))))) - -(def! -main (fn* [& args] - (if (> (count args) 0) - (rep (str "(load-file \"" (first args) "\")")) - (do - (rep "(println (str \"Mal [\" *host-language* \"]\"))") - (repl-loop))))) -(apply -main *ARGV*) diff --git a/perl/Makefile b/perl/Makefile index 772bba7..d8e95a0 100644 --- a/perl/Makefile +++ b/perl/Makefile @@ -2,7 +2,7 @@ TESTS = SOURCES_BASE = readline.pm types.pm reader.pm printer.pm \ interop.pm -SOURCES_LISP = env.pm core.pm stepA_more.pl +SOURCES_LISP = env.pm core.pm stepA_interop.pl SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) #all: mal.pl diff --git a/perl/interop.pm b/perl/interop.pm index 44657ec..ffa379f 100644 --- a/perl/interop.pm +++ b/perl/interop.pm @@ -1,6 +1,7 @@ package interop; use strict; use warnings FATAL => qw(all); +no if $] >= 5.018, warnings => "experimental::smartmatch"; use feature qw(switch); use Exporter 'import'; our @EXPORT_OK = qw( pl_to_mal ); diff --git a/perl/printer.pm b/perl/printer.pm index e31bed5..9ce6707 100644 --- a/perl/printer.pm +++ b/perl/printer.pm @@ -1,6 +1,7 @@ package printer; use strict; use warnings FATAL => qw(all); +no if $] >= 5.018, warnings => "experimental::smartmatch"; use feature qw(switch); use Exporter 'import'; our @EXPORT_OK = qw( _pr_str ); diff --git a/perl/reader.pm b/perl/reader.pm index e49d5a1..cd4c565 100644 --- a/perl/reader.pm +++ b/perl/reader.pm @@ -2,6 +2,7 @@ package reader; use feature qw(switch); use strict; use warnings FATAL => qw(all); +no if $] >= 5.018, warnings => "experimental::smartmatch"; use Exporter 'import'; our @EXPORT_OK = qw( read_str ); diff --git a/perl/step1_read_print.pl b/perl/step1_read_print.pl index 14675b9..8288336 100644 --- a/perl/step1_read_print.pl +++ b/perl/step1_read_print.pl @@ -1,5 +1,6 @@ use strict; use warnings FATAL => qw(all); +no if $] >= 5.018, warnings => "experimental::smartmatch"; use File::Basename; use lib dirname (__FILE__); use readline qw(mal_readline); diff --git a/perl/step2_eval.pl b/perl/step2_eval.pl index 0cbd697..c3759a5 100644 --- a/perl/step2_eval.pl +++ b/perl/step2_eval.pl @@ -1,5 +1,6 @@ use strict; use warnings FATAL => qw(all); +no if $] >= 5.018, warnings => "experimental::smartmatch"; use File::Basename; use lib dirname (__FILE__); use readline qw(mal_readline); diff --git a/perl/step3_env.pl b/perl/step3_env.pl index 9a7efa4..f63443d 100644 --- a/perl/step3_env.pl +++ b/perl/step3_env.pl @@ -1,5 +1,6 @@ use strict; use warnings FATAL => qw(all); +no if $] >= 5.018, warnings => "experimental::smartmatch"; use File::Basename; use lib dirname (__FILE__); use readline qw(mal_readline); diff --git a/perl/step4_if_fn_do.pl b/perl/step4_if_fn_do.pl index 4a4a8d5..abf0c67 100644 --- a/perl/step4_if_fn_do.pl +++ b/perl/step4_if_fn_do.pl @@ -1,5 +1,6 @@ use strict; use warnings FATAL => qw(all); +no if $] >= 5.018, warnings => "experimental::smartmatch"; use File::Basename; use lib dirname (__FILE__); use readline qw(mal_readline); diff --git a/perl/step5_tco.pl b/perl/step5_tco.pl index a225d79..60dc13a 100644 --- a/perl/step5_tco.pl +++ b/perl/step5_tco.pl @@ -1,5 +1,6 @@ use strict; use warnings FATAL => qw(all); +no if $] >= 5.018, warnings => "experimental::smartmatch"; use File::Basename; use lib dirname (__FILE__); use readline qw(mal_readline); diff --git a/perl/step6_file.pl b/perl/step6_file.pl index 86ac3f3..a95197a 100644 --- a/perl/step6_file.pl +++ b/perl/step6_file.pl @@ -1,5 +1,6 @@ use strict; use warnings FATAL => qw(all); +no if $] >= 5.018, warnings => "experimental::smartmatch"; use File::Basename; use lib dirname (__FILE__); use readline qw(mal_readline); diff --git a/perl/step7_quote.pl b/perl/step7_quote.pl index 2e08c1a..5ce9199 100644 --- a/perl/step7_quote.pl +++ b/perl/step7_quote.pl @@ -1,5 +1,6 @@ use strict; use warnings FATAL => qw(all); +no if $] >= 5.018, warnings => "experimental::smartmatch"; use File::Basename; use lib dirname (__FILE__); use readline qw(mal_readline); diff --git a/perl/step8_macros.pl b/perl/step8_macros.pl index d723651..d95e032 100644 --- a/perl/step8_macros.pl +++ b/perl/step8_macros.pl @@ -1,5 +1,6 @@ use strict; use warnings FATAL => qw(all); +no if $] >= 5.018, warnings => "experimental::smartmatch"; use File::Basename; use lib dirname (__FILE__); use readline qw(mal_readline); diff --git a/perl/step9_interop.pl b/perl/step9_interop.pl deleted file mode 100644 index 4f53b6a..0000000 --- a/perl/step9_interop.pl +++ /dev/null @@ -1,226 +0,0 @@ -use strict; -use warnings FATAL => qw(all); -use File::Basename; -use lib dirname (__FILE__); -use readline qw(mal_readline); -use feature qw(switch); -use Data::Dumper; - -use types qw($nil $true $false _sequential_Q _symbol_Q _list_Q); -use reader; -use printer; -use env; -use core qw($core_ns); -use interop qw(pl_to_mal); - -# read -sub READ { - my $str = shift; - return reader::read_str($str); -} - -# eval -sub is_pair { - my ($x) = @_; - return _sequential_Q($x) && scalar(@{$x->{val}}) > 0; -} - -sub quasiquote { - my ($ast) = @_; - if (!is_pair($ast)) { - return List->new([Symbol->new("quote"), $ast]); - } elsif (_symbol_Q($ast->nth(0)) && ${$ast->nth(0)} eq 'unquote') { - return $ast->nth(1); - } elsif (is_pair($ast->nth(0)) && _symbol_Q($ast->nth(0)->nth(0)) && - ${$ast->nth(0)->nth(0)} eq 'splice-unquote') { - return List->new([Symbol->new("concat"), - $ast->nth(0)->nth(1), - quasiquote($ast->rest())]); - } else { - return List->new([Symbol->new("cons"), - quasiquote($ast->nth(0)), - quasiquote($ast->rest())]); - } -} - -sub is_macro_call { - my ($ast, $env) = @_; - if (_list_Q($ast) && - _symbol_Q($ast->nth(0)) && - $env->find(${$ast->nth(0)})) { - my ($f) = $env->get(${$ast->nth(0)}); - if ((ref $f) =~ /^Function/) { - return $f->{ismacro}; - } - } - return 0; -} - -sub macroexpand { - my ($ast, $env) = @_; - while (is_macro_call($ast, $env)) { - my $mac = $env->get(${$ast->nth(0)}); - $ast = $mac->apply($ast->rest()); - } - return $ast; -} - - -sub eval_ast { - my($ast, $env) = @_; - given (ref $ast) { - when (/^Symbol/) { - $env->get($$ast); - } - when (/^List/) { - my @lst = map {EVAL($_, $env)} @{$ast->{val}}; - return List->new(\@lst); - } - when (/^Vector/) { - my @lst = map {EVAL($_, $env)} @{$ast->{val}}; - return Vector->new(\@lst); - } - when (/^HashMap/) { - my $new_hm = {}; - foreach my $k (keys($ast->{val})) { - $new_hm->{$k} = EVAL($ast->get($k), $env); - } - return HashMap->new($new_hm); - } - default { - return $ast; - } - } -} - -sub EVAL { - my($ast, $env) = @_; - - while (1) { - - #print "EVAL: " . printer::_pr_str($ast) . "\n"; - if (! _list_Q($ast)) { - return eval_ast($ast, $env); - } - - # apply list - $ast = macroexpand($ast, $env); - if (! _list_Q($ast)) { return $ast; } - - my ($a0, $a1, $a2, $a3) = @{$ast->{val}}; - given ((ref $a0) =~ /^Symbol/ ? $$a0 : $a0) { - when (/^def!$/) { - my $res = EVAL($a2, $env); - return $env->set($$a1, $res); - } - when (/^let\*$/) { - my $let_env = Env->new($env); - for(my $i=0; $i < scalar(@{$a1->{val}}); $i+=2) { - $let_env->set(${$a1->nth($i)}, EVAL($a1->nth($i+1), $let_env)); - } - $ast = $a2; - $env = $let_env; - # Continue loop (TCO) - } - when (/^quote$/) { - return $a1; - } - when (/^quasiquote$/) { - $ast = quasiquote($a1); - # Continue loop (TCO) - } - when (/^defmacro!$/) { - my $func = EVAL($a2, $env); - $func->{ismacro} = 1; - return $env->set($$a1, $func); - } - when (/^macroexpand$/) { - return macroexpand($a1, $env); - } - when (/^pl\*$/) { - return pl_to_mal(eval(${$a1})); - } - when (/^do$/) { - eval_ast($ast->slice(1, $#{$ast->{val}}-1), $env); - $ast = $ast->nth($#{$ast->{val}}); - # Continue loop (TCO) - } - when (/^if$/) { - my $cond = EVAL($a1, $env); - if ($cond eq $nil || $cond eq $false) { - $ast = $a3 ? $a3 : $nil; - } else { - $ast = $a2; - } - # Continue loop (TCO) - } - when (/^fn\*$/) { - return Function->new(\&EVAL, $a2, $env, $a1); - } - default { - my $el = eval_ast($ast, $env); - my $f = $el->nth(0); - if ((ref $f) =~ /^Function/) { - $ast = $f->{ast}; - $env = $f->gen_env($el->rest()); - # Continue loop (TCO) - } else { - return &{ $f }($el->rest()); - } - } - } - - } # TCO while loop -} - -# print -sub PRINT { - my $exp = shift; - return printer::_pr_str($exp); -} - -# repl -my $repl_env = Env->new(); -sub REP { - my $str = shift; - return PRINT(EVAL(READ($str), $repl_env)); -} - -# core.pl: defined using perl -foreach my $n (%$core_ns) { $repl_env->set($n, $core_ns->{$n}); } -$repl_env->set('eval', sub { EVAL($_[0]->nth(0), $repl_env); }); -my @_argv = map {String->new($_)} @ARGV[1..$#ARGV]; -$repl_env->set('*ARGV*', List->new(\@_argv)); - -# core.mal: defined using the language itself -REP("(def! not (fn* (a) (if a false true)))"); -REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); - -if (scalar(@ARGV) > 0) { - REP("(load-file \"" . $ARGV[0] . "\")"); - exit 0; -} -while (1) { - my $line = mal_readline("user> "); - if (! defined $line) { last; } - do { - local $@; - my $ret; - eval { - use autodie; # always "throw" errors - print(REP($line), "\n"); - 1; - } or do { - my $err = $@; - given (ref $err) { - when (/^BlankException/) { - # ignore and continue - } - default { - chomp $err; - print "Error: $err\n"; - } - } - }; - }; -} diff --git a/perl/step9_try.pl b/perl/step9_try.pl new file mode 100644 index 0000000..5862ef1 --- /dev/null +++ b/perl/step9_try.pl @@ -0,0 +1,256 @@ +use strict; +use warnings FATAL => qw(all); +no if $] >= 5.018, warnings => "experimental::smartmatch"; +use File::Basename; +use lib dirname (__FILE__); +use readline qw(mal_readline); +use feature qw(switch); +use Data::Dumper; + +use types qw($nil $true $false _sequential_Q _symbol_Q _list_Q); +use reader; +use printer; +use env; +use core qw($core_ns); +use interop qw(pl_to_mal); + +# read +sub READ { + my $str = shift; + return reader::read_str($str); +} + +# eval +sub is_pair { + my ($x) = @_; + return _sequential_Q($x) && scalar(@{$x->{val}}) > 0; +} + +sub quasiquote { + my ($ast) = @_; + if (!is_pair($ast)) { + return List->new([Symbol->new("quote"), $ast]); + } elsif (_symbol_Q($ast->nth(0)) && ${$ast->nth(0)} eq 'unquote') { + return $ast->nth(1); + } elsif (is_pair($ast->nth(0)) && _symbol_Q($ast->nth(0)->nth(0)) && + ${$ast->nth(0)->nth(0)} eq 'splice-unquote') { + return List->new([Symbol->new("concat"), + $ast->nth(0)->nth(1), + quasiquote($ast->rest())]); + } else { + return List->new([Symbol->new("cons"), + quasiquote($ast->nth(0)), + quasiquote($ast->rest())]); + } +} + +sub is_macro_call { + my ($ast, $env) = @_; + if (_list_Q($ast) && + _symbol_Q($ast->nth(0)) && + $env->find(${$ast->nth(0)})) { + my ($f) = $env->get(${$ast->nth(0)}); + if ((ref $f) =~ /^Function/) { + return $f->{ismacro}; + } + } + return 0; +} + +sub macroexpand { + my ($ast, $env) = @_; + while (is_macro_call($ast, $env)) { + my $mac = $env->get(${$ast->nth(0)}); + $ast = $mac->apply($ast->rest()); + } + return $ast; +} + + +sub eval_ast { + my($ast, $env) = @_; + given (ref $ast) { + when (/^Symbol/) { + $env->get($$ast); + } + when (/^List/) { + my @lst = map {EVAL($_, $env)} @{$ast->{val}}; + return List->new(\@lst); + } + when (/^Vector/) { + my @lst = map {EVAL($_, $env)} @{$ast->{val}}; + return Vector->new(\@lst); + } + when (/^HashMap/) { + my $new_hm = {}; + foreach my $k (keys($ast->{val})) { + $new_hm->{$k} = EVAL($ast->get($k), $env); + } + return HashMap->new($new_hm); + } + default { + return $ast; + } + } +} + +sub EVAL { + my($ast, $env) = @_; + + while (1) { + + #print "EVAL: " . printer::_pr_str($ast) . "\n"; + if (! _list_Q($ast)) { + return eval_ast($ast, $env); + } + + # apply list + $ast = macroexpand($ast, $env); + if (! _list_Q($ast)) { return $ast; } + + my ($a0, $a1, $a2, $a3) = @{$ast->{val}}; + given ((ref $a0) =~ /^Symbol/ ? $$a0 : $a0) { + when (/^def!$/) { + my $res = EVAL($a2, $env); + return $env->set($$a1, $res); + } + when (/^let\*$/) { + my $let_env = Env->new($env); + for(my $i=0; $i < scalar(@{$a1->{val}}); $i+=2) { + $let_env->set(${$a1->nth($i)}, EVAL($a1->nth($i+1), $let_env)); + } + $ast = $a2; + $env = $let_env; + # Continue loop (TCO) + } + when (/^quote$/) { + return $a1; + } + when (/^quasiquote$/) { + $ast = quasiquote($a1); + # Continue loop (TCO) + } + when (/^defmacro!$/) { + my $func = EVAL($a2, $env); + $func->{ismacro} = 1; + return $env->set($$a1, $func); + } + when (/^macroexpand$/) { + return macroexpand($a1, $env); + } + when (/^try\*$/) { + do { + local $@; + my $ret; + eval { + use autodie; # always "throw" errors + $ret = EVAL($a1, $env); + 1; + } or do { + my $err = $@; + if ($a2 && ${$a2->nth(0)} eq "catch\*") { + my $exc; + if (ref $err) { + $exc = $err; + } else { + $exc = String->new(substr $err, 0, -1); + } + return EVAL($a2->nth(2), Env->new($env, + List->new([$a2->nth(1)]), + List->new([$exc]))); + } else { + die $err; + } + }; + return $ret; + }; + } + when (/^do$/) { + eval_ast($ast->slice(1, $#{$ast->{val}}-1), $env); + $ast = $ast->nth($#{$ast->{val}}); + # Continue loop (TCO) + } + when (/^if$/) { + my $cond = EVAL($a1, $env); + if ($cond eq $nil || $cond eq $false) { + $ast = $a3 ? $a3 : $nil; + } else { + $ast = $a2; + } + # Continue loop (TCO) + } + when (/^fn\*$/) { + return Function->new(\&EVAL, $a2, $env, $a1); + } + default { + my $el = eval_ast($ast, $env); + my $f = $el->nth(0); + if ((ref $f) =~ /^Function/) { + $ast = $f->{ast}; + $env = $f->gen_env($el->rest()); + # Continue loop (TCO) + } else { + return &{ $f }($el->rest()); + } + } + } + + } # TCO while loop +} + +# print +sub PRINT { + my $exp = shift; + return printer::_pr_str($exp); +} + +# repl +my $repl_env = Env->new(); +sub REP { + my $str = shift; + return PRINT(EVAL(READ($str), $repl_env)); +} + +# core.pl: defined using perl +foreach my $n (%$core_ns) { $repl_env->set($n, $core_ns->{$n}); } +$repl_env->set('eval', sub { EVAL($_[0]->nth(0), $repl_env); }); +my @_argv = map {String->new($_)} @ARGV[1..$#ARGV]; +$repl_env->set('*ARGV*', List->new(\@_argv)); + +# core.mal: defined using the language itself +REP("(def! *host-language* \"javascript\")"); +REP("(def! not (fn* (a) (if a false true)))"); +REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); +REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); +REP("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); + + +if (scalar(@ARGV) > 0) { + REP("(load-file \"" . $ARGV[0] . "\")"); + exit 0; +} +REP("(println (str \"Mal [\" *host-language* \"]\"))"); +while (1) { + my $line = mal_readline("user> "); + if (! defined $line) { last; } + do { + local $@; + my $ret; + eval { + use autodie; # always "throw" errors + print(REP($line), "\n"); + 1; + } or do { + my $err = $@; + given (ref $err) { + when (/^BlankException/) { + # ignore and continue + } + default { + chomp $err; + print "Error: $err\n"; + } + } + }; + }; +} diff --git a/perl/stepA_interop.pl b/perl/stepA_interop.pl new file mode 100644 index 0000000..0605d57 --- /dev/null +++ b/perl/stepA_interop.pl @@ -0,0 +1,259 @@ +use strict; +use warnings FATAL => qw(all); +no if $] >= 5.018, warnings => "experimental::smartmatch"; +use File::Basename; +use lib dirname (__FILE__); +use readline qw(mal_readline); +use feature qw(switch); +use Data::Dumper; + +use types qw($nil $true $false _sequential_Q _symbol_Q _list_Q); +use reader; +use printer; +use env; +use core qw($core_ns); +use interop qw(pl_to_mal); + +# read +sub READ { + my $str = shift; + return reader::read_str($str); +} + +# eval +sub is_pair { + my ($x) = @_; + return _sequential_Q($x) && scalar(@{$x->{val}}) > 0; +} + +sub quasiquote { + my ($ast) = @_; + if (!is_pair($ast)) { + return List->new([Symbol->new("quote"), $ast]); + } elsif (_symbol_Q($ast->nth(0)) && ${$ast->nth(0)} eq 'unquote') { + return $ast->nth(1); + } elsif (is_pair($ast->nth(0)) && _symbol_Q($ast->nth(0)->nth(0)) && + ${$ast->nth(0)->nth(0)} eq 'splice-unquote') { + return List->new([Symbol->new("concat"), + $ast->nth(0)->nth(1), + quasiquote($ast->rest())]); + } else { + return List->new([Symbol->new("cons"), + quasiquote($ast->nth(0)), + quasiquote($ast->rest())]); + } +} + +sub is_macro_call { + my ($ast, $env) = @_; + if (_list_Q($ast) && + _symbol_Q($ast->nth(0)) && + $env->find(${$ast->nth(0)})) { + my ($f) = $env->get(${$ast->nth(0)}); + if ((ref $f) =~ /^Function/) { + return $f->{ismacro}; + } + } + return 0; +} + +sub macroexpand { + my ($ast, $env) = @_; + while (is_macro_call($ast, $env)) { + my $mac = $env->get(${$ast->nth(0)}); + $ast = $mac->apply($ast->rest()); + } + return $ast; +} + + +sub eval_ast { + my($ast, $env) = @_; + given (ref $ast) { + when (/^Symbol/) { + $env->get($$ast); + } + when (/^List/) { + my @lst = map {EVAL($_, $env)} @{$ast->{val}}; + return List->new(\@lst); + } + when (/^Vector/) { + my @lst = map {EVAL($_, $env)} @{$ast->{val}}; + return Vector->new(\@lst); + } + when (/^HashMap/) { + my $new_hm = {}; + foreach my $k (keys($ast->{val})) { + $new_hm->{$k} = EVAL($ast->get($k), $env); + } + return HashMap->new($new_hm); + } + default { + return $ast; + } + } +} + +sub EVAL { + my($ast, $env) = @_; + + while (1) { + + #print "EVAL: " . printer::_pr_str($ast) . "\n"; + if (! _list_Q($ast)) { + return eval_ast($ast, $env); + } + + # apply list + $ast = macroexpand($ast, $env); + if (! _list_Q($ast)) { return $ast; } + + my ($a0, $a1, $a2, $a3) = @{$ast->{val}}; + given ((ref $a0) =~ /^Symbol/ ? $$a0 : $a0) { + when (/^def!$/) { + my $res = EVAL($a2, $env); + return $env->set($$a1, $res); + } + when (/^let\*$/) { + my $let_env = Env->new($env); + for(my $i=0; $i < scalar(@{$a1->{val}}); $i+=2) { + $let_env->set(${$a1->nth($i)}, EVAL($a1->nth($i+1), $let_env)); + } + $ast = $a2; + $env = $let_env; + # Continue loop (TCO) + } + when (/^quote$/) { + return $a1; + } + when (/^quasiquote$/) { + $ast = quasiquote($a1); + # Continue loop (TCO) + } + when (/^defmacro!$/) { + my $func = EVAL($a2, $env); + $func->{ismacro} = 1; + return $env->set($$a1, $func); + } + when (/^macroexpand$/) { + return macroexpand($a1, $env); + } + when (/^pl\*$/) { + return pl_to_mal(eval(${$a1})); + } + when (/^try\*$/) { + do { + local $@; + my $ret; + eval { + use autodie; # always "throw" errors + $ret = EVAL($a1, $env); + 1; + } or do { + my $err = $@; + if ($a2 && ${$a2->nth(0)} eq "catch\*") { + my $exc; + if (ref $err) { + $exc = $err; + } else { + $exc = String->new(substr $err, 0, -1); + } + return EVAL($a2->nth(2), Env->new($env, + List->new([$a2->nth(1)]), + List->new([$exc]))); + } else { + die $err; + } + }; + return $ret; + }; + } + when (/^do$/) { + eval_ast($ast->slice(1, $#{$ast->{val}}-1), $env); + $ast = $ast->nth($#{$ast->{val}}); + # Continue loop (TCO) + } + when (/^if$/) { + my $cond = EVAL($a1, $env); + if ($cond eq $nil || $cond eq $false) { + $ast = $a3 ? $a3 : $nil; + } else { + $ast = $a2; + } + # Continue loop (TCO) + } + when (/^fn\*$/) { + return Function->new(\&EVAL, $a2, $env, $a1); + } + default { + my $el = eval_ast($ast, $env); + my $f = $el->nth(0); + if ((ref $f) =~ /^Function/) { + $ast = $f->{ast}; + $env = $f->gen_env($el->rest()); + # Continue loop (TCO) + } else { + return &{ $f }($el->rest()); + } + } + } + + } # TCO while loop +} + +# print +sub PRINT { + my $exp = shift; + return printer::_pr_str($exp); +} + +# repl +my $repl_env = Env->new(); +sub REP { + my $str = shift; + return PRINT(EVAL(READ($str), $repl_env)); +} + +# core.pl: defined using perl +foreach my $n (%$core_ns) { $repl_env->set($n, $core_ns->{$n}); } +$repl_env->set('eval', sub { EVAL($_[0]->nth(0), $repl_env); }); +my @_argv = map {String->new($_)} @ARGV[1..$#ARGV]; +$repl_env->set('*ARGV*', List->new(\@_argv)); + +# core.mal: defined using the language itself +REP("(def! *host-language* \"javascript\")"); +REP("(def! not (fn* (a) (if a false true)))"); +REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); +REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); +REP("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); + + +if (scalar(@ARGV) > 0) { + REP("(load-file \"" . $ARGV[0] . "\")"); + exit 0; +} +REP("(println (str \"Mal [\" *host-language* \"]\"))"); +while (1) { + my $line = mal_readline("user> "); + if (! defined $line) { last; } + do { + local $@; + my $ret; + eval { + use autodie; # always "throw" errors + print(REP($line), "\n"); + 1; + } or do { + my $err = $@; + given (ref $err) { + when (/^BlankException/) { + # ignore and continue + } + default { + chomp $err; + print "Error: $err\n"; + } + } + }; + }; +} diff --git a/perl/stepA_more.pl b/perl/stepA_more.pl deleted file mode 100644 index 3703c47..0000000 --- a/perl/stepA_more.pl +++ /dev/null @@ -1,258 +0,0 @@ -use strict; -use warnings FATAL => qw(all); -use File::Basename; -use lib dirname (__FILE__); -use readline qw(mal_readline); -use feature qw(switch); -use Data::Dumper; - -use types qw($nil $true $false _sequential_Q _symbol_Q _list_Q); -use reader; -use printer; -use env; -use core qw($core_ns); -use interop qw(pl_to_mal); - -# read -sub READ { - my $str = shift; - return reader::read_str($str); -} - -# eval -sub is_pair { - my ($x) = @_; - return _sequential_Q($x) && scalar(@{$x->{val}}) > 0; -} - -sub quasiquote { - my ($ast) = @_; - if (!is_pair($ast)) { - return List->new([Symbol->new("quote"), $ast]); - } elsif (_symbol_Q($ast->nth(0)) && ${$ast->nth(0)} eq 'unquote') { - return $ast->nth(1); - } elsif (is_pair($ast->nth(0)) && _symbol_Q($ast->nth(0)->nth(0)) && - ${$ast->nth(0)->nth(0)} eq 'splice-unquote') { - return List->new([Symbol->new("concat"), - $ast->nth(0)->nth(1), - quasiquote($ast->rest())]); - } else { - return List->new([Symbol->new("cons"), - quasiquote($ast->nth(0)), - quasiquote($ast->rest())]); - } -} - -sub is_macro_call { - my ($ast, $env) = @_; - if (_list_Q($ast) && - _symbol_Q($ast->nth(0)) && - $env->find(${$ast->nth(0)})) { - my ($f) = $env->get(${$ast->nth(0)}); - if ((ref $f) =~ /^Function/) { - return $f->{ismacro}; - } - } - return 0; -} - -sub macroexpand { - my ($ast, $env) = @_; - while (is_macro_call($ast, $env)) { - my $mac = $env->get(${$ast->nth(0)}); - $ast = $mac->apply($ast->rest()); - } - return $ast; -} - - -sub eval_ast { - my($ast, $env) = @_; - given (ref $ast) { - when (/^Symbol/) { - $env->get($$ast); - } - when (/^List/) { - my @lst = map {EVAL($_, $env)} @{$ast->{val}}; - return List->new(\@lst); - } - when (/^Vector/) { - my @lst = map {EVAL($_, $env)} @{$ast->{val}}; - return Vector->new(\@lst); - } - when (/^HashMap/) { - my $new_hm = {}; - foreach my $k (keys($ast->{val})) { - $new_hm->{$k} = EVAL($ast->get($k), $env); - } - return HashMap->new($new_hm); - } - default { - return $ast; - } - } -} - -sub EVAL { - my($ast, $env) = @_; - - while (1) { - - #print "EVAL: " . printer::_pr_str($ast) . "\n"; - if (! _list_Q($ast)) { - return eval_ast($ast, $env); - } - - # apply list - $ast = macroexpand($ast, $env); - if (! _list_Q($ast)) { return $ast; } - - my ($a0, $a1, $a2, $a3) = @{$ast->{val}}; - given ((ref $a0) =~ /^Symbol/ ? $$a0 : $a0) { - when (/^def!$/) { - my $res = EVAL($a2, $env); - return $env->set($$a1, $res); - } - when (/^let\*$/) { - my $let_env = Env->new($env); - for(my $i=0; $i < scalar(@{$a1->{val}}); $i+=2) { - $let_env->set(${$a1->nth($i)}, EVAL($a1->nth($i+1), $let_env)); - } - $ast = $a2; - $env = $let_env; - # Continue loop (TCO) - } - when (/^quote$/) { - return $a1; - } - when (/^quasiquote$/) { - $ast = quasiquote($a1); - # Continue loop (TCO) - } - when (/^defmacro!$/) { - my $func = EVAL($a2, $env); - $func->{ismacro} = 1; - return $env->set($$a1, $func); - } - when (/^macroexpand$/) { - return macroexpand($a1, $env); - } - when (/^pl\*$/) { - return pl_to_mal(eval(${$a1})); - } - when (/^try\*$/) { - do { - local $@; - my $ret; - eval { - use autodie; # always "throw" errors - $ret = EVAL($a1, $env); - 1; - } or do { - my $err = $@; - if ($a2 && ${$a2->nth(0)} eq "catch\*") { - my $exc; - if (ref $err) { - $exc = $err; - } else { - $exc = String->new(substr $err, 0, -1); - } - return EVAL($a2->nth(2), Env->new($env, - List->new([$a2->nth(1)]), - List->new([$exc]))); - } else { - die $err; - } - }; - return $ret; - }; - } - when (/^do$/) { - eval_ast($ast->slice(1, $#{$ast->{val}}-1), $env); - $ast = $ast->nth($#{$ast->{val}}); - # Continue loop (TCO) - } - when (/^if$/) { - my $cond = EVAL($a1, $env); - if ($cond eq $nil || $cond eq $false) { - $ast = $a3 ? $a3 : $nil; - } else { - $ast = $a2; - } - # Continue loop (TCO) - } - when (/^fn\*$/) { - return Function->new(\&EVAL, $a2, $env, $a1); - } - default { - my $el = eval_ast($ast, $env); - my $f = $el->nth(0); - if ((ref $f) =~ /^Function/) { - $ast = $f->{ast}; - $env = $f->gen_env($el->rest()); - # Continue loop (TCO) - } else { - return &{ $f }($el->rest()); - } - } - } - - } # TCO while loop -} - -# print -sub PRINT { - my $exp = shift; - return printer::_pr_str($exp); -} - -# repl -my $repl_env = Env->new(); -sub REP { - my $str = shift; - return PRINT(EVAL(READ($str), $repl_env)); -} - -# core.pl: defined using perl -foreach my $n (%$core_ns) { $repl_env->set($n, $core_ns->{$n}); } -$repl_env->set('eval', sub { EVAL($_[0]->nth(0), $repl_env); }); -my @_argv = map {String->new($_)} @ARGV[1..$#ARGV]; -$repl_env->set('*ARGV*', List->new(\@_argv)); - -# core.mal: defined using the language itself -REP("(def! *host-language* \"javascript\")"); -REP("(def! not (fn* (a) (if a false true)))"); -REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); -REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); -REP("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); - - -if (scalar(@ARGV) > 0) { - REP("(load-file \"" . $ARGV[0] . "\")"); - exit 0; -} -REP("(println (str \"Mal [\" *host-language* \"]\"))"); -while (1) { - my $line = mal_readline("user> "); - if (! defined $line) { last; } - do { - local $@; - my $ret; - eval { - use autodie; # always "throw" errors - print(REP($line), "\n"); - 1; - } or do { - my $err = $@; - given (ref $err) { - when (/^BlankException/) { - # ignore and continue - } - default { - chomp $err; - print "Error: $err\n"; - } - } - }; - }; -} diff --git a/perl/tests/step9_interop.mal b/perl/tests/step9_interop.mal deleted file mode 100644 index 1335be4..0000000 --- a/perl/tests/step9_interop.mal +++ /dev/null @@ -1,22 +0,0 @@ -;; Testing types returned from pl* - -(pl* "123") -;=>123 - -(pl* "\"abc\"") -;=>"abc" - -(pl* "{'abc'=>123}") -;=>{"abc" 123} - -(pl* "['abc', 123]") -;=>("abc" 123) - -(pl* "2+3") -;=>5 - -;; Testing eval of print statement - -(pl* "print 'hello\n';") -; hello -;=>1 diff --git a/perl/tests/stepA_interop.mal b/perl/tests/stepA_interop.mal new file mode 100644 index 0000000..1335be4 --- /dev/null +++ b/perl/tests/stepA_interop.mal @@ -0,0 +1,22 @@ +;; Testing types returned from pl* + +(pl* "123") +;=>123 + +(pl* "\"abc\"") +;=>"abc" + +(pl* "{'abc'=>123}") +;=>{"abc" 123} + +(pl* "['abc', 123]") +;=>("abc" 123) + +(pl* "2+3") +;=>5 + +;; Testing eval of print statement + +(pl* "print 'hello\n';") +; hello +;=>1 diff --git a/perl/types.pm b/perl/types.pm index e551e11..356f8c6 100644 --- a/perl/types.pm +++ b/perl/types.pm @@ -1,6 +1,7 @@ package types; use strict; use warnings FATAL => qw(all); +no if $] >= 5.018, warnings => "experimental::smartmatch"; use feature qw(switch); use Exporter 'import'; our @EXPORT_OK = qw(_sequential_Q _equal_Q _clone diff --git a/php/Makefile b/php/Makefile index 9b91421..d9fd2d4 100644 --- a/php/Makefile +++ b/php/Makefile @@ -2,7 +2,7 @@ TESTS = SOURCES_BASE = readline.php types.php reader.php printer.php -SOURCES_LISP = env.php core.php stepA_more.php +SOURCES_LISP = env.php core.php stepA_interop.php SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) .PHONY: stats tests $(TESTS) diff --git a/php/step9_interop.php b/php/step9_interop.php deleted file mode 100644 index d4a59c7..0000000 --- a/php/step9_interop.php +++ /dev/null @@ -1,197 +0,0 @@ - 0; -} - -function quasiquote($ast) { - if (!is_pair($ast)) { - return _list(_symbol("quote"), $ast); - } elseif (_symbol_Q($ast[0]) && $ast[0]->value === 'unquote') { - return $ast[1]; - } elseif (is_pair($ast[0]) && _symbol_Q($ast[0][0]) && - $ast[0][0]->value === 'splice-unquote') { - return _list(_symbol("concat"), $ast[0][1], - quasiquote($ast->slice(1))); - } else { - return _list(_symbol("cons"), quasiquote($ast[0]), - quasiquote($ast->slice(1))); - } -} - -function is_macro_call($ast, $env) { - return is_pair($ast) && - _symbol_Q($ast[0]) && - $env->find($ast[0]->value) && - $env->get($ast[0]->value)->ismacro; -} - -function macroexpand($ast, $env) { - while (is_macro_call($ast, $env)) { - $mac = $env->get($ast[0]->value); - $args = array_slice($ast->getArrayCopy(),1); - $ast = $mac->apply($args); - } - return $ast; -} - -function eval_ast($ast, $env) { - if (_symbol_Q($ast)) { - return $env->get($ast->value); - } elseif (_sequential_Q($ast)) { - if (_list_Q($ast)) { - $el = _list(); - } else { - $el = _vector(); - } - foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } - return $el; - } elseif (_hash_map_Q($ast)) { - $new_hm = _hash_map(); - foreach (array_keys($ast->getArrayCopy()) as $key) { - $new_hm[$key] = MAL_EVAL($ast[$key], $env); - } - return $new_hm; - } else { - return $ast; - } -} - -function MAL_EVAL($ast, $env) { - while (true) { - - #echo "MAL_EVAL: " . _pr_str($ast) . "\n"; - if (!_list_Q($ast)) { - return eval_ast($ast, $env); - } - - // apply list - $ast = macroexpand($ast, $env); - if (!_list_Q($ast)) { return $ast; } - - $a0 = $ast[0]; - $a0v = (_symbol_Q($a0) ? $a0->value : $a0); - switch ($a0v) { - case "def!": - $res = MAL_EVAL($ast[2], $env); - return $env->set($ast[1]->value, $res); - case "let*": - $a1 = $ast[1]; - $let_env = new Env($env); - for ($i=0; $i < count($a1); $i+=2) { - $let_env->set($a1[$i]->value, MAL_EVAL($a1[$i+1], $let_env)); - } - $ast = $ast[2]; - $env = $let_env; - break; // Continue loop (TCO) - case "quote": - return $ast[1]; - case "quasiquote": - $ast = quasiquote($ast[1]); - break; // Continue loop (TCO) - case "defmacro!": - $func = MAL_EVAL($ast[2], $env); - $func->ismacro = true; - return $env->set($ast[1]->value, $func); - case "macroexpand": - return macroexpand($ast[1], $env); - case "php*": - return eval($ast[1]); - case "do": - eval_ast($ast->slice(1, -1), $env); - $ast = $ast[count($ast)-1]; - break; // Continue loop (TCO) - case "if": - $cond = MAL_EVAL($ast[1], $env); - if ($cond === NULL || $cond === false) { - if (count($ast) === 4) { $ast = $ast[3]; } - else { $ast = NULL; } - } else { - $ast = $ast[2]; - } - break; // Continue loop (TCO) - case "fn*": - return _function('MAL_EVAL', 'native', - $ast[2], $env, $ast[1]); - default: - $el = eval_ast($ast, $env); - $f = $el[0]; - $args = array_slice($el->getArrayCopy(), 1); - if ($f->type === 'native') { - $ast = $f->ast; - $env = $f->gen_env($args); - // Continue loop (TCO) - } else { - return $f->apply($args); - } - } - - } -} - -// print -function MAL_PRINT($exp) { - return _pr_str($exp, True) . "\n"; -} - -// repl -$repl_env = new Env(NULL); -function rep($str) { - global $repl_env; - return MAL_PRINT(MAL_EVAL(READ($str), $repl_env)); -} - -// core.php: defined using PHP -foreach ($core_ns as $k=>$v) { - $repl_env->set($k, _function($v)); -} -$repl_env->set('eval', _function(function($ast) { - global $repl_env; return MAL_EVAL($ast, $repl_env); -})); -$_argv = _list(); -for ($i=2; $i < count($argv); $i++) { - $_argv->append($argv[$i]); -} -$repl_env->set('*ARGV*', $_argv); - -// core.mal: defined using the language itself -rep("(def! not (fn* (a) (if a false true)))"); -rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); -rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); -rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); - -if (count($argv) > 1) { - rep('(load-file "' . $argv[1] . '")'); - exit(0); -} - -// repl loop -do { - try { - $line = mal_readline("user> "); - if ($line === NULL) { break; } - if ($line !== "") { - print(rep($line)); - } - } catch (BlankException $e) { - continue; - } catch (Exception $e) { - echo "Error: " . $e->getMessage() . "\n"; - echo $e->getTraceAsString() . "\n"; - } -} while (true); - -?> diff --git a/php/step9_try.php b/php/step9_try.php new file mode 100644 index 0000000..9343dea --- /dev/null +++ b/php/step9_try.php @@ -0,0 +1,215 @@ + 0; +} + +function quasiquote($ast) { + if (!is_pair($ast)) { + return _list(_symbol("quote"), $ast); + } elseif (_symbol_Q($ast[0]) && $ast[0]->value === 'unquote') { + return $ast[1]; + } elseif (is_pair($ast[0]) && _symbol_Q($ast[0][0]) && + $ast[0][0]->value === 'splice-unquote') { + return _list(_symbol("concat"), $ast[0][1], + quasiquote($ast->slice(1))); + } else { + return _list(_symbol("cons"), quasiquote($ast[0]), + quasiquote($ast->slice(1))); + } +} + +function is_macro_call($ast, $env) { + return is_pair($ast) && + _symbol_Q($ast[0]) && + $env->find($ast[0]->value) && + $env->get($ast[0]->value)->ismacro; +} + +function macroexpand($ast, $env) { + while (is_macro_call($ast, $env)) { + $mac = $env->get($ast[0]->value); + $args = array_slice($ast->getArrayCopy(),1); + $ast = $mac->apply($args); + } + return $ast; +} + +function eval_ast($ast, $env) { + if (_symbol_Q($ast)) { + return $env->get($ast->value); + } elseif (_sequential_Q($ast)) { + if (_list_Q($ast)) { + $el = _list(); + } else { + $el = _vector(); + } + foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } + return $el; + } elseif (_hash_map_Q($ast)) { + $new_hm = _hash_map(); + foreach (array_keys($ast->getArrayCopy()) as $key) { + $new_hm[$key] = MAL_EVAL($ast[$key], $env); + } + return $new_hm; + } else { + return $ast; + } +} + +function MAL_EVAL($ast, $env) { + while (true) { + + #echo "MAL_EVAL: " . _pr_str($ast) . "\n"; + if (!_list_Q($ast)) { + return eval_ast($ast, $env); + } + + // apply list + $ast = macroexpand($ast, $env); + if (!_list_Q($ast)) { return $ast; } + + $a0 = $ast[0]; + $a0v = (_symbol_Q($a0) ? $a0->value : $a0); + switch ($a0v) { + case "def!": + $res = MAL_EVAL($ast[2], $env); + return $env->set($ast[1]->value, $res); + case "let*": + $a1 = $ast[1]; + $let_env = new Env($env); + for ($i=0; $i < count($a1); $i+=2) { + $let_env->set($a1[$i]->value, MAL_EVAL($a1[$i+1], $let_env)); + } + $ast = $ast[2]; + $env = $let_env; + break; // Continue loop (TCO) + case "quote": + return $ast[1]; + case "quasiquote": + $ast = quasiquote($ast[1]); + break; // Continue loop (TCO) + case "defmacro!": + $func = MAL_EVAL($ast[2], $env); + $func->ismacro = true; + return $env->set($ast[1]->value, $func); + case "macroexpand": + return macroexpand($ast[1], $env); + case "try*": + $a1 = $ast[1]; + $a2 = $ast[2]; + if ($a2[0]->value === "catch*") { + try { + return MAL_EVAL($a1, $env); + } catch (Error $e) { + $catch_env = new Env($env, array($a2[1]), + array($e->obj)); + return MAL_EVAL($a2[2], $catch_env); + } catch (Exception $e) { + $catch_env = new Env($env, array($a2[1]), + array($e->getMessage())); + return MAL_EVAL($a2[2], $catch_env); + } + } else { + return MAL_EVAL($a1, $env); + } + case "do": + eval_ast($ast->slice(1, -1), $env); + $ast = $ast[count($ast)-1]; + break; // Continue loop (TCO) + case "if": + $cond = MAL_EVAL($ast[1], $env); + if ($cond === NULL || $cond === false) { + if (count($ast) === 4) { $ast = $ast[3]; } + else { $ast = NULL; } + } else { + $ast = $ast[2]; + } + break; // Continue loop (TCO) + case "fn*": + return _function('MAL_EVAL', 'native', + $ast[2], $env, $ast[1]); + default: + $el = eval_ast($ast, $env); + $f = $el[0]; + $args = array_slice($el->getArrayCopy(), 1); + if ($f->type === 'native') { + $ast = $f->ast; + $env = $f->gen_env($args); + // Continue loop (TCO) + } else { + return $f->apply($args); + } + } + + } +} + +// print +function MAL_PRINT($exp) { + return _pr_str($exp, True) . "\n"; +} + +// repl +$repl_env = new Env(NULL); +function rep($str) { + global $repl_env; + return MAL_PRINT(MAL_EVAL(READ($str), $repl_env)); +} + +// core.php: defined using PHP +foreach ($core_ns as $k=>$v) { + $repl_env->set($k, _function($v)); +} +$repl_env->set('eval', _function(function($ast) { + global $repl_env; return MAL_EVAL($ast, $repl_env); +})); +$_argv = _list(); +for ($i=2; $i < count($argv); $i++) { + $_argv->append($argv[$i]); +} +$repl_env->set('*ARGV*', $_argv); + +// core.mal: defined using the language itself +rep("(def! *host-language* \"php\")"); +rep("(def! not (fn* (a) (if a false true)))"); +rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); +rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); +rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); + +if (count($argv) > 1) { + rep('(load-file "' . $argv[1] . '")'); + exit(0); +} + +// repl loop +rep("(println (str \"Mal [\" *host-language* \"]\"))"); +do { + try { + $line = mal_readline("user> "); + if ($line === NULL) { break; } + if ($line !== "") { + print(rep($line)); + } + } catch (BlankException $e) { + continue; + } catch (Exception $e) { + echo "Error: " . $e->getMessage() . "\n"; + echo $e->getTraceAsString() . "\n"; + } +} while (true); + +?> diff --git a/php/stepA_interop.php b/php/stepA_interop.php new file mode 100644 index 0000000..f38656f --- /dev/null +++ b/php/stepA_interop.php @@ -0,0 +1,217 @@ + 0; +} + +function quasiquote($ast) { + if (!is_pair($ast)) { + return _list(_symbol("quote"), $ast); + } elseif (_symbol_Q($ast[0]) && $ast[0]->value === 'unquote') { + return $ast[1]; + } elseif (is_pair($ast[0]) && _symbol_Q($ast[0][0]) && + $ast[0][0]->value === 'splice-unquote') { + return _list(_symbol("concat"), $ast[0][1], + quasiquote($ast->slice(1))); + } else { + return _list(_symbol("cons"), quasiquote($ast[0]), + quasiquote($ast->slice(1))); + } +} + +function is_macro_call($ast, $env) { + return is_pair($ast) && + _symbol_Q($ast[0]) && + $env->find($ast[0]->value) && + $env->get($ast[0]->value)->ismacro; +} + +function macroexpand($ast, $env) { + while (is_macro_call($ast, $env)) { + $mac = $env->get($ast[0]->value); + $args = array_slice($ast->getArrayCopy(),1); + $ast = $mac->apply($args); + } + return $ast; +} + +function eval_ast($ast, $env) { + if (_symbol_Q($ast)) { + return $env->get($ast->value); + } elseif (_sequential_Q($ast)) { + if (_list_Q($ast)) { + $el = _list(); + } else { + $el = _vector(); + } + foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } + return $el; + } elseif (_hash_map_Q($ast)) { + $new_hm = _hash_map(); + foreach (array_keys($ast->getArrayCopy()) as $key) { + $new_hm[$key] = MAL_EVAL($ast[$key], $env); + } + return $new_hm; + } else { + return $ast; + } +} + +function MAL_EVAL($ast, $env) { + while (true) { + + #echo "MAL_EVAL: " . _pr_str($ast) . "\n"; + if (!_list_Q($ast)) { + return eval_ast($ast, $env); + } + + // apply list + $ast = macroexpand($ast, $env); + if (!_list_Q($ast)) { return $ast; } + + $a0 = $ast[0]; + $a0v = (_symbol_Q($a0) ? $a0->value : $a0); + switch ($a0v) { + case "def!": + $res = MAL_EVAL($ast[2], $env); + return $env->set($ast[1]->value, $res); + case "let*": + $a1 = $ast[1]; + $let_env = new Env($env); + for ($i=0; $i < count($a1); $i+=2) { + $let_env->set($a1[$i]->value, MAL_EVAL($a1[$i+1], $let_env)); + } + $ast = $ast[2]; + $env = $let_env; + break; // Continue loop (TCO) + case "quote": + return $ast[1]; + case "quasiquote": + $ast = quasiquote($ast[1]); + break; // Continue loop (TCO) + case "defmacro!": + $func = MAL_EVAL($ast[2], $env); + $func->ismacro = true; + return $env->set($ast[1]->value, $func); + case "macroexpand": + return macroexpand($ast[1], $env); + case "php*": + return eval($ast[1]); + case "try*": + $a1 = $ast[1]; + $a2 = $ast[2]; + if ($a2[0]->value === "catch*") { + try { + return MAL_EVAL($a1, $env); + } catch (Error $e) { + $catch_env = new Env($env, array($a2[1]), + array($e->obj)); + return MAL_EVAL($a2[2], $catch_env); + } catch (Exception $e) { + $catch_env = new Env($env, array($a2[1]), + array($e->getMessage())); + return MAL_EVAL($a2[2], $catch_env); + } + } else { + return MAL_EVAL($a1, $env); + } + case "do": + eval_ast($ast->slice(1, -1), $env); + $ast = $ast[count($ast)-1]; + break; // Continue loop (TCO) + case "if": + $cond = MAL_EVAL($ast[1], $env); + if ($cond === NULL || $cond === false) { + if (count($ast) === 4) { $ast = $ast[3]; } + else { $ast = NULL; } + } else { + $ast = $ast[2]; + } + break; // Continue loop (TCO) + case "fn*": + return _function('MAL_EVAL', 'native', + $ast[2], $env, $ast[1]); + default: + $el = eval_ast($ast, $env); + $f = $el[0]; + $args = array_slice($el->getArrayCopy(), 1); + if ($f->type === 'native') { + $ast = $f->ast; + $env = $f->gen_env($args); + // Continue loop (TCO) + } else { + return $f->apply($args); + } + } + + } +} + +// print +function MAL_PRINT($exp) { + return _pr_str($exp, True) . "\n"; +} + +// repl +$repl_env = new Env(NULL); +function rep($str) { + global $repl_env; + return MAL_PRINT(MAL_EVAL(READ($str), $repl_env)); +} + +// core.php: defined using PHP +foreach ($core_ns as $k=>$v) { + $repl_env->set($k, _function($v)); +} +$repl_env->set('eval', _function(function($ast) { + global $repl_env; return MAL_EVAL($ast, $repl_env); +})); +$_argv = _list(); +for ($i=2; $i < count($argv); $i++) { + $_argv->append($argv[$i]); +} +$repl_env->set('*ARGV*', $_argv); + +// core.mal: defined using the language itself +rep("(def! *host-language* \"php\")"); +rep("(def! not (fn* (a) (if a false true)))"); +rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); +rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); +rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); + +if (count($argv) > 1) { + rep('(load-file "' . $argv[1] . '")'); + exit(0); +} + +// repl loop +rep("(println (str \"Mal [\" *host-language* \"]\"))"); +do { + try { + $line = mal_readline("user> "); + if ($line === NULL) { break; } + if ($line !== "") { + print(rep($line)); + } + } catch (BlankException $e) { + continue; + } catch (Exception $e) { + echo "Error: " . $e->getMessage() . "\n"; + echo $e->getTraceAsString() . "\n"; + } +} while (true); + +?> diff --git a/php/stepA_more.php b/php/stepA_more.php deleted file mode 100644 index f38656f..0000000 --- a/php/stepA_more.php +++ /dev/null @@ -1,217 +0,0 @@ - 0; -} - -function quasiquote($ast) { - if (!is_pair($ast)) { - return _list(_symbol("quote"), $ast); - } elseif (_symbol_Q($ast[0]) && $ast[0]->value === 'unquote') { - return $ast[1]; - } elseif (is_pair($ast[0]) && _symbol_Q($ast[0][0]) && - $ast[0][0]->value === 'splice-unquote') { - return _list(_symbol("concat"), $ast[0][1], - quasiquote($ast->slice(1))); - } else { - return _list(_symbol("cons"), quasiquote($ast[0]), - quasiquote($ast->slice(1))); - } -} - -function is_macro_call($ast, $env) { - return is_pair($ast) && - _symbol_Q($ast[0]) && - $env->find($ast[0]->value) && - $env->get($ast[0]->value)->ismacro; -} - -function macroexpand($ast, $env) { - while (is_macro_call($ast, $env)) { - $mac = $env->get($ast[0]->value); - $args = array_slice($ast->getArrayCopy(),1); - $ast = $mac->apply($args); - } - return $ast; -} - -function eval_ast($ast, $env) { - if (_symbol_Q($ast)) { - return $env->get($ast->value); - } elseif (_sequential_Q($ast)) { - if (_list_Q($ast)) { - $el = _list(); - } else { - $el = _vector(); - } - foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } - return $el; - } elseif (_hash_map_Q($ast)) { - $new_hm = _hash_map(); - foreach (array_keys($ast->getArrayCopy()) as $key) { - $new_hm[$key] = MAL_EVAL($ast[$key], $env); - } - return $new_hm; - } else { - return $ast; - } -} - -function MAL_EVAL($ast, $env) { - while (true) { - - #echo "MAL_EVAL: " . _pr_str($ast) . "\n"; - if (!_list_Q($ast)) { - return eval_ast($ast, $env); - } - - // apply list - $ast = macroexpand($ast, $env); - if (!_list_Q($ast)) { return $ast; } - - $a0 = $ast[0]; - $a0v = (_symbol_Q($a0) ? $a0->value : $a0); - switch ($a0v) { - case "def!": - $res = MAL_EVAL($ast[2], $env); - return $env->set($ast[1]->value, $res); - case "let*": - $a1 = $ast[1]; - $let_env = new Env($env); - for ($i=0; $i < count($a1); $i+=2) { - $let_env->set($a1[$i]->value, MAL_EVAL($a1[$i+1], $let_env)); - } - $ast = $ast[2]; - $env = $let_env; - break; // Continue loop (TCO) - case "quote": - return $ast[1]; - case "quasiquote": - $ast = quasiquote($ast[1]); - break; // Continue loop (TCO) - case "defmacro!": - $func = MAL_EVAL($ast[2], $env); - $func->ismacro = true; - return $env->set($ast[1]->value, $func); - case "macroexpand": - return macroexpand($ast[1], $env); - case "php*": - return eval($ast[1]); - case "try*": - $a1 = $ast[1]; - $a2 = $ast[2]; - if ($a2[0]->value === "catch*") { - try { - return MAL_EVAL($a1, $env); - } catch (Error $e) { - $catch_env = new Env($env, array($a2[1]), - array($e->obj)); - return MAL_EVAL($a2[2], $catch_env); - } catch (Exception $e) { - $catch_env = new Env($env, array($a2[1]), - array($e->getMessage())); - return MAL_EVAL($a2[2], $catch_env); - } - } else { - return MAL_EVAL($a1, $env); - } - case "do": - eval_ast($ast->slice(1, -1), $env); - $ast = $ast[count($ast)-1]; - break; // Continue loop (TCO) - case "if": - $cond = MAL_EVAL($ast[1], $env); - if ($cond === NULL || $cond === false) { - if (count($ast) === 4) { $ast = $ast[3]; } - else { $ast = NULL; } - } else { - $ast = $ast[2]; - } - break; // Continue loop (TCO) - case "fn*": - return _function('MAL_EVAL', 'native', - $ast[2], $env, $ast[1]); - default: - $el = eval_ast($ast, $env); - $f = $el[0]; - $args = array_slice($el->getArrayCopy(), 1); - if ($f->type === 'native') { - $ast = $f->ast; - $env = $f->gen_env($args); - // Continue loop (TCO) - } else { - return $f->apply($args); - } - } - - } -} - -// print -function MAL_PRINT($exp) { - return _pr_str($exp, True) . "\n"; -} - -// repl -$repl_env = new Env(NULL); -function rep($str) { - global $repl_env; - return MAL_PRINT(MAL_EVAL(READ($str), $repl_env)); -} - -// core.php: defined using PHP -foreach ($core_ns as $k=>$v) { - $repl_env->set($k, _function($v)); -} -$repl_env->set('eval', _function(function($ast) { - global $repl_env; return MAL_EVAL($ast, $repl_env); -})); -$_argv = _list(); -for ($i=2; $i < count($argv); $i++) { - $_argv->append($argv[$i]); -} -$repl_env->set('*ARGV*', $_argv); - -// core.mal: defined using the language itself -rep("(def! *host-language* \"php\")"); -rep("(def! not (fn* (a) (if a false true)))"); -rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); -rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); -rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); - -if (count($argv) > 1) { - rep('(load-file "' . $argv[1] . '")'); - exit(0); -} - -// repl loop -rep("(println (str \"Mal [\" *host-language* \"]\"))"); -do { - try { - $line = mal_readline("user> "); - if ($line === NULL) { break; } - if ($line !== "") { - print(rep($line)); - } - } catch (BlankException $e) { - continue; - } catch (Exception $e) { - echo "Error: " . $e->getMessage() . "\n"; - echo $e->getTraceAsString() . "\n"; - } -} while (true); - -?> diff --git a/php/tests/stepA_interop.mal b/php/tests/stepA_interop.mal new file mode 100644 index 0000000..15f8a94 --- /dev/null +++ b/php/tests/stepA_interop.mal @@ -0,0 +1,25 @@ +;; Testing basic php interop + +(php* "return 7;") +;=>7 + +(php* "return '7';") +;=>"7" + +(php* "return array(7,8,9);") +;=>(7 8 9) + +(php* "return array(\"abc\" => 789);") +;=>{"abc" 789} + +(php* "print \"hello\n\";") +; hello +;=>nil + +(php* "global $foo; $foo=8;") +(php* "global $foo; return $foo;") +;=>8 + +(php* "global $f; $f = function($v) { return 1+$v; };") +(php* "global $f; return array_map($f, array(1,2,3));") +;=>(2 3 4) diff --git a/ps/Makefile b/ps/Makefile index 43b5b70..26056a6 100644 --- a/ps/Makefile +++ b/ps/Makefile @@ -2,7 +2,7 @@ TESTS = SOURCES_BASE = types.ps reader.ps printer.ps -SOURCES_LISP = env.ps core.ps stepA_more.ps +SOURCES_LISP = env.ps core.ps stepA_interop.ps SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) .PHONY: stats tests $(TESTS) diff --git a/ps/interop.ps b/ps/interop.ps new file mode 100644 index 0000000..fb3b88d --- /dev/null +++ b/ps/interop.ps @@ -0,0 +1,21 @@ +% ps_val -> ps2mal -> mal_val +/ps2mal { + % convert a PS value to a Mal value (recursively) + [ exch + { %forall returned values + dup == + dup type /arraytype eq { + (here1\n) print + _list_from_array + }{ dup type /dicttype eq { + (here2\n) print + _hash_map_from_dict + }{ + (here3\n) print + % no-op + } ifelse } ifelse + } forall + ] + (here4\n) print +} def + diff --git a/ps/step9_interop.ps b/ps/step9_interop.ps deleted file mode 100644 index 7f90d20..0000000 --- a/ps/step9_interop.ps +++ /dev/null @@ -1,258 +0,0 @@ -/runlibfile where { pop }{ /runlibfile { run } def } ifelse % -(types.ps) runlibfile -(reader.ps) runlibfile -(printer.ps) runlibfile -(env.ps) runlibfile -(core.ps) runlibfile - -% read -/_readline { print flush (%stdin) (r) file 99 string readline } def - -/READ { - /str exch def - str read_str -} def - - -% eval -% is_pair?: ast -> is_pair? -> bool -% return true if non-empty list, otherwise false -/is_pair? { - dup _sequential? { _count 0 gt }{ pop false } ifelse -} def - -% ast -> quasiquote -> new_ast -/quasiquote { 3 dict begin - /ast exch def - ast is_pair? not { %if not is_pair? - /quote ast 2 _list - }{ - /a0 ast 0 _nth def - a0 /unquote eq { %if a0 unquote symbol - ast 1 _nth - }{ a0 is_pair? { %elseif a0 is_pair? - /a00 a0 0 _nth def - a00 /splice-unquote eq { %if splice-unquote - /concat a0 1 _nth ast _rest quasiquote 3 _list - }{ %else not splice-unquote - /cons a0 quasiquote ast _rest quasiquote 3 _list - } ifelse - }{ % else not a0 is_pair? - /cons a0 quasiquote ast _rest quasiquote 3 _list - } ifelse } ifelse - } ifelse -end } def - -/is_macro_call? { 3 dict begin - /env exch def - /ast exch def - ast _list? { - /a0 ast 0 _nth def - a0 _symbol? { %if a0 is symbol - env a0 env_find null ne { %if a0 is in env - env a0 env_get _mal_function? { %if user defined function - env a0 env_get /macro? get true eq %if marked as macro - }{ false } ifelse - }{ false } ifelse - }{ false } ifelse - }{ false } ifelse -end } def - -/macroexpand { 3 dict begin - /env exch def - /ast exch def - { - ast env is_macro_call? { - /mac env ast 0 _nth env_get def - /ast ast _rest mac fload EVAL def - }{ - exit - } ifelse - } loop - ast -end } def - -/eval_ast { 2 dict begin - /env exch def - /ast exch def - %(eval_ast: ) print ast == - ast _symbol? { %if symbol - env ast env_get - }{ ast _sequential? { %elseif list or vector - [ - ast /data get { %forall items - env EVAL - } forall - ] ast _list? { _list_from_array }{ _vector_from_array } ifelse - }{ ast _hash_map? { %elseif list or vector - << - ast /data get { %forall entries - env EVAL - } forall - >> _hash_map_from_dict - }{ % else - ast - } ifelse } ifelse } ifelse -end } def - -/EVAL { 13 dict begin - { %loop (TCO) - - /env exch def - /ast exch def - /loop? false def - - %(EVAL: ) print ast true _pr_str print (\n) print - ast _list? not { %if not a list - ast env eval_ast - }{ %else apply the list - /ast ast env macroexpand def - ast _list? not { %if no longer a list - ast - }{ %else still a list - /a0 ast 0 _nth def - /def! a0 eq { %if def! - /a1 ast 1 _nth def - /a2 ast 2 _nth def - env a1 a2 env EVAL env_set - }{ /let* a0 eq { %if let* - /a1 ast 1 _nth def - /a2 ast 2 _nth def - /let_env env null null env_new def - 0 2 a1 _count 1 sub { %for each pair - /idx exch def - let_env - a1 idx _nth - a1 idx 1 add _nth let_env EVAL - env_set - pop % discard the return value - } for - a2 - let_env - /loop? true def % loop - }{ /quote a0 eq { %if quote - ast 1 _nth - }{ /quasiquote a0 eq { %if quasiquote - ast 1 _nth quasiquote - env - /loop? true def % loop - }{ /defmacro! a0 eq { %if defmacro! - /a1 ast 1 _nth def - /a2 ast 2 _nth def - a2 env EVAL - dup /macro? true put % set macro flag - env exch a1 exch env_set % def! it - }{ /macroexpand a0 eq { %if defmacro! - ast 1 _nth env macroexpand - }{ /ps* a0 eq { %if ps* - count /stackcnt exch def - ast 1 _nth - { - token not { exit } if - exch - } loop - exec - count stackcnt gt { % if new operands on stack - % return an list of new operands - count stackcnt sub array astore - }{ - null % return nil - } ifelse - }{ /do a0 eq { %if do - ast _count 2 gt { %if ast has more than 2 elements - ast 1 ast _count 2 sub _slice env eval_ast pop - } if - ast ast _count 1 sub _nth % last ast becomes new ast - env - /loop? true def % loop - }{ /if a0 eq { %if if - /a1 ast 1 _nth def - /cond a1 env EVAL def - cond null eq cond false eq or { % if cond is nil or false - ast _count 3 gt { %if false branch with a3 - ast 3 _nth env - /loop? true def - }{ % else false branch with no a3 - null - } ifelse - }{ % true branch - ast 2 _nth env - /loop? true def - } ifelse - }{ /fn* a0 eq { %if fn* - /a1 ast 1 _nth def - /a2 ast 2 _nth def - a2 env a1 _mal_function - }{ - /el ast env eval_ast def - el _rest el _first % stack: ast function - dup _mal_function? { %if user defined function - fload % stack: ast new_env - /loop? true def - }{ dup _function? { %else if builtin function - /data get exec - }{ %else (regular procedure/function) - (cannot apply native proc!\n) print quit - } ifelse } ifelse - } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse - } ifelse - } ifelse - - loop? not { exit } if - } loop % TCO -end } def - - -% print -/PRINT { - true _pr_str -} def - - -% repl -/repl_env null null null env_new def - -/RE { READ repl_env EVAL } def -/REP { READ repl_env EVAL PRINT } def - -% core.ps: defined using postscript -/_ref { repl_env 3 1 roll env_set pop } def -core_ns { _function _ref } forall -(eval) { 0 _nth repl_env EVAL } _function _ref -(*ARGV*) [ ] _list_from_array _ref - -% core.mal: defined using the language itself -(\(def! not \(fn* \(a\) \(if a false true\)\)\)) RE pop -(\(def! load-file \(fn* \(f\) \(eval \(read-string \(str "\(do " \(slurp f\) "\)"\)\)\)\)\)) RE pop -(\(defmacro! cond \(fn* \(& xs\) \(if \(> \(count xs\) 0\) \(list 'if \(first xs\) \(if \(> \(count xs\) 1\) \(nth xs 1\) \(throw "odd number of forms to cond"\)\) \(cons 'cond \(rest \(rest xs\)\)\)\)\)\)\)) RE pop -(\(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\)\)\)\)\)\)\)\)) RE pop - -userdict /ARGUMENTS known { %if command line arguments - ARGUMENTS length 0 gt { %if more than 0 arguments - (*ARGV*) ARGUMENTS 1 ARGUMENTS length 1 sub getinterval - _list_from_array _ref - ARGUMENTS 0 get - (\(load-file ") exch ("\)) concatenate concatenate RE pop - quit - } if -} if - -% repl loop -{ %loop - (user> ) _readline - not { exit } if % exit if EOF - - { %try - REP print (\n) print - } stopped { - (Error: ) print - get_error_data false _pr_str print (\n) print - $error /newerror false put - $error /errorinfo null put - clear - cleardictstack - } if -} bind loop - -(\n) print % final newline before exit for cleanliness -quit diff --git a/ps/step9_try.ps b/ps/step9_try.ps new file mode 100644 index 0000000..9c5c240 --- /dev/null +++ b/ps/step9_try.ps @@ -0,0 +1,282 @@ +/runlibfile where { pop }{ /runlibfile { run } def } ifelse % +(types.ps) runlibfile +(reader.ps) runlibfile +(printer.ps) runlibfile +(env.ps) runlibfile +(core.ps) runlibfile + +% read +/_readline { print flush (%stdin) (r) file 99 string readline } def + +/READ { + /str exch def + str read_str +} def + + +% eval +% is_pair?: ast -> is_pair? -> bool +% return true if non-empty list, otherwise false +/is_pair? { + dup _sequential? { _count 0 gt }{ pop false } ifelse +} def + +% ast -> quasiquote -> new_ast +/quasiquote { 3 dict begin + /ast exch def + ast is_pair? not { %if not is_pair? + /quote ast 2 _list + }{ + /a0 ast 0 _nth def + a0 /unquote eq { %if a0 unquote symbol + ast 1 _nth + }{ a0 is_pair? { %elseif a0 is_pair? + /a00 a0 0 _nth def + a00 /splice-unquote eq { %if splice-unquote + /concat a0 1 _nth ast _rest quasiquote 3 _list + }{ %else not splice-unquote + /cons a0 quasiquote ast _rest quasiquote 3 _list + } ifelse + }{ % else not a0 is_pair? + /cons a0 quasiquote ast _rest quasiquote 3 _list + } ifelse } ifelse + } ifelse +end } def + +/is_macro_call? { 3 dict begin + /env exch def + /ast exch def + ast _list? { + /a0 ast 0 _nth def + a0 _symbol? { %if a0 is symbol + env a0 env_find null ne { %if a0 is in env + env a0 env_get _mal_function? { %if user defined function + env a0 env_get /macro? get true eq %if marked as macro + }{ false } ifelse + }{ false } ifelse + }{ false } ifelse + }{ false } ifelse +end } def + +/macroexpand { 3 dict begin + /env exch def + /ast exch def + { + ast env is_macro_call? { + /mac env ast 0 _nth env_get def + /ast ast _rest mac fload EVAL def + }{ + exit + } ifelse + } loop + ast +end } def + +/eval_ast { 2 dict begin + /env exch def + /ast exch def + %(eval_ast: ) print ast == + ast _symbol? { %if symbol + env ast env_get + }{ ast _sequential? { %elseif list or vector + [ + ast /data get { %forall items + env EVAL + } forall + ] ast _list? { _list_from_array }{ _vector_from_array } ifelse + }{ ast _hash_map? { %elseif list or vector + << + ast /data get { %forall entries + env EVAL + } forall + >> _hash_map_from_dict + }{ % else + ast + } ifelse } ifelse } ifelse +end } def + +/EVAL { 13 dict begin + { %loop (TCO) + + /env exch def + /ast exch def + /loop? false def + + %(EVAL: ) print ast true _pr_str print (\n) print + ast _list? not { %if not a list + ast env eval_ast + }{ %else apply the list + /ast ast env macroexpand def + ast _list? not { %if no longer a list + ast + }{ %else still a list + /a0 ast 0 _nth def + /def! a0 eq { %if def! + /a1 ast 1 _nth def + /a2 ast 2 _nth def + env a1 a2 env EVAL env_set + }{ /let* a0 eq { %if let* + /a1 ast 1 _nth def + /a2 ast 2 _nth def + /let_env env null null env_new def + 0 2 a1 _count 1 sub { %for each pair + /idx exch def + let_env + a1 idx _nth + a1 idx 1 add _nth let_env EVAL + env_set + pop % discard the return value + } for + a2 + let_env + /loop? true def % loop + }{ /quote a0 eq { %if quote + ast 1 _nth + }{ /quasiquote a0 eq { %if quasiquote + ast 1 _nth quasiquote + env + /loop? true def % loop + }{ /defmacro! a0 eq { %if defmacro! + /a1 ast 1 _nth def + /a2 ast 2 _nth def + a2 env EVAL + dup /macro? true put % set macro flag + env exch a1 exch env_set % def! it + }{ /macroexpand a0 eq { %if defmacro! + ast 1 _nth env macroexpand + }{ /do a0 eq { %if do + ast _count 2 gt { %if ast has more than 2 elements + ast 1 ast _count 2 sub _slice env eval_ast pop + } if + ast ast _count 1 sub _nth % last ast becomes new ast + env + /loop? true def % loop + }{ /try* a0 eq { %if try* + { %try + countdictstack /dictcnt exch def + count /stackcnt exch def + ast 1 _nth env EVAL + } stopped { %catch + % clean up the dictionary stack + 1 1 countdictstack dictcnt sub { %foreach added dict + %(popping dict\n) print + pop end % pop idx and pop dict + %(new ast: ) print ast true _pr_str print (\n) print + } for + % clean up the operand stack + count 1 exch 1 exch stackcnt sub { %foreach added operand + %(op stack: ) print pstack + pop pop % pop idx and operand + %(popped op stack\n) print pstack + } for + % get error data and reset $error dict + /errdata get_error_data def + $error /newerror false put + $error /errorinfo null put + + ast _count 3 lt { %if no third (catch*) form + errdata throw + } if + ast 2 _nth 0 _nth (catch*) eq not { %if third form not catch* + (No catch* in throw form) _throw + } if + ast 2 _nth 2 _nth + env + ast 2 _nth 1 _nth 1 _list + errdata 1 _list + env_new + EVAL + } if + }{ /if a0 eq { %if if + /a1 ast 1 _nth def + /cond a1 env EVAL def + cond null eq cond false eq or { % if cond is nil or false + ast _count 3 gt { %if false branch with a3 + ast 3 _nth env + /loop? true def + }{ % else false branch with no a3 + null + } ifelse + }{ % true branch + ast 2 _nth env + /loop? true def + } ifelse + }{ /fn* a0 eq { %if fn* + /a1 ast 1 _nth def + /a2 ast 2 _nth def + a2 env a1 _mal_function + }{ + /el ast env eval_ast def + el _rest el _first % stack: ast function + dup _mal_function? { %if user defined function + fload % stack: ast new_env + /loop? true def + }{ dup _function? { %else if builtin function + /data get exec + }{ %else (regular procedure/function) + (cannot apply native proc!\n) print quit + } ifelse } ifelse + } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse + } ifelse + } ifelse + + loop? not { exit } if + } loop % TCO +end } def + + +% print +/PRINT { + true _pr_str +} def + + +% repl +/repl_env null null null env_new def + +/RE { READ repl_env EVAL } def +/REP { READ repl_env EVAL PRINT } def + +% core.ps: defined using postscript +/_ref { repl_env 3 1 roll env_set pop } def +core_ns { _function _ref } forall +(eval) { 0 _nth repl_env EVAL } _function _ref +(*ARGV*) [ ] _list_from_array _ref + +% core.mal: defined using the language itself +(\(def! *host-language* "postscript"\)) RE pop +(\(def! not \(fn* \(a\) \(if a false true\)\)\)) RE pop +(\(def! load-file \(fn* \(f\) \(eval \(read-string \(str "\(do " \(slurp f\) "\)"\)\)\)\)\)) RE pop +(\(defmacro! cond \(fn* \(& xs\) \(if \(> \(count xs\) 0\) \(list 'if \(first xs\) \(if \(> \(count xs\) 1\) \(nth xs 1\) \(throw "odd number of forms to cond"\)\) \(cons 'cond \(rest \(rest xs\)\)\)\)\)\)\)) RE pop +(\(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\)\)\)\)\)\)\)\)) RE pop + +userdict /ARGUMENTS known { %if command line arguments + ARGUMENTS length 0 gt { %if more than 0 arguments + (*ARGV*) ARGUMENTS 1 ARGUMENTS length 1 sub getinterval + _list_from_array _ref + ARGUMENTS 0 get + (\(load-file ") exch ("\)) concatenate concatenate RE pop + quit + } if +} if + +% repl loop +(\(println \(str "Mal [" *host-language* "]"\)\)) RE pop +{ %loop + (user> ) _readline + not { exit } if % exit if EOF + + { %try + REP print (\n) print + } stopped { + (Error: ) print + get_error_data false _pr_str print (\n) print + $error /newerror false put + $error /errorinfo null put + clear + cleardictstack + } if +} bind loop + +(\n) print % final newline before exit for cleanliness +quit diff --git a/ps/stepA_interop.ps b/ps/stepA_interop.ps new file mode 100644 index 0000000..a24ee28 --- /dev/null +++ b/ps/stepA_interop.ps @@ -0,0 +1,296 @@ +/runlibfile where { pop }{ /runlibfile { run } def } ifelse % +(types.ps) runlibfile +(reader.ps) runlibfile +(printer.ps) runlibfile +(env.ps) runlibfile +(core.ps) runlibfile + +% read +/_readline { print flush (%stdin) (r) file 99 string readline } def + +/READ { + /str exch def + str read_str +} def + + +% eval +% is_pair?: ast -> is_pair? -> bool +% return true if non-empty list, otherwise false +/is_pair? { + dup _sequential? { _count 0 gt }{ pop false } ifelse +} def + +% ast -> quasiquote -> new_ast +/quasiquote { 3 dict begin + /ast exch def + ast is_pair? not { %if not is_pair? + /quote ast 2 _list + }{ + /a0 ast 0 _nth def + a0 /unquote eq { %if a0 unquote symbol + ast 1 _nth + }{ a0 is_pair? { %elseif a0 is_pair? + /a00 a0 0 _nth def + a00 /splice-unquote eq { %if splice-unquote + /concat a0 1 _nth ast _rest quasiquote 3 _list + }{ %else not splice-unquote + /cons a0 quasiquote ast _rest quasiquote 3 _list + } ifelse + }{ % else not a0 is_pair? + /cons a0 quasiquote ast _rest quasiquote 3 _list + } ifelse } ifelse + } ifelse +end } def + +/is_macro_call? { 3 dict begin + /env exch def + /ast exch def + ast _list? { + /a0 ast 0 _nth def + a0 _symbol? { %if a0 is symbol + env a0 env_find null ne { %if a0 is in env + env a0 env_get _mal_function? { %if user defined function + env a0 env_get /macro? get true eq %if marked as macro + }{ false } ifelse + }{ false } ifelse + }{ false } ifelse + }{ false } ifelse +end } def + +/macroexpand { 3 dict begin + /env exch def + /ast exch def + { + ast env is_macro_call? { + /mac env ast 0 _nth env_get def + /ast ast _rest mac fload EVAL def + }{ + exit + } ifelse + } loop + ast +end } def + +/eval_ast { 2 dict begin + /env exch def + /ast exch def + %(eval_ast: ) print ast == + ast _symbol? { %if symbol + env ast env_get + }{ ast _sequential? { %elseif list or vector + [ + ast /data get { %forall items + env EVAL + } forall + ] ast _list? { _list_from_array }{ _vector_from_array } ifelse + }{ ast _hash_map? { %elseif list or vector + << + ast /data get { %forall entries + env EVAL + } forall + >> _hash_map_from_dict + }{ % else + ast + } ifelse } ifelse } ifelse +end } def + +/EVAL { 13 dict begin + { %loop (TCO) + + /env exch def + /ast exch def + /loop? false def + + %(EVAL: ) print ast true _pr_str print (\n) print + ast _list? not { %if not a list + ast env eval_ast + }{ %else apply the list + /ast ast env macroexpand def + ast _list? not { %if no longer a list + ast + }{ %else still a list + /a0 ast 0 _nth def + /def! a0 eq { %if def! + /a1 ast 1 _nth def + /a2 ast 2 _nth def + env a1 a2 env EVAL env_set + }{ /let* a0 eq { %if let* + /a1 ast 1 _nth def + /a2 ast 2 _nth def + /let_env env null null env_new def + 0 2 a1 _count 1 sub { %for each pair + /idx exch def + let_env + a1 idx _nth + a1 idx 1 add _nth let_env EVAL + env_set + pop % discard the return value + } for + a2 + let_env + /loop? true def % loop + }{ /quote a0 eq { %if quote + ast 1 _nth + }{ /quasiquote a0 eq { %if quasiquote + ast 1 _nth quasiquote + env + /loop? true def % loop + }{ /defmacro! a0 eq { %if defmacro! + /a1 ast 1 _nth def + /a2 ast 2 _nth def + a2 env EVAL + dup /macro? true put % set macro flag + env exch a1 exch env_set % def! it + }{ /macroexpand a0 eq { %if defmacro! + ast 1 _nth env macroexpand + }{ /ps* a0 eq { %if ps* + count /stackcnt exch def + ast 1 _nth + { + token not { exit } if + exch + } loop + exec + count stackcnt gt { % if new operands on stack + % return an list of new operands + count stackcnt sub array astore + }{ + null % return nil + } ifelse + }{ /do a0 eq { %if do + ast _count 2 gt { %if ast has more than 2 elements + ast 1 ast _count 2 sub _slice env eval_ast pop + } if + ast ast _count 1 sub _nth % last ast becomes new ast + env + /loop? true def % loop + }{ /try* a0 eq { %if try* + { %try + countdictstack /dictcnt exch def + count /stackcnt exch def + ast 1 _nth env EVAL + } stopped { %catch + % clean up the dictionary stack + 1 1 countdictstack dictcnt sub { %foreach added dict + %(popping dict\n) print + pop end % pop idx and pop dict + %(new ast: ) print ast true _pr_str print (\n) print + } for + % clean up the operand stack + count 1 exch 1 exch stackcnt sub { %foreach added operand + %(op stack: ) print pstack + pop pop % pop idx and operand + %(popped op stack\n) print pstack + } for + % get error data and reset $error dict + /errdata get_error_data def + $error /newerror false put + $error /errorinfo null put + + ast _count 3 lt { %if no third (catch*) form + errdata throw + } if + ast 2 _nth 0 _nth (catch*) eq not { %if third form not catch* + (No catch* in throw form) _throw + } if + ast 2 _nth 2 _nth + env + ast 2 _nth 1 _nth 1 _list + errdata 1 _list + env_new + EVAL + } if + }{ /if a0 eq { %if if + /a1 ast 1 _nth def + /cond a1 env EVAL def + cond null eq cond false eq or { % if cond is nil or false + ast _count 3 gt { %if false branch with a3 + ast 3 _nth env + /loop? true def + }{ % else false branch with no a3 + null + } ifelse + }{ % true branch + ast 2 _nth env + /loop? true def + } ifelse + }{ /fn* a0 eq { %if fn* + /a1 ast 1 _nth def + /a2 ast 2 _nth def + a2 env a1 _mal_function + }{ + /el ast env eval_ast def + el _rest el _first % stack: ast function + dup _mal_function? { %if user defined function + fload % stack: ast new_env + /loop? true def + }{ dup _function? { %else if builtin function + /data get exec + }{ %else (regular procedure/function) + (cannot apply native proc!\n) print quit + } ifelse } ifelse + } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse + } ifelse + } ifelse + + loop? not { exit } if + } loop % TCO +end } def + + +% print +/PRINT { + true _pr_str +} def + + +% repl +/repl_env null null null env_new def + +/RE { READ repl_env EVAL } def +/REP { READ repl_env EVAL PRINT } def + +% core.ps: defined using postscript +/_ref { repl_env 3 1 roll env_set pop } def +core_ns { _function _ref } forall +(eval) { 0 _nth repl_env EVAL } _function _ref +(*ARGV*) [ ] _list_from_array _ref + +% core.mal: defined using the language itself +(\(def! *host-language* "postscript"\)) RE pop +(\(def! not \(fn* \(a\) \(if a false true\)\)\)) RE pop +(\(def! load-file \(fn* \(f\) \(eval \(read-string \(str "\(do " \(slurp f\) "\)"\)\)\)\)\)) RE pop +(\(defmacro! cond \(fn* \(& xs\) \(if \(> \(count xs\) 0\) \(list 'if \(first xs\) \(if \(> \(count xs\) 1\) \(nth xs 1\) \(throw "odd number of forms to cond"\)\) \(cons 'cond \(rest \(rest xs\)\)\)\)\)\)\)) RE pop +(\(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\)\)\)\)\)\)\)\)) RE pop + +userdict /ARGUMENTS known { %if command line arguments + ARGUMENTS length 0 gt { %if more than 0 arguments + (*ARGV*) ARGUMENTS 1 ARGUMENTS length 1 sub getinterval + _list_from_array _ref + ARGUMENTS 0 get + (\(load-file ") exch ("\)) concatenate concatenate RE pop + quit + } if +} if + +% repl loop +(\(println \(str "Mal [" *host-language* "]"\)\)) RE pop +{ %loop + (user> ) _readline + not { exit } if % exit if EOF + + { %try + REP print (\n) print + } stopped { + (Error: ) print + get_error_data false _pr_str print (\n) print + $error /newerror false put + $error /errorinfo null put + clear + cleardictstack + } if +} bind loop + +(\n) print % final newline before exit for cleanliness +quit diff --git a/ps/stepA_more.ps b/ps/stepA_more.ps deleted file mode 100644 index a24ee28..0000000 --- a/ps/stepA_more.ps +++ /dev/null @@ -1,296 +0,0 @@ -/runlibfile where { pop }{ /runlibfile { run } def } ifelse % -(types.ps) runlibfile -(reader.ps) runlibfile -(printer.ps) runlibfile -(env.ps) runlibfile -(core.ps) runlibfile - -% read -/_readline { print flush (%stdin) (r) file 99 string readline } def - -/READ { - /str exch def - str read_str -} def - - -% eval -% is_pair?: ast -> is_pair? -> bool -% return true if non-empty list, otherwise false -/is_pair? { - dup _sequential? { _count 0 gt }{ pop false } ifelse -} def - -% ast -> quasiquote -> new_ast -/quasiquote { 3 dict begin - /ast exch def - ast is_pair? not { %if not is_pair? - /quote ast 2 _list - }{ - /a0 ast 0 _nth def - a0 /unquote eq { %if a0 unquote symbol - ast 1 _nth - }{ a0 is_pair? { %elseif a0 is_pair? - /a00 a0 0 _nth def - a00 /splice-unquote eq { %if splice-unquote - /concat a0 1 _nth ast _rest quasiquote 3 _list - }{ %else not splice-unquote - /cons a0 quasiquote ast _rest quasiquote 3 _list - } ifelse - }{ % else not a0 is_pair? - /cons a0 quasiquote ast _rest quasiquote 3 _list - } ifelse } ifelse - } ifelse -end } def - -/is_macro_call? { 3 dict begin - /env exch def - /ast exch def - ast _list? { - /a0 ast 0 _nth def - a0 _symbol? { %if a0 is symbol - env a0 env_find null ne { %if a0 is in env - env a0 env_get _mal_function? { %if user defined function - env a0 env_get /macro? get true eq %if marked as macro - }{ false } ifelse - }{ false } ifelse - }{ false } ifelse - }{ false } ifelse -end } def - -/macroexpand { 3 dict begin - /env exch def - /ast exch def - { - ast env is_macro_call? { - /mac env ast 0 _nth env_get def - /ast ast _rest mac fload EVAL def - }{ - exit - } ifelse - } loop - ast -end } def - -/eval_ast { 2 dict begin - /env exch def - /ast exch def - %(eval_ast: ) print ast == - ast _symbol? { %if symbol - env ast env_get - }{ ast _sequential? { %elseif list or vector - [ - ast /data get { %forall items - env EVAL - } forall - ] ast _list? { _list_from_array }{ _vector_from_array } ifelse - }{ ast _hash_map? { %elseif list or vector - << - ast /data get { %forall entries - env EVAL - } forall - >> _hash_map_from_dict - }{ % else - ast - } ifelse } ifelse } ifelse -end } def - -/EVAL { 13 dict begin - { %loop (TCO) - - /env exch def - /ast exch def - /loop? false def - - %(EVAL: ) print ast true _pr_str print (\n) print - ast _list? not { %if not a list - ast env eval_ast - }{ %else apply the list - /ast ast env macroexpand def - ast _list? not { %if no longer a list - ast - }{ %else still a list - /a0 ast 0 _nth def - /def! a0 eq { %if def! - /a1 ast 1 _nth def - /a2 ast 2 _nth def - env a1 a2 env EVAL env_set - }{ /let* a0 eq { %if let* - /a1 ast 1 _nth def - /a2 ast 2 _nth def - /let_env env null null env_new def - 0 2 a1 _count 1 sub { %for each pair - /idx exch def - let_env - a1 idx _nth - a1 idx 1 add _nth let_env EVAL - env_set - pop % discard the return value - } for - a2 - let_env - /loop? true def % loop - }{ /quote a0 eq { %if quote - ast 1 _nth - }{ /quasiquote a0 eq { %if quasiquote - ast 1 _nth quasiquote - env - /loop? true def % loop - }{ /defmacro! a0 eq { %if defmacro! - /a1 ast 1 _nth def - /a2 ast 2 _nth def - a2 env EVAL - dup /macro? true put % set macro flag - env exch a1 exch env_set % def! it - }{ /macroexpand a0 eq { %if defmacro! - ast 1 _nth env macroexpand - }{ /ps* a0 eq { %if ps* - count /stackcnt exch def - ast 1 _nth - { - token not { exit } if - exch - } loop - exec - count stackcnt gt { % if new operands on stack - % return an list of new operands - count stackcnt sub array astore - }{ - null % return nil - } ifelse - }{ /do a0 eq { %if do - ast _count 2 gt { %if ast has more than 2 elements - ast 1 ast _count 2 sub _slice env eval_ast pop - } if - ast ast _count 1 sub _nth % last ast becomes new ast - env - /loop? true def % loop - }{ /try* a0 eq { %if try* - { %try - countdictstack /dictcnt exch def - count /stackcnt exch def - ast 1 _nth env EVAL - } stopped { %catch - % clean up the dictionary stack - 1 1 countdictstack dictcnt sub { %foreach added dict - %(popping dict\n) print - pop end % pop idx and pop dict - %(new ast: ) print ast true _pr_str print (\n) print - } for - % clean up the operand stack - count 1 exch 1 exch stackcnt sub { %foreach added operand - %(op stack: ) print pstack - pop pop % pop idx and operand - %(popped op stack\n) print pstack - } for - % get error data and reset $error dict - /errdata get_error_data def - $error /newerror false put - $error /errorinfo null put - - ast _count 3 lt { %if no third (catch*) form - errdata throw - } if - ast 2 _nth 0 _nth (catch*) eq not { %if third form not catch* - (No catch* in throw form) _throw - } if - ast 2 _nth 2 _nth - env - ast 2 _nth 1 _nth 1 _list - errdata 1 _list - env_new - EVAL - } if - }{ /if a0 eq { %if if - /a1 ast 1 _nth def - /cond a1 env EVAL def - cond null eq cond false eq or { % if cond is nil or false - ast _count 3 gt { %if false branch with a3 - ast 3 _nth env - /loop? true def - }{ % else false branch with no a3 - null - } ifelse - }{ % true branch - ast 2 _nth env - /loop? true def - } ifelse - }{ /fn* a0 eq { %if fn* - /a1 ast 1 _nth def - /a2 ast 2 _nth def - a2 env a1 _mal_function - }{ - /el ast env eval_ast def - el _rest el _first % stack: ast function - dup _mal_function? { %if user defined function - fload % stack: ast new_env - /loop? true def - }{ dup _function? { %else if builtin function - /data get exec - }{ %else (regular procedure/function) - (cannot apply native proc!\n) print quit - } ifelse } ifelse - } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse - } ifelse - } ifelse - - loop? not { exit } if - } loop % TCO -end } def - - -% print -/PRINT { - true _pr_str -} def - - -% repl -/repl_env null null null env_new def - -/RE { READ repl_env EVAL } def -/REP { READ repl_env EVAL PRINT } def - -% core.ps: defined using postscript -/_ref { repl_env 3 1 roll env_set pop } def -core_ns { _function _ref } forall -(eval) { 0 _nth repl_env EVAL } _function _ref -(*ARGV*) [ ] _list_from_array _ref - -% core.mal: defined using the language itself -(\(def! *host-language* "postscript"\)) RE pop -(\(def! not \(fn* \(a\) \(if a false true\)\)\)) RE pop -(\(def! load-file \(fn* \(f\) \(eval \(read-string \(str "\(do " \(slurp f\) "\)"\)\)\)\)\)) RE pop -(\(defmacro! cond \(fn* \(& xs\) \(if \(> \(count xs\) 0\) \(list 'if \(first xs\) \(if \(> \(count xs\) 1\) \(nth xs 1\) \(throw "odd number of forms to cond"\)\) \(cons 'cond \(rest \(rest xs\)\)\)\)\)\)\)) RE pop -(\(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\)\)\)\)\)\)\)\)) RE pop - -userdict /ARGUMENTS known { %if command line arguments - ARGUMENTS length 0 gt { %if more than 0 arguments - (*ARGV*) ARGUMENTS 1 ARGUMENTS length 1 sub getinterval - _list_from_array _ref - ARGUMENTS 0 get - (\(load-file ") exch ("\)) concatenate concatenate RE pop - quit - } if -} if - -% repl loop -(\(println \(str "Mal [" *host-language* "]"\)\)) RE pop -{ %loop - (user> ) _readline - not { exit } if % exit if EOF - - { %try - REP print (\n) print - } stopped { - (Error: ) print - get_error_data false _pr_str print (\n) print - $error /newerror false put - $error /errorinfo null put - clear - cleardictstack - } if -} bind loop - -(\n) print % final newline before exit for cleanliness -quit diff --git a/python/Makefile b/python/Makefile index b461db3..6e51430 100644 --- a/python/Makefile +++ b/python/Makefile @@ -3,7 +3,7 @@ TESTS = SOURCES_BASE = mal_readline.py mal_types.py reader.py printer.py -SOURCES_LISP = env.py core.py stepA_more.py +SOURCES_LISP = env.py core.py stepA_interop.py SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) diff --git a/python/step9_interop.py b/python/step9_interop.py deleted file mode 100644 index 7cacf1f..0000000 --- a/python/step9_interop.py +++ /dev/null @@ -1,164 +0,0 @@ -import sys, traceback -import mal_readline -import mal_types as types -import reader, printer -from env import Env -import core - -# read -def READ(str): - return reader.read_str(str) - -# eval -def is_pair(x): - return types._sequential_Q(x) and len(x) > 0 - -def quasiquote(ast): - if not is_pair(ast): - return types._list(types._symbol("quote"), - ast) - elif ast[0] == 'unquote': - return ast[1] - elif is_pair(ast[0]) and ast[0][0] == 'splice-unquote': - return types._list(types._symbol("concat"), - ast[0][1], - quasiquote(ast[1:])) - else: - return types._list(types._symbol("cons"), - quasiquote(ast[0]), - quasiquote(ast[1:])) - -def is_macro_call(ast, env): - return (types._list_Q(ast) and - types._symbol_Q(ast[0]) and - env.find(ast[0]) and - hasattr(env.get(ast[0]), '_ismacro_')) - -def macroexpand(ast, env): - while is_macro_call(ast, env): - mac = env.get(ast[0]) - ast = macroexpand(mac(*ast[1:]), env) - return ast - -def eval_ast(ast, env): - if types._symbol_Q(ast): - return env.get(ast) - elif types._list_Q(ast): - return types._list(*map(lambda a: EVAL(a, env), ast)) - elif types._vector_Q(ast): - return types._vector(*map(lambda a: EVAL(a, env), ast)) - elif types._hash_map_Q(ast): - keyvals = [] - for k in ast.keys(): - keyvals.append(EVAL(k, env)) - keyvals.append(EVAL(ast[k], env)) - return types._hash_map(*keyvals) - else: - return ast # primitive value, return unchanged - -def EVAL(ast, env): - while True: - #print("EVAL %s" % printer._pr_str(ast)) - if not types._list_Q(ast): - return eval_ast(ast, env) - - # apply list - ast = macroexpand(ast, env) - if not types._list_Q(ast): return ast - if len(ast) == 0: return ast - a0 = ast[0] - - if "def!" == a0: - a1, a2 = ast[1], ast[2] - res = EVAL(a2, env) - return env.set(a1, res) - elif "let*" == a0: - a1, a2 = ast[1], ast[2] - let_env = Env(env) - for i in range(0, len(a1), 2): - let_env.set(a1[i], EVAL(a1[i+1], let_env)) - ast = a2 - env = let_env - # Continue loop (TCO) - elif "quote" == a0: - return ast[1] - elif "quasiquote" == a0: - ast = quasiquote(ast[1]); - # Continue loop (TCO) - elif 'defmacro!' == a0: - func = EVAL(ast[2], env) - func._ismacro_ = True - return env.set(ast[1], func) - elif 'macroexpand' == a0: - return macroexpand(ast[1], env) - elif "py!*" == a0: - if sys.version_info[0] >= 3: - exec(compile(ast[1], '', 'single'), globals()) - else: - exec(compile(ast[1], '', 'single') in globals()) - return None - elif "py*" == a0: - return eval(ast[1]) - elif "." == a0: - el = eval_ast(ast[2:], env) - f = eval(ast[1]) - return f(*el) - elif "do" == a0: - eval_ast(ast[1:-1], env) - ast = ast[-1] - # Continue loop (TCO) - elif "if" == a0: - a1, a2 = ast[1], ast[2] - cond = EVAL(a1, env) - if cond is None or cond is False: - if len(ast) > 3: ast = ast[3] - else: ast = None - else: - ast = a2 - # Continue loop (TCO) - elif "fn*" == a0: - a1, a2 = ast[1], ast[2] - return types._function(EVAL, Env, a2, env, a1) - else: - el = eval_ast(ast, env) - f = el[0] - if hasattr(f, '__ast__'): - ast = f.__ast__ - env = f.__gen_env__(el[1:]) - else: - return f(*el[1:]) - -# print -def PRINT(exp): - return printer._pr_str(exp) - -# repl -repl_env = Env() -def REP(str): - return PRINT(EVAL(READ(str), repl_env)) - -# core.py: defined using python -for k, v in core.ns.items(): repl_env.set(k, v) -repl_env.set('eval', lambda ast: EVAL(ast, repl_env)) -repl_env.set('*ARGV*', types._list(*sys.argv[2:])) - -# core.mal: defined using the language itself -REP("(def! not (fn* (a) (if a false true)))") -REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") -REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") -REP("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") - -if len(sys.argv) >= 2: - REP('(load-file "' + sys.argv[1] + '")') - sys.exit(0) - -# repl loop -while True: - try: - line = mal_readline.readline("user> ") - if line == None: break - if line == "": continue - print(REP(line)) - except reader.Blank: continue - except Exception as e: - print("".join(traceback.format_exception(*sys.exc_info()))) diff --git a/python/step9_try.py b/python/step9_try.py new file mode 100644 index 0000000..65da08c --- /dev/null +++ b/python/step9_try.py @@ -0,0 +1,171 @@ +import sys, traceback +import mal_readline +import mal_types as types +import reader, printer +from env import Env +import core + +# read +def READ(str): + return reader.read_str(str) + +# eval +def is_pair(x): + return types._sequential_Q(x) and len(x) > 0 + +def quasiquote(ast): + if not is_pair(ast): + return types._list(types._symbol("quote"), + ast) + elif ast[0] == 'unquote': + return ast[1] + elif is_pair(ast[0]) and ast[0][0] == 'splice-unquote': + return types._list(types._symbol("concat"), + ast[0][1], + quasiquote(ast[1:])) + else: + return types._list(types._symbol("cons"), + quasiquote(ast[0]), + quasiquote(ast[1:])) + +def is_macro_call(ast, env): + return (types._list_Q(ast) and + types._symbol_Q(ast[0]) and + env.find(ast[0]) and + hasattr(env.get(ast[0]), '_ismacro_')) + +def macroexpand(ast, env): + while is_macro_call(ast, env): + mac = env.get(ast[0]) + ast = macroexpand(mac(*ast[1:]), env) + return ast + +def eval_ast(ast, env): + if types._symbol_Q(ast): + return env.get(ast) + elif types._list_Q(ast): + return types._list(*map(lambda a: EVAL(a, env), ast)) + elif types._vector_Q(ast): + return types._vector(*map(lambda a: EVAL(a, env), ast)) + elif types._hash_map_Q(ast): + keyvals = [] + for k in ast.keys(): + keyvals.append(EVAL(k, env)) + keyvals.append(EVAL(ast[k], env)) + return types._hash_map(*keyvals) + else: + return ast # primitive value, return unchanged + +def EVAL(ast, env): + while True: + #print("EVAL %s" % printer._pr_str(ast)) + if not types._list_Q(ast): + return eval_ast(ast, env) + + # apply list + ast = macroexpand(ast, env) + if not types._list_Q(ast): return ast + if len(ast) == 0: return ast + a0 = ast[0] + + if "def!" == a0: + a1, a2 = ast[1], ast[2] + res = EVAL(a2, env) + return env.set(a1, res) + elif "let*" == a0: + a1, a2 = ast[1], ast[2] + let_env = Env(env) + for i in range(0, len(a1), 2): + let_env.set(a1[i], EVAL(a1[i+1], let_env)) + ast = a2 + env = let_env + # Continue loop (TCO) + elif "quote" == a0: + return ast[1] + elif "quasiquote" == a0: + ast = quasiquote(ast[1]); + # Continue loop (TCO) + elif 'defmacro!' == a0: + func = EVAL(ast[2], env) + func._ismacro_ = True + return env.set(ast[1], func) + elif 'macroexpand' == a0: + return macroexpand(ast[1], env) + elif "py!*" == a0: + if sys.version_info[0] >= 3: + exec(compile(ast[1], '', 'single'), globals()) + else: + exec(compile(ast[1], '', 'single') in globals()) + return None + elif "try*" == a0: + a1, a2 = ast[1], ast[2] + if a2[0] == "catch*": + try: + return EVAL(a1, env); + except Exception as exc: + exc = exc.args[0] + catch_env = Env(env, [a2[1]], [exc]) + return EVAL(a2[2], catch_env) + else: + return EVAL(a1, env); + elif "do" == a0: + eval_ast(ast[1:-1], env) + ast = ast[-1] + # Continue loop (TCO) + elif "if" == a0: + a1, a2 = ast[1], ast[2] + cond = EVAL(a1, env) + if cond is None or cond is False: + if len(ast) > 3: ast = ast[3] + else: ast = None + else: + ast = a2 + # Continue loop (TCO) + elif "fn*" == a0: + a1, a2 = ast[1], ast[2] + return types._function(EVAL, Env, a2, env, a1) + else: + el = eval_ast(ast, env) + f = el[0] + if hasattr(f, '__ast__'): + ast = f.__ast__ + env = f.__gen_env__(el[1:]) + else: + return f(*el[1:]) + +# print +def PRINT(exp): + return printer._pr_str(exp) + +# repl +repl_env = Env() +def REP(str): + return PRINT(EVAL(READ(str), repl_env)) + +# core.py: defined using python +for k, v in core.ns.items(): repl_env.set(k, v) +repl_env.set('eval', lambda ast: EVAL(ast, repl_env)) +repl_env.set('*ARGV*', types._list(*sys.argv[2:])) + +# core.mal: defined using the language itself +REP("(def! *host-language* \"python\")") +REP("(def! not (fn* (a) (if a false true)))") +REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") +REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") +REP("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") + +if len(sys.argv) >= 2: + REP('(load-file "' + sys.argv[1] + '")') + sys.exit(0) + +# repl loop +REP("(println (str \"Mal [\" *host-language* \"]\"))") +while True: + try: + line = mal_readline.readline("user> ") + if line == None: break + if line == "": continue + print(REP(line)) + except reader.Blank: continue + except Exception as e: + print("".join(traceback.format_exception(*sys.exc_info()))) diff --git a/python/stepA_interop.py b/python/stepA_interop.py new file mode 100644 index 0000000..723f0ed --- /dev/null +++ b/python/stepA_interop.py @@ -0,0 +1,177 @@ +import sys, traceback +import mal_readline +import mal_types as types +import reader, printer +from env import Env +import core + +# read +def READ(str): + return reader.read_str(str) + +# eval +def is_pair(x): + return types._sequential_Q(x) and len(x) > 0 + +def quasiquote(ast): + if not is_pair(ast): + return types._list(types._symbol("quote"), + ast) + elif ast[0] == 'unquote': + return ast[1] + elif is_pair(ast[0]) and ast[0][0] == 'splice-unquote': + return types._list(types._symbol("concat"), + ast[0][1], + quasiquote(ast[1:])) + else: + return types._list(types._symbol("cons"), + quasiquote(ast[0]), + quasiquote(ast[1:])) + +def is_macro_call(ast, env): + return (types._list_Q(ast) and + types._symbol_Q(ast[0]) and + env.find(ast[0]) and + hasattr(env.get(ast[0]), '_ismacro_')) + +def macroexpand(ast, env): + while is_macro_call(ast, env): + mac = env.get(ast[0]) + ast = macroexpand(mac(*ast[1:]), env) + return ast + +def eval_ast(ast, env): + if types._symbol_Q(ast): + return env.get(ast) + elif types._list_Q(ast): + return types._list(*map(lambda a: EVAL(a, env), ast)) + elif types._vector_Q(ast): + return types._vector(*map(lambda a: EVAL(a, env), ast)) + elif types._hash_map_Q(ast): + keyvals = [] + for k in ast.keys(): + keyvals.append(EVAL(k, env)) + keyvals.append(EVAL(ast[k], env)) + return types._hash_map(*keyvals) + else: + return ast # primitive value, return unchanged + +def EVAL(ast, env): + while True: + #print("EVAL %s" % printer._pr_str(ast)) + if not types._list_Q(ast): + return eval_ast(ast, env) + + # apply list + ast = macroexpand(ast, env) + if not types._list_Q(ast): return ast + if len(ast) == 0: return ast + a0 = ast[0] + + if "def!" == a0: + a1, a2 = ast[1], ast[2] + res = EVAL(a2, env) + return env.set(a1, res) + elif "let*" == a0: + a1, a2 = ast[1], ast[2] + let_env = Env(env) + for i in range(0, len(a1), 2): + let_env.set(a1[i], EVAL(a1[i+1], let_env)) + ast = a2 + env = let_env + # Continue loop (TCO) + elif "quote" == a0: + return ast[1] + elif "quasiquote" == a0: + ast = quasiquote(ast[1]); + # Continue loop (TCO) + elif 'defmacro!' == a0: + func = EVAL(ast[2], env) + func._ismacro_ = True + return env.set(ast[1], func) + elif 'macroexpand' == a0: + return macroexpand(ast[1], env) + elif "py!*" == a0: + if sys.version_info[0] >= 3: + exec(compile(ast[1], '', 'single'), globals()) + else: + exec(compile(ast[1], '', 'single') in globals()) + return None + elif "py*" == a0: + return eval(ast[1]) + elif "." == a0: + el = eval_ast(ast[2:], env) + f = eval(ast[1]) + return f(*el) + elif "try*" == a0: + a1, a2 = ast[1], ast[2] + if a2[0] == "catch*": + try: + return EVAL(a1, env); + except Exception as exc: + exc = exc.args[0] + catch_env = Env(env, [a2[1]], [exc]) + return EVAL(a2[2], catch_env) + else: + return EVAL(a1, env); + elif "do" == a0: + eval_ast(ast[1:-1], env) + ast = ast[-1] + # Continue loop (TCO) + elif "if" == a0: + a1, a2 = ast[1], ast[2] + cond = EVAL(a1, env) + if cond is None or cond is False: + if len(ast) > 3: ast = ast[3] + else: ast = None + else: + ast = a2 + # Continue loop (TCO) + elif "fn*" == a0: + a1, a2 = ast[1], ast[2] + return types._function(EVAL, Env, a2, env, a1) + else: + el = eval_ast(ast, env) + f = el[0] + if hasattr(f, '__ast__'): + ast = f.__ast__ + env = f.__gen_env__(el[1:]) + else: + return f(*el[1:]) + +# print +def PRINT(exp): + return printer._pr_str(exp) + +# repl +repl_env = Env() +def REP(str): + return PRINT(EVAL(READ(str), repl_env)) + +# core.py: defined using python +for k, v in core.ns.items(): repl_env.set(k, v) +repl_env.set('eval', lambda ast: EVAL(ast, repl_env)) +repl_env.set('*ARGV*', types._list(*sys.argv[2:])) + +# core.mal: defined using the language itself +REP("(def! *host-language* \"python\")") +REP("(def! not (fn* (a) (if a false true)))") +REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") +REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") +REP("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") + +if len(sys.argv) >= 2: + REP('(load-file "' + sys.argv[1] + '")') + sys.exit(0) + +# repl loop +REP("(println (str \"Mal [\" *host-language* \"]\"))") +while True: + try: + line = mal_readline.readline("user> ") + if line == None: break + if line == "": continue + print(REP(line)) + except reader.Blank: continue + except Exception as e: + print("".join(traceback.format_exception(*sys.exc_info()))) diff --git a/python/stepA_more.py b/python/stepA_more.py deleted file mode 100644 index 723f0ed..0000000 --- a/python/stepA_more.py +++ /dev/null @@ -1,177 +0,0 @@ -import sys, traceback -import mal_readline -import mal_types as types -import reader, printer -from env import Env -import core - -# read -def READ(str): - return reader.read_str(str) - -# eval -def is_pair(x): - return types._sequential_Q(x) and len(x) > 0 - -def quasiquote(ast): - if not is_pair(ast): - return types._list(types._symbol("quote"), - ast) - elif ast[0] == 'unquote': - return ast[1] - elif is_pair(ast[0]) and ast[0][0] == 'splice-unquote': - return types._list(types._symbol("concat"), - ast[0][1], - quasiquote(ast[1:])) - else: - return types._list(types._symbol("cons"), - quasiquote(ast[0]), - quasiquote(ast[1:])) - -def is_macro_call(ast, env): - return (types._list_Q(ast) and - types._symbol_Q(ast[0]) and - env.find(ast[0]) and - hasattr(env.get(ast[0]), '_ismacro_')) - -def macroexpand(ast, env): - while is_macro_call(ast, env): - mac = env.get(ast[0]) - ast = macroexpand(mac(*ast[1:]), env) - return ast - -def eval_ast(ast, env): - if types._symbol_Q(ast): - return env.get(ast) - elif types._list_Q(ast): - return types._list(*map(lambda a: EVAL(a, env), ast)) - elif types._vector_Q(ast): - return types._vector(*map(lambda a: EVAL(a, env), ast)) - elif types._hash_map_Q(ast): - keyvals = [] - for k in ast.keys(): - keyvals.append(EVAL(k, env)) - keyvals.append(EVAL(ast[k], env)) - return types._hash_map(*keyvals) - else: - return ast # primitive value, return unchanged - -def EVAL(ast, env): - while True: - #print("EVAL %s" % printer._pr_str(ast)) - if not types._list_Q(ast): - return eval_ast(ast, env) - - # apply list - ast = macroexpand(ast, env) - if not types._list_Q(ast): return ast - if len(ast) == 0: return ast - a0 = ast[0] - - if "def!" == a0: - a1, a2 = ast[1], ast[2] - res = EVAL(a2, env) - return env.set(a1, res) - elif "let*" == a0: - a1, a2 = ast[1], ast[2] - let_env = Env(env) - for i in range(0, len(a1), 2): - let_env.set(a1[i], EVAL(a1[i+1], let_env)) - ast = a2 - env = let_env - # Continue loop (TCO) - elif "quote" == a0: - return ast[1] - elif "quasiquote" == a0: - ast = quasiquote(ast[1]); - # Continue loop (TCO) - elif 'defmacro!' == a0: - func = EVAL(ast[2], env) - func._ismacro_ = True - return env.set(ast[1], func) - elif 'macroexpand' == a0: - return macroexpand(ast[1], env) - elif "py!*" == a0: - if sys.version_info[0] >= 3: - exec(compile(ast[1], '', 'single'), globals()) - else: - exec(compile(ast[1], '', 'single') in globals()) - return None - elif "py*" == a0: - return eval(ast[1]) - elif "." == a0: - el = eval_ast(ast[2:], env) - f = eval(ast[1]) - return f(*el) - elif "try*" == a0: - a1, a2 = ast[1], ast[2] - if a2[0] == "catch*": - try: - return EVAL(a1, env); - except Exception as exc: - exc = exc.args[0] - catch_env = Env(env, [a2[1]], [exc]) - return EVAL(a2[2], catch_env) - else: - return EVAL(a1, env); - elif "do" == a0: - eval_ast(ast[1:-1], env) - ast = ast[-1] - # Continue loop (TCO) - elif "if" == a0: - a1, a2 = ast[1], ast[2] - cond = EVAL(a1, env) - if cond is None or cond is False: - if len(ast) > 3: ast = ast[3] - else: ast = None - else: - ast = a2 - # Continue loop (TCO) - elif "fn*" == a0: - a1, a2 = ast[1], ast[2] - return types._function(EVAL, Env, a2, env, a1) - else: - el = eval_ast(ast, env) - f = el[0] - if hasattr(f, '__ast__'): - ast = f.__ast__ - env = f.__gen_env__(el[1:]) - else: - return f(*el[1:]) - -# print -def PRINT(exp): - return printer._pr_str(exp) - -# repl -repl_env = Env() -def REP(str): - return PRINT(EVAL(READ(str), repl_env)) - -# core.py: defined using python -for k, v in core.ns.items(): repl_env.set(k, v) -repl_env.set('eval', lambda ast: EVAL(ast, repl_env)) -repl_env.set('*ARGV*', types._list(*sys.argv[2:])) - -# core.mal: defined using the language itself -REP("(def! *host-language* \"python\")") -REP("(def! not (fn* (a) (if a false true)))") -REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") -REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") -REP("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") - -if len(sys.argv) >= 2: - REP('(load-file "' + sys.argv[1] + '")') - sys.exit(0) - -# repl loop -REP("(println (str \"Mal [\" *host-language* \"]\"))") -while True: - try: - line = mal_readline.readline("user> ") - if line == None: break - if line == "": continue - print(REP(line)) - except reader.Blank: continue - except Exception as e: - print("".join(traceback.format_exception(*sys.exc_info()))) diff --git a/ruby/Makefile b/ruby/Makefile index 71ab92c..f9792f5 100644 --- a/ruby/Makefile +++ b/ruby/Makefile @@ -1,7 +1,7 @@ TESTS = SOURCES_BASE = mal_readline.rb types.rb reader.rb printer.rb -SOURCES_LISP = env.rb core.rb stepA_more.rb +SOURCES_LISP = env.rb core.rb stepA_interop.rb SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) #all: mal.rb diff --git a/ruby/step9_interop.rb b/ruby/step9_interop.rb deleted file mode 100644 index 6d2cbe2..0000000 --- a/ruby/step9_interop.rb +++ /dev/null @@ -1,163 +0,0 @@ -$: << File.expand_path(File.dirname(__FILE__)) -require "mal_readline" -require "types" -require "reader" -require "printer" -require "env" -require "core" - -# read -def READ(str) - return read_str(str) -end - -# eval -def pair?(x) - return sequential?(x) && x.size > 0 -end - -def quasiquote(ast) - if not pair?(ast) - return List.new [:quote, ast] - elsif ast[0] == :unquote - return ast[1] - elsif pair?(ast[0]) && ast[0][0] == :"splice-unquote" - return List.new [:concat, ast[0][1], quasiquote(ast.drop(1))] - else - return List.new [:cons, quasiquote(ast[0]), quasiquote(ast.drop(1))] - end -end - -def macro_call?(ast, env) - return (ast.is_a?(List) && - ast[0].is_a?(Symbol) && - env.find(ast[0]) && - env.get(ast[0]).is_a?(Function) && - env.get(ast[0]).is_macro) -end - -def macroexpand(ast, env) - while macro_call?(ast, env) - mac = env.get(ast[0]) - ast = mac[*ast.drop(1)] - end - return ast -end - -def eval_ast(ast, env) - return case ast - when Symbol - env.get(ast) - when List - List.new ast.map{|a| EVAL(a, env)} - when Vector - Vector.new ast.map{|a| EVAL(a, env)} - when Hash - new_hm = {} - ast.each{|k,v| new_hm[EVAL(k,env)] = EVAL(v, env)} - new_hm - else - ast - end -end - -def EVAL(ast, env) - while true - - #puts "EVAL: #{_pr_str(ast, true)}" - - if not ast.is_a? List - return eval_ast(ast, env) - end - - # apply list - ast = macroexpand(ast, env) - return ast if not ast.is_a? List - - a0,a1,a2,a3 = ast - case a0 - when :def! - return env.set(a1, EVAL(a2, env)) - when :"let*" - let_env = Env.new(env) - a1.each_slice(2) do |a,e| - let_env.set(a, EVAL(e, let_env)) - end - env = let_env - ast = a2 # Continue loop (TCO) - when :quote - return a1 - when :quasiquote - ast = quasiquote(a1); # Continue loop (TCO) - when :defmacro! - func = EVAL(a2, env) - func.is_macro = true - return env.set(a1, func) - when :macroexpand - return macroexpand(a1, env) - when :"rb*" - return eval(a1) - when :do - eval_ast(ast[1..-2], env) - ast = ast.last # Continue loop (TCO) - when :if - cond = EVAL(a1, env) - if not cond - return nil if a3 == nil - ast = a3 # Continue loop (TCO) - else - ast = a2 # Continue loop (TCO) - end - when :"fn*" - return Function.new(a2, env, a1) {|*args| - EVAL(a2, Env.new(env, a1, args)) - } - else - el = eval_ast(ast, env) - f = el[0] - if f.class == Function - ast = f.ast - env = f.gen_env(el.drop(1)) # Continue loop (TCO) - else - return f[*el.drop(1)] - end - end - - end -end - -# print -def PRINT(exp) - return _pr_str(exp, true) -end - -# repl -repl_env = Env.new -RE = lambda {|str| EVAL(READ(str), repl_env) } -REP = lambda {|str| PRINT(EVAL(READ(str), repl_env)) } - -# core.rb: defined using ruby -$core_ns.each do |k,v| repl_env.set(k,v) end -repl_env.set(:eval, lambda {|ast| EVAL(ast, repl_env)}) -repl_env.set(:"*ARGV*", List.new(ARGV.slice(1,ARGV.length) || [])) - -# core.mal: defined using the language itself -RE["(def! not (fn* (a) (if a false true)))"] -RE["(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"] -RE["(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"] -RE["(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"] - -if ARGV.size > 0 - RE["(load-file \"" + ARGV[0] + "\")"] - exit 0 -end - -# repl loop -while line = _readline("user> ") - begin - puts REP[line] - rescue Exception => e - puts "Error: #{e}" - puts "\t#{e.backtrace.join("\n\t")}" - end -end diff --git a/ruby/step9_try.rb b/ruby/step9_try.rb new file mode 100644 index 0000000..6123293 --- /dev/null +++ b/ruby/step9_try.rb @@ -0,0 +1,180 @@ +$: << File.expand_path(File.dirname(__FILE__)) +require "mal_readline" +require "types" +require "reader" +require "printer" +require "env" +require "core" + +# read +def READ(str) + return read_str(str) +end + +# eval +def pair?(x) + return sequential?(x) && x.size > 0 +end + +def quasiquote(ast) + if not pair?(ast) + return List.new [:quote, ast] + elsif ast[0] == :unquote + return ast[1] + elsif pair?(ast[0]) && ast[0][0] == :"splice-unquote" + return List.new [:concat, ast[0][1], quasiquote(ast.drop(1))] + else + return List.new [:cons, quasiquote(ast[0]), quasiquote(ast.drop(1))] + end +end + +def macro_call?(ast, env) + return (ast.is_a?(List) && + ast[0].is_a?(Symbol) && + env.find(ast[0]) && + env.get(ast[0]).is_a?(Function) && + env.get(ast[0]).is_macro) +end + +def macroexpand(ast, env) + while macro_call?(ast, env) + mac = env.get(ast[0]) + ast = mac[*ast.drop(1)] + end + return ast +end + +def eval_ast(ast, env) + return case ast + when Symbol + env.get(ast) + when List + List.new ast.map{|a| EVAL(a, env)} + when Vector + Vector.new ast.map{|a| EVAL(a, env)} + when Hash + new_hm = {} + ast.each{|k,v| new_hm[EVAL(k,env)] = EVAL(v, env)} + new_hm + else + ast + end +end + +def EVAL(ast, env) + while true + + #puts "EVAL: #{_pr_str(ast, true)}" + + if not ast.is_a? List + return eval_ast(ast, env) + end + + # apply list + ast = macroexpand(ast, env) + return ast if not ast.is_a? List + + a0,a1,a2,a3 = ast + case a0 + when :def! + return env.set(a1, EVAL(a2, env)) + when :"let*" + let_env = Env.new(env) + a1.each_slice(2) do |a,e| + let_env.set(a, EVAL(e, let_env)) + end + env = let_env + ast = a2 # Continue loop (TCO) + when :quote + return a1 + when :quasiquote + ast = quasiquote(a1); # Continue loop (TCO) + when :defmacro! + func = EVAL(a2, env) + func.is_macro = true + return env.set(a1, func) + when :macroexpand + return macroexpand(a1, env) + when :"rb*" + return eval(a1) + when :"try*" + begin + return EVAL(a1, env) + rescue Exception => exc + if exc.is_a? MalException + exc = exc.data + else + exc = exc.message + end + if a2 && a2[0] == :"catch*" + return EVAL(a2[2], Env.new(env, [a2[1]], [exc])) + else + raise esc + end + end + when :do + eval_ast(ast[1..-2], env) + ast = ast.last # Continue loop (TCO) + when :if + cond = EVAL(a1, env) + if not cond + return nil if a3 == nil + ast = a3 # Continue loop (TCO) + else + ast = a2 # Continue loop (TCO) + end + when :"fn*" + return Function.new(a2, env, a1) {|*args| + EVAL(a2, Env.new(env, a1, args)) + } + else + el = eval_ast(ast, env) + f = el[0] + if f.class == Function + ast = f.ast + env = f.gen_env(el.drop(1)) # Continue loop (TCO) + else + return f[*el.drop(1)] + end + end + + end +end + +# print +def PRINT(exp) + return _pr_str(exp, true) +end + +# repl +repl_env = Env.new +RE = lambda {|str| EVAL(READ(str), repl_env) } +REP = lambda {|str| PRINT(EVAL(READ(str), repl_env)) } + +# core.rb: defined using ruby +$core_ns.each do |k,v| repl_env.set(k,v) end +repl_env.set(:eval, lambda {|ast| EVAL(ast, repl_env)}) +repl_env.set(:"*ARGV*", List.new(ARGV.slice(1,ARGV.length) || [])) + +# core.mal: defined using the language itself +RE["(def! *host-language* \"ruby\")"] +RE["(def! not (fn* (a) (if a false true)))"] +RE["(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"] +RE["(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"] +RE["(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"] + +if ARGV.size > 0 + RE["(load-file \"" + ARGV[0] + "\")"] + exit 0 +end + +# repl loop +RE["(println (str \"Mal [\" *host-language* \"]\"))"] +while line = _readline("user> ") + begin + puts REP[line] + rescue Exception => e + puts "Error: #{e}" + puts "\t#{e.backtrace.join("\n\t")}" + end +end diff --git a/ruby/stepA_interop.rb b/ruby/stepA_interop.rb new file mode 100644 index 0000000..6d2cbe2 --- /dev/null +++ b/ruby/stepA_interop.rb @@ -0,0 +1,163 @@ +$: << File.expand_path(File.dirname(__FILE__)) +require "mal_readline" +require "types" +require "reader" +require "printer" +require "env" +require "core" + +# read +def READ(str) + return read_str(str) +end + +# eval +def pair?(x) + return sequential?(x) && x.size > 0 +end + +def quasiquote(ast) + if not pair?(ast) + return List.new [:quote, ast] + elsif ast[0] == :unquote + return ast[1] + elsif pair?(ast[0]) && ast[0][0] == :"splice-unquote" + return List.new [:concat, ast[0][1], quasiquote(ast.drop(1))] + else + return List.new [:cons, quasiquote(ast[0]), quasiquote(ast.drop(1))] + end +end + +def macro_call?(ast, env) + return (ast.is_a?(List) && + ast[0].is_a?(Symbol) && + env.find(ast[0]) && + env.get(ast[0]).is_a?(Function) && + env.get(ast[0]).is_macro) +end + +def macroexpand(ast, env) + while macro_call?(ast, env) + mac = env.get(ast[0]) + ast = mac[*ast.drop(1)] + end + return ast +end + +def eval_ast(ast, env) + return case ast + when Symbol + env.get(ast) + when List + List.new ast.map{|a| EVAL(a, env)} + when Vector + Vector.new ast.map{|a| EVAL(a, env)} + when Hash + new_hm = {} + ast.each{|k,v| new_hm[EVAL(k,env)] = EVAL(v, env)} + new_hm + else + ast + end +end + +def EVAL(ast, env) + while true + + #puts "EVAL: #{_pr_str(ast, true)}" + + if not ast.is_a? List + return eval_ast(ast, env) + end + + # apply list + ast = macroexpand(ast, env) + return ast if not ast.is_a? List + + a0,a1,a2,a3 = ast + case a0 + when :def! + return env.set(a1, EVAL(a2, env)) + when :"let*" + let_env = Env.new(env) + a1.each_slice(2) do |a,e| + let_env.set(a, EVAL(e, let_env)) + end + env = let_env + ast = a2 # Continue loop (TCO) + when :quote + return a1 + when :quasiquote + ast = quasiquote(a1); # Continue loop (TCO) + when :defmacro! + func = EVAL(a2, env) + func.is_macro = true + return env.set(a1, func) + when :macroexpand + return macroexpand(a1, env) + when :"rb*" + return eval(a1) + when :do + eval_ast(ast[1..-2], env) + ast = ast.last # Continue loop (TCO) + when :if + cond = EVAL(a1, env) + if not cond + return nil if a3 == nil + ast = a3 # Continue loop (TCO) + else + ast = a2 # Continue loop (TCO) + end + when :"fn*" + return Function.new(a2, env, a1) {|*args| + EVAL(a2, Env.new(env, a1, args)) + } + else + el = eval_ast(ast, env) + f = el[0] + if f.class == Function + ast = f.ast + env = f.gen_env(el.drop(1)) # Continue loop (TCO) + else + return f[*el.drop(1)] + end + end + + end +end + +# print +def PRINT(exp) + return _pr_str(exp, true) +end + +# repl +repl_env = Env.new +RE = lambda {|str| EVAL(READ(str), repl_env) } +REP = lambda {|str| PRINT(EVAL(READ(str), repl_env)) } + +# core.rb: defined using ruby +$core_ns.each do |k,v| repl_env.set(k,v) end +repl_env.set(:eval, lambda {|ast| EVAL(ast, repl_env)}) +repl_env.set(:"*ARGV*", List.new(ARGV.slice(1,ARGV.length) || [])) + +# core.mal: defined using the language itself +RE["(def! not (fn* (a) (if a false true)))"] +RE["(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"] +RE["(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"] +RE["(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"] + +if ARGV.size > 0 + RE["(load-file \"" + ARGV[0] + "\")"] + exit 0 +end + +# repl loop +while line = _readline("user> ") + begin + puts REP[line] + rescue Exception => e + puts "Error: #{e}" + puts "\t#{e.backtrace.join("\n\t")}" + end +end diff --git a/ruby/stepA_more.rb b/ruby/stepA_more.rb deleted file mode 100644 index 6123293..0000000 --- a/ruby/stepA_more.rb +++ /dev/null @@ -1,180 +0,0 @@ -$: << File.expand_path(File.dirname(__FILE__)) -require "mal_readline" -require "types" -require "reader" -require "printer" -require "env" -require "core" - -# read -def READ(str) - return read_str(str) -end - -# eval -def pair?(x) - return sequential?(x) && x.size > 0 -end - -def quasiquote(ast) - if not pair?(ast) - return List.new [:quote, ast] - elsif ast[0] == :unquote - return ast[1] - elsif pair?(ast[0]) && ast[0][0] == :"splice-unquote" - return List.new [:concat, ast[0][1], quasiquote(ast.drop(1))] - else - return List.new [:cons, quasiquote(ast[0]), quasiquote(ast.drop(1))] - end -end - -def macro_call?(ast, env) - return (ast.is_a?(List) && - ast[0].is_a?(Symbol) && - env.find(ast[0]) && - env.get(ast[0]).is_a?(Function) && - env.get(ast[0]).is_macro) -end - -def macroexpand(ast, env) - while macro_call?(ast, env) - mac = env.get(ast[0]) - ast = mac[*ast.drop(1)] - end - return ast -end - -def eval_ast(ast, env) - return case ast - when Symbol - env.get(ast) - when List - List.new ast.map{|a| EVAL(a, env)} - when Vector - Vector.new ast.map{|a| EVAL(a, env)} - when Hash - new_hm = {} - ast.each{|k,v| new_hm[EVAL(k,env)] = EVAL(v, env)} - new_hm - else - ast - end -end - -def EVAL(ast, env) - while true - - #puts "EVAL: #{_pr_str(ast, true)}" - - if not ast.is_a? List - return eval_ast(ast, env) - end - - # apply list - ast = macroexpand(ast, env) - return ast if not ast.is_a? List - - a0,a1,a2,a3 = ast - case a0 - when :def! - return env.set(a1, EVAL(a2, env)) - when :"let*" - let_env = Env.new(env) - a1.each_slice(2) do |a,e| - let_env.set(a, EVAL(e, let_env)) - end - env = let_env - ast = a2 # Continue loop (TCO) - when :quote - return a1 - when :quasiquote - ast = quasiquote(a1); # Continue loop (TCO) - when :defmacro! - func = EVAL(a2, env) - func.is_macro = true - return env.set(a1, func) - when :macroexpand - return macroexpand(a1, env) - when :"rb*" - return eval(a1) - when :"try*" - begin - return EVAL(a1, env) - rescue Exception => exc - if exc.is_a? MalException - exc = exc.data - else - exc = exc.message - end - if a2 && a2[0] == :"catch*" - return EVAL(a2[2], Env.new(env, [a2[1]], [exc])) - else - raise esc - end - end - when :do - eval_ast(ast[1..-2], env) - ast = ast.last # Continue loop (TCO) - when :if - cond = EVAL(a1, env) - if not cond - return nil if a3 == nil - ast = a3 # Continue loop (TCO) - else - ast = a2 # Continue loop (TCO) - end - when :"fn*" - return Function.new(a2, env, a1) {|*args| - EVAL(a2, Env.new(env, a1, args)) - } - else - el = eval_ast(ast, env) - f = el[0] - if f.class == Function - ast = f.ast - env = f.gen_env(el.drop(1)) # Continue loop (TCO) - else - return f[*el.drop(1)] - end - end - - end -end - -# print -def PRINT(exp) - return _pr_str(exp, true) -end - -# repl -repl_env = Env.new -RE = lambda {|str| EVAL(READ(str), repl_env) } -REP = lambda {|str| PRINT(EVAL(READ(str), repl_env)) } - -# core.rb: defined using ruby -$core_ns.each do |k,v| repl_env.set(k,v) end -repl_env.set(:eval, lambda {|ast| EVAL(ast, repl_env)}) -repl_env.set(:"*ARGV*", List.new(ARGV.slice(1,ARGV.length) || [])) - -# core.mal: defined using the language itself -RE["(def! *host-language* \"ruby\")"] -RE["(def! not (fn* (a) (if a false true)))"] -RE["(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"] -RE["(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"] -RE["(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"] - -if ARGV.size > 0 - RE["(load-file \"" + ARGV[0] + "\")"] - exit 0 -end - -# repl loop -RE["(println (str \"Mal [\" *host-language* \"]\"))"] -while line = _readline("user> ") - begin - puts REP[line] - rescue Exception => e - puts "Error: #{e}" - puts "\t#{e.backtrace.join("\n\t")}" - end -end diff --git a/ruby/tests/stepA_interop.mal b/ruby/tests/stepA_interop.mal new file mode 100644 index 0000000..2d7efb8 --- /dev/null +++ b/ruby/tests/stepA_interop.mal @@ -0,0 +1,27 @@ +;; Testing basic ruby interop + +(rb* "7") +;=>7 + +(rb* "'7'") +;=>"7" + +(rb* "[7,8,9]") +;=>(7 8 9) + +(rb* "{\"abc\" => 789}") +;=>{"abc" 789} + +(rb* "print 'hello\n'") +; hello +;=>nil + +(rb* "$foo=8;") +(rb* "$foo") +;=>8 + +(rb* "['a','b','c'].map{|x| 'X'+x+'Y'}.join(' ')") +;=>"XaY XbY XcY" + +(rb* "[1,2,3].map{|x| 1+x}") +;=>(2 3 4) diff --git a/tests/step1_read_print.mal b/tests/step1_read_print.mal index 2b7c269..43e7931 100644 --- a/tests/step1_read_print.mal +++ b/tests/step1_read_print.mal @@ -51,6 +51,10 @@ abc-def ;=>(+ 1 (+ 2 3)) ( + 1 (+ 2 3 ) ) ;=>(+ 1 (+ 2 3)) +(* 1 2) +;=>(* 1 2) +(** 1 2) +;=>(** 1 2) ;; Testing read of vectors [+ 1 2] diff --git a/tests/step9_try.mal b/tests/step9_try.mal new file mode 100644 index 0000000..7b7dac5 --- /dev/null +++ b/tests/step9_try.mal @@ -0,0 +1,337 @@ +;; +;; Testing try*/catch* + +(try* (abc 1 2) (catch* exc (prn "exc is:" exc)))) +; "exc is:" "'abc' not found" +;=>nil + +;;;TODO: fix so long lines don't trigger ANSI escape codes ;;;(try* +;;;(try* (throw {"data" "foo"}) (catch* exc (do (prn "exc is:" exc) 7))) ;;;; +;;;; "exc is:" {"data" "foo"} ;;;;=>7 +;;;;=>7 + +(try* (throw {"data" "foo"}) (catch* exc (do (prn "err:" exc) 7))) +; "err:" {"data" "foo"} +;=>7 + +(try* (throw "my exception") (catch* exc (do (prn "exc:" exc) 7))) +; "exc:" "my exception" +;=>7 + + +;; +;; Testing builtin functions + +(symbol? 'abc) +;=>true +(symbol? "abc") +;=>false + +(nil? nil) +;=>true +(nil? true) +;=>false + +(true? true) +;=>true +(true? false) +;=>false +(true? true?) +;=>false + +(false? false) +;=>true +(false? true) +;=>false + +;; Testing apply function +(apply + (list 2 3)) +;=>5 +(apply + 4 (list 5)) +;=>9 +(apply prn (list 1 2 "3" (list))) +; 1 2 "3" () +;=>nil + + +;; Testing map function +(def! nums (list 1 2 3)) +(def! double (fn* (a) (* 2 a))) +(double 3) +;=>6 +(map double nums) +;=>(2 4 6) + +;; +;; Testing read-str and eval +(read-string "(1 2 (3 4) nil)") +;=>(1 2 (3 4) nil) + +(read-string "7 ;; comment") +;=>7 + +;;; Differing output, but make sure no fatal error +(read-string ";; comment") + + +(eval (read-string "(+ 4 5)")) +;=>9 + +;; +;; Testing readline +(readline "mal-user> ") +"hello" +;=>"\"hello\"" + +;; +;; -------- Optional Functionality -------- + +;; Testing sequential? function + +(sequential? (list 1 2 3)) +;=>true +(sequential? [15]) +;=>true +(sequential? sequential?) +;=>false +(sequential? nil) +;=>false +(sequential? "abc") +;=>false + +;; Testing vector functions + +(vector? [10 11]) +;=>true +(vector? '(12 13)) +;=>false +(vector 3 4 5) +;=>[3 4 5] + +;; 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]] + +(map? []) +;=>false + +;; +;; Testing hash-maps +(hash-map "a" 1) +;=>{"a" 1} + +{"a" 1} +;=>{"a" 1} + +(assoc {} "a" 1) +;=>{"a" 1} + +(def! hm1 (hash-map)) +;=>{} + +(map? hm1) +;=>true +(map? 1) +;=>false +(map? "abc") +;=>false + +(get nil "a") +;=>nil + +(get hm1 "a") +;=>nil + +(contains? hm1 "a") +;=>false + +(def! hm2 (assoc hm1 "a" 1)) +;=>{"a" 1} + +(get hm1 "a") +;=>nil + +(contains? hm1 "a") +;=>false + +(get hm2 "a") +;=>1 + +(contains? hm2 "a") +;=>true + +(keys hm2) +;=>("a") + +(vals hm2) +;=>(1) + +(count (keys (assoc hm2 "b" 2 "c" 3))) +;=>3 + +(def! hm3 (assoc hm2 "b" 2)) +(count (keys hm3)) +;=>2 +(count (vals hm3)) +;=>2 + +(dissoc hm3 "a") +;=>{"b" 2} + +(dissoc hm3 "a" "b") +;=>{} + +(dissoc hm3 "a" "b" "c") +;=>{} + +(count (keys hm3)) +;=>2 + + +;; +;; Testing metadata +(meta [1 2 3]) +;=>nil + +(meta (fn* (a) a)) +;=>nil + +(with-meta [1 2 3] {"a" 1}) +;=>[1 2 3] + +(meta (with-meta [1 2 3] {"a" 1})) +;=>{"a" 1} + +(meta (with-meta [1 2 3] "abc")) +;=>"abc" + +(meta (with-meta (list 1 2 3) {"a" 1})) +;=>{"a" 1} + +(meta (with-meta {"abc" 123} {"a" 1})) +;=>{"a" 1} + +;;; Not actually supported by Clojure +;;;(meta (with-meta (atom 7) {"a" 1})) +;;;;=>{"a" 1} + +(def! l-wm (with-meta [4 5 6] {"b" 2})) +;=>[4 5 6] +(meta l-wm) +;=>{"b" 2} + +(meta (with-meta l-wm {"new_meta" 123})) +;=>{"new_meta" 123} +(meta l-wm) +;=>{"b" 2} + +;; Testing metadata on functions +(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} + +;; Testing metadata on builtin functions +(meta +) +;=>nil +(def! f-wm3 ^{"def" 2} +) +(meta f-wm3) +;=>{"def" 2} +(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 atoms + +(def! inc3 (fn* (a) (+ 3 a))) + +(def! a (atom 2)) +;=>(atom 2) + +;;;(type a) +;;;;=>"atom" + +(deref a) +;=>2 + +@a +;=>2 + +(reset! a 3) +;=>3 + +@a +;=>3 + +(swap! a inc3) +;=>6 + +@a +;=>6 + +(swap! a (fn* (a) a)) +;=>6 + +(swap! a (fn* (a) (* 2 a))) +;=>12 + +(swap! a (fn* (a b) (* a b)) 10) +;=>120 + +(swap! a + 3) +;=>123 + +;; Testing swap!/closure interaction +(def! inc-it (fn* (a) (+ 1 a))) +(def! atm (atom 7)) +(def! f (fn* [] (swap! atm inc-it))) +(f) +;=>8 +(f) +;=>9 + diff --git a/tests/stepA_more.mal b/tests/stepA_more.mal deleted file mode 100644 index 7b7dac5..0000000 --- a/tests/stepA_more.mal +++ /dev/null @@ -1,337 +0,0 @@ -;; -;; Testing try*/catch* - -(try* (abc 1 2) (catch* exc (prn "exc is:" exc)))) -; "exc is:" "'abc' not found" -;=>nil - -;;;TODO: fix so long lines don't trigger ANSI escape codes ;;;(try* -;;;(try* (throw {"data" "foo"}) (catch* exc (do (prn "exc is:" exc) 7))) ;;;; -;;;; "exc is:" {"data" "foo"} ;;;;=>7 -;;;;=>7 - -(try* (throw {"data" "foo"}) (catch* exc (do (prn "err:" exc) 7))) -; "err:" {"data" "foo"} -;=>7 - -(try* (throw "my exception") (catch* exc (do (prn "exc:" exc) 7))) -; "exc:" "my exception" -;=>7 - - -;; -;; Testing builtin functions - -(symbol? 'abc) -;=>true -(symbol? "abc") -;=>false - -(nil? nil) -;=>true -(nil? true) -;=>false - -(true? true) -;=>true -(true? false) -;=>false -(true? true?) -;=>false - -(false? false) -;=>true -(false? true) -;=>false - -;; Testing apply function -(apply + (list 2 3)) -;=>5 -(apply + 4 (list 5)) -;=>9 -(apply prn (list 1 2 "3" (list))) -; 1 2 "3" () -;=>nil - - -;; Testing map function -(def! nums (list 1 2 3)) -(def! double (fn* (a) (* 2 a))) -(double 3) -;=>6 -(map double nums) -;=>(2 4 6) - -;; -;; Testing read-str and eval -(read-string "(1 2 (3 4) nil)") -;=>(1 2 (3 4) nil) - -(read-string "7 ;; comment") -;=>7 - -;;; Differing output, but make sure no fatal error -(read-string ";; comment") - - -(eval (read-string "(+ 4 5)")) -;=>9 - -;; -;; Testing readline -(readline "mal-user> ") -"hello" -;=>"\"hello\"" - -;; -;; -------- Optional Functionality -------- - -;; Testing sequential? function - -(sequential? (list 1 2 3)) -;=>true -(sequential? [15]) -;=>true -(sequential? sequential?) -;=>false -(sequential? nil) -;=>false -(sequential? "abc") -;=>false - -;; Testing vector functions - -(vector? [10 11]) -;=>true -(vector? '(12 13)) -;=>false -(vector 3 4 5) -;=>[3 4 5] - -;; 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]] - -(map? []) -;=>false - -;; -;; Testing hash-maps -(hash-map "a" 1) -;=>{"a" 1} - -{"a" 1} -;=>{"a" 1} - -(assoc {} "a" 1) -;=>{"a" 1} - -(def! hm1 (hash-map)) -;=>{} - -(map? hm1) -;=>true -(map? 1) -;=>false -(map? "abc") -;=>false - -(get nil "a") -;=>nil - -(get hm1 "a") -;=>nil - -(contains? hm1 "a") -;=>false - -(def! hm2 (assoc hm1 "a" 1)) -;=>{"a" 1} - -(get hm1 "a") -;=>nil - -(contains? hm1 "a") -;=>false - -(get hm2 "a") -;=>1 - -(contains? hm2 "a") -;=>true - -(keys hm2) -;=>("a") - -(vals hm2) -;=>(1) - -(count (keys (assoc hm2 "b" 2 "c" 3))) -;=>3 - -(def! hm3 (assoc hm2 "b" 2)) -(count (keys hm3)) -;=>2 -(count (vals hm3)) -;=>2 - -(dissoc hm3 "a") -;=>{"b" 2} - -(dissoc hm3 "a" "b") -;=>{} - -(dissoc hm3 "a" "b" "c") -;=>{} - -(count (keys hm3)) -;=>2 - - -;; -;; Testing metadata -(meta [1 2 3]) -;=>nil - -(meta (fn* (a) a)) -;=>nil - -(with-meta [1 2 3] {"a" 1}) -;=>[1 2 3] - -(meta (with-meta [1 2 3] {"a" 1})) -;=>{"a" 1} - -(meta (with-meta [1 2 3] "abc")) -;=>"abc" - -(meta (with-meta (list 1 2 3) {"a" 1})) -;=>{"a" 1} - -(meta (with-meta {"abc" 123} {"a" 1})) -;=>{"a" 1} - -;;; Not actually supported by Clojure -;;;(meta (with-meta (atom 7) {"a" 1})) -;;;;=>{"a" 1} - -(def! l-wm (with-meta [4 5 6] {"b" 2})) -;=>[4 5 6] -(meta l-wm) -;=>{"b" 2} - -(meta (with-meta l-wm {"new_meta" 123})) -;=>{"new_meta" 123} -(meta l-wm) -;=>{"b" 2} - -;; Testing metadata on functions -(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} - -;; Testing metadata on builtin functions -(meta +) -;=>nil -(def! f-wm3 ^{"def" 2} +) -(meta f-wm3) -;=>{"def" 2} -(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 atoms - -(def! inc3 (fn* (a) (+ 3 a))) - -(def! a (atom 2)) -;=>(atom 2) - -;;;(type a) -;;;;=>"atom" - -(deref a) -;=>2 - -@a -;=>2 - -(reset! a 3) -;=>3 - -@a -;=>3 - -(swap! a inc3) -;=>6 - -@a -;=>6 - -(swap! a (fn* (a) a)) -;=>6 - -(swap! a (fn* (a) (* 2 a))) -;=>12 - -(swap! a (fn* (a b) (* a b)) 10) -;=>120 - -(swap! a + 3) -;=>123 - -;; Testing swap!/closure interaction -(def! inc-it (fn* (a) (+ 1 a))) -(def! atm (atom 7)) -(def! f (fn* [] (swap! atm inc-it))) -(f) -;=>8 -(f) -;=>9 - -- cgit v1.2.3