From 4abbbe949e548a2d0490468451057c39389bacdf Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Tue, 28 Sep 2021 17:34:05 +0200 Subject: [PATCH] Implement suggestions from issue #587 in stepA of several languages * Merge eval-ast and eval into a single conditional. * Print "EVAL: $ast" at the top of EVAL. * Expand macros during the apply phase, removing lots of duplicate tests, and increasing the overall consistency by allowing the macro to be computed instead of referenced by name (`((defmacro! cond (...)))` is currently illegal for example). Each change was already applied by some implementations. With the two last changes, macroexpand and quasiquoteexpand special forms are not needed anymore. If macroexpand is kept: * an optional test should be added for `(macroexpand ())`, which currently fails on several implementations, * it should only apply one macro at a time. The purpose being debugging, hiding an iteration does not help. Moreover, the loop is currently untested (and probably wrong in nim). --- impls/ada.2/stepa_mal.adb | 37 +- impls/ada/stepa_mal.adb | 159 +++------ impls/awk/stepA_mal.awk | 159 ++++----- impls/bash/stepA_mal.sh | 93 ++--- impls/bbc-basic/stepA_mal.bas | 73 ++-- impls/c.2/stepA_mal.c | 193 +++-------- impls/c/stepA_mal.c | 70 ++-- impls/clojure/src/mal/stepA_mal.cljc | 66 ++-- impls/coffee/stepA_mal.coffee | 50 +-- impls/cpp/stepA_mal.cpp | 57 +--- impls/cs/stepA_mal.cs | 90 ++--- impls/d/stepA_mal.d | 95 ++---- impls/elisp/stepA_mal.el | 68 ++-- impls/elixir/lib/mix/tasks/stepA_mal.ex | 54 +-- impls/erlang/src/stepA_mal.erl | 69 ++-- impls/es6/stepA_mal.mjs | 40 +-- impls/factor/stepA_mal/stepA_mal.factor | 55 ++- impls/fsharp/stepA_mal.fs | 46 +-- impls/gnu-smalltalk/stepA_mal.st | 92 ++--- impls/go/src/stepA_mal/stepA_mal.go | 123 +++---- impls/groovy/stepA_mal.groovy | 57 +--- impls/guile/stepA_mal.scm | 47 +-- impls/haskell/stepA_mal.hs | 14 - impls/haxe/StepA_mal.hx | 69 ++-- impls/java/src/main/java/mal/stepA_mal.java | 97 ++---- impls/js/stepA_mal.js | 55 +-- impls/logo/stepA_mal.lg | 65 +--- impls/make/stepA_mal.mk | 69 ++-- impls/mal/stepA_mal.mal | 57 ++-- impls/miniMAL/stepA_mal.json | 59 +--- impls/nasm/stepA_mal.asm | 357 ++++++++------------ impls/nim/stepA_mal.nim | 123 +++---- impls/objpascal/stepA_mal.pas | 141 +++----- impls/ocaml/stepA_mal.ml | 46 +-- impls/perl/stepA_mal.pl | 63 +--- impls/perl6/stepA_mal.pl | 49 ++- impls/php/stepA_mal.php | 60 +--- impls/picolisp/stepA_mal.l | 52 +-- impls/pike/stepA_mal.pike | 54 +-- impls/prolog/stepA_mal.pl | 17 - impls/ps/stepA_mal.ps | Bin 9734 -> 8831 bytes impls/python/stepA_mal.py | 55 +-- impls/r/stepA_mal.r | 60 +--- impls/racket/stepA_mal.rkt | 50 +-- impls/ruby/stepA_mal.rb | 64 ++-- impls/rust/stepA_mal.rs | 142 +++----- impls/skew/stepA_mal.sk | 53 +-- impls/tcl/stepA_mal.tcl | 83 ++--- impls/tests/step7_quote.mal | 70 ---- impls/tests/step8_macros.mal | 18 - impls/ts/stepA_mal.ts | 81 +---- impls/vhdl/stepA_mal.vhdl | 136 ++++---- impls/vimscript/stepA_mal.vim | 88 ++--- process/guide.md | 126 ++++--- process/stepA_mal.txt | 65 ++-- 55 files changed, 1349 insertions(+), 2982 deletions(-) diff --git a/impls/ada.2/stepa_mal.adb b/impls/ada.2/stepa_mal.adb index 59a1ad7fd1..8695d2e768 100644 --- a/impls/ada.2/stepa_mal.adb +++ b/impls/ada.2/stepa_mal.adb @@ -60,7 +60,6 @@ procedure StepA_Mal is -- True when the environment has been created in this recursion -- level, and has not yet been referenced by a closure. If so, -- we can reuse it instead of creating a subenvironment. - Macroexpanding : Boolean := False; First : Types.T; begin <> @@ -184,14 +183,6 @@ procedure StepA_Mal is Ast => Ast.Sequence.all.Data (3), Env => Env)); end; - elsif First.Str.all = "macroexpand" then - Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); - Macroexpanding := True; - Ast := Ast.Sequence.all.Data (2); - goto Restart; - elsif First.Str.all = "quasiquoteexpand" then - Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); - return Quasiquote (Ast.Sequence.all.Data (2)); elsif First.Str.all = "quasiquote" then Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); Ast := Quasiquote (Ast.Sequence.all.Data (2)); @@ -248,24 +239,10 @@ procedure StepA_Mal is case First.Kind is when Kind_Macro => -- Use the unevaluated arguments. - if Macroexpanding then - -- Evaluate the macro with tail call optimization. - if not Env_Reusable then - Env := Envs.New_Env (Outer => First.Fn.all.Env); - Env_Reusable := True; - end if; - Env.all.Set_Binds - (Binds => First.Fn.all.Params.all.Data, - Exprs => Ast.Sequence.all.Data (2 .. Ast.Sequence.all.Length)); - Ast := First.Fn.all.Ast; - goto Restart; - else - -- Evaluate the macro normally. - Ast := First.Fn.all.Apply - (Ast.Sequence.all.Data (2 .. Ast.Sequence.all.Length)); - -- Then evaluate the result with TCO. - goto Restart; - end if; + Ast := First.Fn.all.Apply + (Ast.Sequence.all.Data (2 .. Ast.Sequence.all.Length)); + -- Then evaluate the result with TCO. + goto Restart; when Types.Kind_Function => null; when others => @@ -296,11 +273,7 @@ procedure StepA_Mal is end; exception when Err.Error => - if Macroexpanding then - Err.Add_Trace_Line ("macroexpand", Ast); - else - Err.Add_Trace_Line ("eval", Ast); - end if; + Err.Add_Trace_Line ("eval", Ast); raise; end Eval; diff --git a/impls/ada/stepa_mal.adb b/impls/ada/stepa_mal.adb index 454921dda1..2e214f48ab 100644 --- a/impls/ada/stepa_mal.adb +++ b/impls/ada/stepa_mal.adb @@ -55,54 +55,6 @@ procedure StepA_Mal is return Res; end Def_Macro; - - function Macro_Expand (Ast : Mal_Handle; Env : Envs.Env_Handle) - return Mal_Handle is - Res : Mal_Handle; - E : Envs.Env_Handle; - LMT : List_Mal_Type; - LP : Lambda_Ptr; - begin - - Res := Ast; - E := Env; - - loop - - if Deref (Res).Sym_Type /= List then - exit; - end if; - - LMT := Deref_List (Res).all; - - -- Get the macro in the list from the env - -- or return null if not applicable. - LP := Get_Macro (Res, E); - - exit when LP = null or else not LP.Get_Is_Macro; - - declare - Fn_List : Mal_Handle := Cdr (LMT); - Params : List_Mal_Type; - begin - E := Envs.New_Env (E); - - Params := Deref_List (LP.Get_Params).all; - if Envs.Bind (E, Params, Deref_List (Fn_List).all) then - - Res := Eval (LP.Get_Expr, E); - - end if; - - end; - - end loop; - - return Res; - - end Macro_Expand; - - function Eval_As_Boolean (MH : Mal_Handle) return Boolean is Res : Boolean; begin @@ -125,45 +77,6 @@ procedure StepA_Mal is end Eval_As_Boolean; - function Eval_Ast - (Ast : Mal_Handle; Env : Envs.Env_Handle) - return Mal_Handle is - - function Call_Eval (A : Mal_Handle) return Mal_Handle is - begin - return Eval (A, Env); - end Call_Eval; - - begin - - case Deref (Ast).Sym_Type is - - when Sym => - - declare - Sym : Mal_String := Deref_Sym (Ast).Get_Sym; - begin - -- if keyword, return it. Otherwise look it up in the environment. - if Sym(1) = ':' then - return Ast; - else - return Envs.Get (Env, Sym); - end if; - exception - when Envs.Not_Found => - raise Envs.Not_Found with ("'" & Sym & "' not found"); - end; - - when List => - - return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all); - - when others => return Ast; - - end case; - - end Eval_Ast; - function Starts_With (Ast : Mal_Handle; Symbol : String) return Boolean is A0 : Mal_Handle; begin @@ -273,6 +186,12 @@ procedure StepA_Mal is Env : Envs.Env_Handle; First_Param, Rest_Params : Mal_Handle; Rest_List, Param_List : List_Mal_Type; + + function Call_Eval (A : Mal_Handle) return Mal_Handle is + begin + return Eval (A, Env); + end Call_Eval; + begin Param := AParam; @@ -284,14 +203,30 @@ procedure StepA_Mal is Ada.Text_IO.Put_Line ("Evaling " & Deref (Param).To_String); end if; - Param := Macro_Expand (Param, Env); + case Deref (Param).Sym_Type is + when Sym => - if Debug then - Ada.Text_IO.Put_Line ("After expansion " & Deref (Param).To_String); - end if; + declare + Sym : Mal_String := Deref_Sym (Param).Get_Sym; + begin + -- if keyword, return it. Otherwise look it up in the environment. + if Sym(1) = ':' then + return Param; + else + return Envs.Get (Env, Sym); + end if; + exception + when Envs.Not_Found => + raise Envs.Not_Found with ("'" & Sym & "' not found"); + end; - if Deref (Param).Sym_Type = List and then - Deref_List (Param).Get_List_Type = List_List then + when List => + case Deref_List (Param).Get_List_Type is + when Hashed_List | Vector_List => + + return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Param).all); + + when List_List => Param_List := Deref_List (Param).all; @@ -310,9 +245,6 @@ procedure StepA_Mal is elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "defmacro!" then return Def_Macro (Rest_List, Env); - elsif Deref (First_Param).Sym_Type = Sym and then - Deref_Sym (First_Param).Get_Sym = "macroexpand" then - return Macro_Expand (Car (Rest_List), Env); elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "let*" then declare @@ -407,11 +339,6 @@ procedure StepA_Mal is return Car (Rest_List); - elsif Deref (First_Param).Sym_Type = Sym and then - Deref_Sym (First_Param).Get_Sym = "quasiquoteexpand" then - - return Quasi_Quote_Processing (Car (Rest_List)); - elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "quasiquote" then @@ -448,18 +375,11 @@ procedure StepA_Mal is else -- The APPLY section. - declare - Evaled_H : Mal_Handle; - begin - Evaled_H := Eval_Ast (Param, Env); - Param_List := Deref_List (Evaled_H).all; - - First_Param := Car (Param_List); - Rest_Params := Cdr (Param_List); - Rest_List := Deref_List (Rest_Params).all; + First_Param := Eval (First_Param, Env); if Deref (First_Param).Sym_Type = Func then + Rest_Params := Map (Call_Eval'Unrestricted_Access, Rest_List); return Call_Func (Deref_Func (First_Param).all, Rest_Params); elsif Deref (First_Param).Sym_Type = Lambda then declare @@ -472,6 +392,16 @@ procedure StepA_Mal is begin L := Deref_Lambda (First_Param).all; + + if L.Get_Is_Macro then + -- Apply to *unevaluated* arguments + Param := L.Apply (Rest_Params); + -- then EVAL the result. + goto Tail_Call_Opt; + end if; + + Rest_Params := Map (Call_Eval'Unrestricted_Access, Rest_List); + E := Envs.New_Env (L.Get_Env); Param_Names := Deref_List (L.Get_Params).all; @@ -495,15 +425,14 @@ procedure StepA_Mal is raise Runtime_Exception with "Deref called on non-Func/Lambda"; end if; - end; - end if; - else -- not a List_List + end case; + when others => -- not a list, map, symbol or vector - return Eval_Ast (Param, Env); + return Param; - end if; + end case; end Eval; diff --git a/impls/awk/stepA_mal.awk b/impls/awk/stepA_mal.awk index 5399b26b18..9393f969a1 100644 --- a/impls/awk/stepA_mal.awk +++ b/impls/awk/stepA_mal.awk @@ -88,52 +88,21 @@ function quasiquote(ast, new_idx, ret, ast_idx, elt_i, elt, previous) return "(" new_idx } -function is_macro_call(ast, env, idx, len, sym, f) -{ - if (ast !~ /^\(/) return 0 - idx = substr(ast, 2) - len = types_heap[idx]["len"] - if (len == 0) return 0 - sym = types_heap[idx][0] - if (sym !~ /^'/) return 0 - f = env_get(env, sym) - return f ~ /^\$/ && types_heap[substr(f, 2)]["is_macro"] -} - -function macroexpand(ast, env, idx, f_idx, new_env) -{ - while (is_macro_call(ast, env)) { - idx = substr(ast, 2) - f_idx = substr(env_get(env, types_heap[idx][0]), 2) - new_env = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], idx) - types_release(ast) - if (new_env ~ /^!/) { - return new_env - } - types_addref(ast = types_heap[f_idx]["body"]) - ast = EVAL(ast, new_env) - env_release(new_env) - if (ast ~ /^!/) { - return ast - } - } - return ast -} - function eval_ast(ast, env, i, idx, len, new_idx, ret) +# This function has two distinct purposes. +# non empty list: a0 a1 .. an -> list: nil (eval a1) .. (eval an) +# vector: a0 a1 .. an -> vector: (eval a0) (eval a1) .. (eval an) { - switch (ast) { - case /^'/: - ret = env_get(env, ast) - if (ret !~ /^!/) { - types_addref(ret) - } - return ret - case /^[([]/: idx = substr(ast, 2) len = types_heap[idx]["len"] new_idx = types_allocate() - for (i = 0; i < len; ++i) { + if (ast ~ /^\(/) { + types_heap[new_idx][0] = "#nil" + i = 1 + } else { + i = 0 + } + for (; i < len; ++i) { ret = EVAL(types_addref(types_heap[idx][i]), env) if (ret ~ /^!/) { types_heap[new_idx]["len"] = i @@ -144,7 +113,10 @@ function eval_ast(ast, env, i, idx, len, new_idx, ret) } types_heap[new_idx]["len"] = len return substr(ast, 1, 1) new_idx - case /^\{/: +} + +function eval_map(ast, env, i, idx, new_idx, ret) +{ idx = substr(ast, 2) new_idx = types_allocate() for (i in types_heap[idx]) { @@ -158,9 +130,6 @@ function eval_ast(ast, env, i, idx, len, new_idx, ret) } } return "{" new_idx - default: - return ast - } } function EVAL_def(ast, env, idx, sym, ret, len) @@ -416,29 +385,37 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret { env_addref(env) for (;;) { - if (ast !~ /^\(/) { - ret = eval_ast(ast, env) + # print "EVAL: " printer_pr_str(substr(ast, 2)) + switch (ast) { + case /^'/: # symbol + ret = env_get(env, ast) + if (ret !~ /^!/) { + types_addref(ret) + } types_release(ast) env_release(env) return ret - } - if (types_heap[substr(ast, 2)]["len"] == 0) { - env_release(env) - return ast - } - ast = macroexpand(ast, env) - if (ast ~ /^!/) { - env_release(env) - return ast - } - if (ast !~ /^\(/) { + case /^\[/: # vector ret = eval_ast(ast, env) types_release(ast) env_release(env) return ret + case /^\{/: # map + ret = eval_map(ast, env) + types_release(ast) + env_release(env) + return ret + case /^[^(]/: # not a list + types_release(ast) + env_release(env) + return ast } idx = substr(ast, 2) len = types_heap[idx]["len"] + if (len == 0) { + env_release(env) + return ast + } switch (types_heap[idx][0]) { case "'def!": return EVAL_def(ast, env) @@ -459,15 +436,6 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret types_release(ast) env_release(env) return body - case "'quasiquoteexpand": - env_release(env) - if (len != 2) { - types_release(ast) - return "!\"Invalid argument length for 'quasiquoteexpand'. Expects exactly 1 argument, supplied " (len - 1) "." - } - types_addref(body = types_heap[idx][1]) - types_release(ast) - return quasiquote(body) case "'quasiquote": if (len != 2) { types_release(ast) @@ -484,17 +452,6 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret continue case "'defmacro!": return EVAL_defmacro(ast, env) - case "'macroexpand": - if (len != 2) { - types_release(ast) - env_release(env) - return "!\"Invalid argument length for 'macroexpand'. Expects exactly 1 argument, supplied " (len - 1) "." - } - types_addref(body = types_heap[idx][1]) - types_release(ast) - ret = macroexpand(body, env) - env_release(env) - return ret case "'try*": ret = EVAL_try(ast, env, ret_body, ret_env) if (ret != "") { @@ -519,34 +476,64 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret case "'fn*": return EVAL_fn(ast, env) default: - new_ast = eval_ast(ast, env) - types_release(ast) - env_release(env) - if (new_ast ~ /^!/) { - return new_ast + f = EVAL(types_addref(types_heap[idx][0]), env) + if (f ~ /^!/) { + types_release(ast) + env_release(env) + return f } - idx = substr(new_ast, 2) - f = types_heap[idx][0] f_idx = substr(f, 2) switch (f) { case /^\$/: + if (types_heap[f_idx]["is_macro"]) { + idx = substr(ast, 2) + ret = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], idx) + types_release(ast) + if (ret ~ /^!/) { + types_release(f) + types_release(env) + return ret + } + ast = EVAL(types_addref(types_heap[f_idx]["body"]), ret) + types_release(ret) + types_release(f) + continue + } + new_ast = eval_ast(ast, env) + types_release(ast) + env_release(env) + if (new_ast ~ /^!/) { + return new_ast + } + idx = substr(new_ast, 2) env = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], idx) if (env ~ /^!/) { types_release(new_ast) return env } types_addref(ast = types_heap[f_idx]["body"]) + types_release(f) types_release(new_ast) continue case /^%/: f_idx = types_heap[f_idx]["func"] + types_release(f) case /^&/: + new_ast = eval_ast(ast, env) + types_release(ast) + env_release(env) + if (new_ast ~ /^!/) { + return new_ast + } + idx = substr(new_ast, 2) ret = @f_idx(idx) types_release(new_ast) return ret default: types_release(new_ast) - return "!\"First element of list must be function, supplied " types_typename(f) "." + ret = "!\"First element of list must be function, supplied " types_typename(f) "." + types_release(f) + return ret } } } diff --git a/impls/bash/stepA_mal.sh b/impls/bash/stepA_mal.sh index d404833615..ef1664efa9 100755 --- a/impls/bash/stepA_mal.sh +++ b/impls/bash/stepA_mal.sh @@ -55,45 +55,22 @@ qqIter () { fi } -IS_MACRO_CALL () { - if ! _list? "${1}"; then return 1; fi - _nth "${1}" 0; local a0="${r}" - if _symbol? "${a0}"; then - ENV_FIND "${2}" "${a0}" - if [[ "${r}" ]]; then - ENV_GET "${2}" "${a0}" - [ "${ANON["${r}_ismacro_"]}" ] - return $? - fi - fi - return 1 -} - -MACROEXPAND () { +EVAL () { local ast="${1}" env="${2}" - while IS_MACRO_CALL "${ast}" "${env}"; do - _nth "${ast}" 0; local a0="${r}" - ENV_GET "${env}" "${a0}"; local mac="${ANON["${r}"]}" - _rest "${ast}" - ${mac%%@*} ${ANON["${r}"]} - ast="${r}" - done - r="${ast}" -} - + while true; do + r= + #_pr_str "${ast}"; echo "EVAL '${r} / ${env}'" -EVAL_AST () { - local ast="${1}" env="${2}" - #_pr_str "${ast}"; echo "EVAL_AST '${ast}:${r} / ${env}'" _obj_type "${ast}"; local ot="${r}" case "${ot}" in symbol) ENV_GET "${env}" "${ast}" return ;; list) - _map_with_type _list EVAL "${ast}" "${env}" ;; + ;; vector) - _map_with_type _vector EVAL "${ast}" "${env}" ;; + _map_with_type _vector EVAL "${ast}" "${env}" + return ;; hash_map) local res="" key= val="" hm="${ANON["${ast}"]}" _hash_map; local new_hm="${r}" @@ -103,30 +80,14 @@ EVAL_AST () { EVAL "${val}" "${env}" _assoc! "${new_hm}" "${key}" "${r}" done - r="${new_hm}" ;; + r="${new_hm}" + return ;; *) - r="${ast}" ;; + r="${ast}" + return ;; esac -} - -EVAL () { - local ast="${1}" env="${2}" - while true; do - r= - [[ "${__ERROR}" ]] && return 1 - #_pr_str "${ast}"; echo "EVAL '${r} / ${env}'" - if ! _list? "${ast}"; then - EVAL_AST "${ast}" "${env}" - return - fi # apply list - MACROEXPAND "${ast}" "${env}" - ast="${r}" - if ! _list? "${ast}"; then - EVAL_AST "${ast}" "${env}" - return - fi _empty? "${ast}" && r="${ast}" && return _nth "${ast}" 0; local a0="${r}" @@ -153,9 +114,6 @@ EVAL () { quote) r="${a1}" return ;; - quasiquoteexpand) - QUASIQUOTE "${a1}" - return ;; quasiquote) QUASIQUOTE "${a1}" ast="${r}" @@ -167,9 +125,6 @@ EVAL () { ANON["${r}_ismacro_"]="yes" ENV_SET "${env}" "${a1}" "${r}" return ;; - macroexpand) - MACROEXPAND "${a1}" "${env}" - return ;; sh__STAR__) EVAL "${a1}" "${env}" local output="" local line="" @@ -195,7 +150,7 @@ EVAL () { return ;; do) _count "${ast}" _slice "${ast}" 1 $(( ${r} - 2 )) - EVAL_AST "${r}" "${env}" + _map_with_type _list EVAL "${r}" "${env}" [[ "${__ERROR}" ]] && r= && return 1 _last "${ast}" ast="${r}" @@ -222,11 +177,27 @@ EVAL () { EVAL \"${a2}\" \"\${r}\"" \ "${a2}" "${env}" "${a1}" return ;; - *) EVAL_AST "${ast}" "${env}" + *) EVAL "${a0}" "${env}" + [[ "${__ERROR}" ]] && return 1 + local f="${r}" + + _rest "${ast}" + # Should cause no error as ast is not empty. + local args="${r}" + + if [ "${ANON["${f}_ismacro_"]}" ]; then + f="${ANON["${f}"]}" + ${f%%@*} ${ANON["${args}"]} + ast="${r}" + continue + fi + + f="${ANON["${f}"]}" + + _map_with_type _list EVAL "${args}" "${env}" [[ "${__ERROR}" ]] && r= && return 1 - local el="${r}" - _first "${el}"; local f="${ANON["${r}"]}" - _rest "${el}"; local args="${ANON["${r}"]}" + args="${ANON["${r}"]}" + #echo "invoke: [${f}] ${args}" if [[ "${f//@/ }" != "${f}" ]]; then set -- ${f//@/ } diff --git a/impls/bbc-basic/stepA_mal.bas b/impls/bbc-basic/stepA_mal.bas index 2ca19477fb..b4f27a3db3 100644 --- a/impls/bbc-basic/stepA_mal.bas +++ b/impls/bbc-basic/stepA_mal.bas @@ -84,27 +84,6 @@ DEF FNquasiquote(ast%) ENDIF =ast% -DEF FNis_macro_call(ast%, env%) - LOCAL car%, val% - IF NOT FNis_list(ast%) THEN =FALSE - car% = FNfirst(ast%) - IF NOT FNis_symbol(car%) THEN =FALSE - IF FNis_nil(FNenv_find(env%, car%)) THEN =FALSE - val% = FNenv_get(env%, car%) -=FNis_macro(val%) - -DEF FNmacroexpand(ast%, env%) - LOCAL mac%, macenv%, macast% - WHILE FNis_macro_call(ast%, env%) - REM PRINT "expanded ";FNpr_str(ast%, TRUE); - mac% = FNenv_get(env%, FNfirst(ast%)) - macenv% = FNnew_env(FNfn_env(mac%), FNfn_params(mac%), FNrest(ast%)) - macast% = FNfn_ast(mac%) - ast% = FNEVAL(macast%, macenv%) - REM PRINT " to ";FNpr_str(ast%, TRUE) - ENDWHILE -=ast% - DEF FNtry_catch(ast%, env%) LOCAL is_error%, ret% REM If there's no 'catch*' clause then we just evaluate the 'try*'. @@ -152,14 +131,25 @@ DEF FNEVAL(ast%, env%) =FNgc_exit(FNEVAL_(ast%, env%)) DEF FNEVAL_(ast%, env%) - LOCAL car%, specialform%, val%, bindings% + LOCAL car%, specialform%, val%, bindings%, key$ REPEAT PROCgc_keep_only2(ast%, env%) - IF NOT FNis_list(ast%) THEN =FNeval_ast(ast%, env%) + REM PRINT "EVAL: " + FNPRINT(ast%) + IF FNis_symbol(ast%) THEN =FNenv_get(env%, ast%) + IF FNis_hashmap(ast%) THEN + val% = FNempty_hashmap + bindings% = FNhashmap_keys(ast%) + WHILE NOT FNis_empty(bindings%) + key$ = FNunbox_string(FNfirst(bindings%)) + val% = FNhashmap_set(val%, key$, FNEVAL(FNhashmap_get(ast%, key$), env%)) + bindings% = FNrest(bindings%) + ENDWHILE + =val% + ENDIF + IF NOT FNis_seq(ast%) THEN =ast% IF FNis_empty(ast%) THEN =ast% - ast% = FNmacroexpand(ast%, env%) - IF NOT FNis_list(ast%) THEN =FNeval_ast(ast%, env%) car% = FNfirst(ast%) + IF FNis_vector(ast%) THEN =FNalloc_vector_pair(FNEVAL(car%, env%), FNeval_ast(FNrest(ast%), env%)) specialform% = FALSE IF FNis_symbol(car%) THEN specialform% = TRUE @@ -205,13 +195,9 @@ DEF FNEVAL_(ast%, env%) =FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%) WHEN "quote" =FNnth(ast%, 1) - WHEN "quasiquoteexpand" - = FNquasiquote(FNnth(ast%, 1)) WHEN "quasiquote" ast% = FNquasiquote(FNnth(ast%, 1)) REM Loop round for tail-call optimisation - WHEN "macroexpand" - =FNmacroexpand(FNnth(ast%, 1), env%) WHEN "try*" =FNtry_catch(ast%, env%) OTHERWISE @@ -220,18 +206,24 @@ DEF FNEVAL_(ast%, env%) ENDIF IF NOT specialform% THEN REM This is the "apply" part. + car% = FNEVAL(car%, env%) + ast% = FNrest(ast%) + IF FNis_macro(car%) THEN + ast% = FNEVAL(FNfn_ast(car%), FNnew_env(FNfn_env(car%), FNfn_params(car%), ast%)) + REM Loop round for tail-call optimisation. + ELSE ast% = FNeval_ast(ast%, env%) - car% = FNfirst(ast%) IF FNis_corefn(car%) THEN - =FNcore_call(FNunbox_corefn(car%), FNrest(ast%)) + =FNcore_call(FNunbox_corefn(car%), ast%) ENDIF IF FNis_fn(car%) THEN - env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), FNrest(ast%)) + env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), ast%) ast% = FNfn_ast(car%) REM Loop round for tail-call optimisation. ELSE ERROR &40E80918, "Not a function" ENDIF + ENDIF ENDIF UNTIL FALSE @@ -242,26 +234,11 @@ DEF FNrep(a$) =FNPRINT(FNEVAL(FNREAD(a$), repl_env%)) DEF FNeval_ast(ast%, env%) - LOCAL val%, car%, cdr%, map%, keys%, key$ - IF FNis_symbol(ast%) THEN =FNenv_get(env%, ast%) - IF FNis_seq(ast%) THEN + LOCAL car%, cdr% IF FNis_empty(ast%) THEN =ast% car% = FNEVAL(FNfirst(ast%), env%) cdr% = FNeval_ast(FNrest(ast%), env%) - IF FNis_vector(ast%) THEN =FNalloc_vector_pair(car%, cdr%) =FNalloc_pair(car%, cdr%) - ENDIF - IF FNis_hashmap(ast%) THEN - map% = FNempty_hashmap - keys% = FNhashmap_keys(ast%) - WHILE NOT FNis_empty(keys%) - key$ = FNunbox_string(FNfirst(keys%)) - map% = FNhashmap_set(map%, key$, FNEVAL(FNhashmap_get(ast%, key$), env%)) - keys% = FNrest(keys%) - ENDWHILE - =map% - ENDIF -=ast% DEF FNget_argv PROCgc_enter diff --git a/impls/c.2/stepA_mal.c b/impls/c.2/stepA_mal.c index 8cd1a51d3d..2a9a621521 100644 --- a/impls/c.2/stepA_mal.c +++ b/impls/c.2/stepA_mal.c @@ -20,11 +20,9 @@ #define SYMBOL_FNSTAR "fn*" #define SYMBOL_QUOTE "quote" #define SYMBOL_QUASIQUOTE "quasiquote" -#define SYMBOL_QUASIQUOTEEXPAND "quasiquoteexpand" #define SYMBOL_UNQUOTE "unquote" #define SYMBOL_SPLICE_UNQUOTE "splice-unquote" #define SYMBOL_DEFMACROBANG "defmacro!" -#define SYMBOL_MACROEXPAND "macroexpand" #define SYMBOL_TRYSTAR "try*" #define SYMBOL_CATCHSTAR "catch*" @@ -38,7 +36,10 @@ MalType* READ(char* str) { MalType* EVAL(MalType* ast, Env* env) { /* forward references */ - MalType* eval_ast(MalType* ast, Env* env); + MalType* apply(MalType* fn, list args); + list evaluate_list(list lst, Env* env); + list evaluate_vector(list lst, Env* env); + list evaluate_hashmap(list lst, Env* env); MalType* eval_defbang(MalType* ast, Env** env); void eval_letstar(MalType** ast, Env** env); void eval_if(MalType** ast, Env** env); @@ -46,30 +47,44 @@ MalType* EVAL(MalType* ast, Env* env) { MalType* eval_do(MalType* ast, Env* env); MalType* eval_quote(MalType* ast); MalType* eval_quasiquote(MalType* ast); - MalType* eval_quasiquoteexpand(MalType* ast); MalType* eval_defmacrobang(MalType*, Env** env); - MalType* eval_macroexpand(MalType* ast, Env* env); - MalType* macroexpand(MalType* ast, Env* env); void eval_try(MalType** ast, Env** env); /* Use goto to jump here rather than calling eval for tail-call elimination */ TCE_entry_point: - /* NULL */ - if (!ast) { return make_nil(); } + /* printf("EVAL: "); */ + /* PRINT(ast); */ + + if (is_symbol(ast)) { + MalType* symbol_value = env_get(env, ast); + if (!symbol_value) + return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY)); + return symbol_value; + } + + if (is_vector(ast)) { + list result = evaluate_vector(ast->value.mal_list, env); + if (result && is_error(result->data)) return result->data; + return make_vector(result); + } - /* macroexpansion */ - ast = macroexpand(ast, env); - if (is_error(ast)) { return ast; } + if (is_hashmap(ast)) { + list result = evaluate_hashmap(ast->value.mal_list, env); + if (result && is_error(result->data)) return result->data; + return make_hashmap(result); + } /* not a list */ - if (!is_list(ast)) { return eval_ast(ast, env); } + if (!is_list(ast)) { return ast; } + + list lst = ast->value.mal_list; /* empty list */ - if (ast->value.mal_list == NULL) { return ast; } + if (lst == NULL) { return ast; } /* list */ - MalType* first = (ast->value.mal_list)->data; + MalType* first = lst->data; char* symbol = first->value.mal_symbol; if (is_symbol(first)) { @@ -115,17 +130,9 @@ MalType* EVAL(MalType* ast, Env* env) { if (is_error(ast)) { return ast; } goto TCE_entry_point; } - else if (strcmp(symbol, SYMBOL_QUASIQUOTEEXPAND) == 0) { - - list lst = ast->value.mal_list; - return eval_quasiquote(make_list(lst)); - } else if (strcmp(symbol, SYMBOL_DEFMACROBANG) == 0) { return eval_defmacrobang(ast, &env); } - else if (strcmp(symbol, SYMBOL_MACROEXPAND) == 0) { - return eval_macroexpand(ast, env); - } else if (strcmp(symbol, SYMBOL_TRYSTAR) == 0) { /* TCE - modify ast and env directly and jump back to eval */ @@ -136,16 +143,23 @@ MalType* EVAL(MalType* ast, Env* env) { } } /* first element is not a special symbol */ - MalType* evaluated_list = eval_ast(ast, env); + MalType* func = EVAL(first, env); + if (is_error(func)) { return func; } + + lst = lst->next; - if (is_error(evaluated_list)) { return evaluated_list; } + if (func->is_macro) { + ast = apply(func, lst); + if (is_error(ast)) { return ast; } + goto TCE_entry_point; + } + list evlst = evaluate_list(lst, env); + if (evlst && is_error(evlst->data)) { return evlst->data; } /* apply the first element of the list to the arguments */ - list evlst = evaluated_list->value.mal_list; - MalType* func = evlst->data; if (is_function(func)) { - return (*func->value.mal_function)(evlst->next); + return (*func->value.mal_function)(evlst); } else if (is_closure(func)) { @@ -153,7 +167,7 @@ MalType* EVAL(MalType* ast, Env* env) { list params = (closure->parameters)->value.mal_list; long param_count = list_count(params); - long arg_count = list_count(evlst->next); + long arg_count = list_count(evlst); if (param_count > arg_count) { return make_error("too few arguments supplied to function"); @@ -164,7 +178,7 @@ MalType* EVAL(MalType* ast, Env* env) { else { /* TCE - modify ast and env directly and jump back to eval */ - env = env_make(closure->env, params, evlst->next, closure->more_symbol); + env = env_make(closure->env, params, evlst, closure->more_symbol); ast = func->value.mal_closure->definition; if (is_error(ast)) { return ast; } @@ -293,58 +307,6 @@ int main(int argc, char** argv) { return 0; } -MalType* eval_ast(MalType* ast, Env* env) { - - /* forward references */ - list evaluate_list(list lst, Env* env); - list evaluate_vector(list lst, Env* env); - list evaluate_hashmap(list lst, Env* env); - - if (is_symbol(ast)) { - - MalType* symbol_value = env_get(env, ast); - - if (symbol_value) { - return symbol_value; - } else { - return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY)); - } - } - else if (is_list(ast)) { - - list result = evaluate_list(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_list(result); - } else { - return result->data; - } - } - else if (is_vector(ast)) { - - list result = evaluate_vector(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_vector(result); - } else { - return result->data; - } - } - else if (is_hashmap(ast)) { - - list result = evaluate_hashmap(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_hashmap(result); - } else { - return result->data; - } - } - else { - return ast; - } -} - MalType* eval_defbang(MalType* ast, Env** env) { list lst = (ast->value.mal_list)->next; @@ -709,46 +671,6 @@ MalType* eval_defmacrobang(MalType* ast, Env** env) { return result; } -MalType* eval_macroexpand(MalType* ast, Env* env) { - - /* forward reference */ - MalType* macroexpand(MalType* ast, Env* env); - - list lst = ast->value.mal_list; - - if (!lst->next) { - return make_nil(); - } - else if (lst->next->next) { - return make_error("'macroexpand': expected exactly one argument"); - } - else { - return macroexpand(lst->next->data, env); - } -} - -MalType* macroexpand(MalType* ast, Env* env) { - - /* forward reference */ - int is_macro_call(MalType* ast, Env* env); - - while(is_macro_call(ast, env)) { - - list lst = ast->value.mal_list; - - MalType* macro_fn = env_get(env, lst->data); - MalClosure* cls = macro_fn->value.mal_closure; - MalType* more_symbol = cls->more_symbol; - - list params_list = (cls->parameters)->value.mal_list; - list args_list = lst->next; - - env = env_make(cls->env, params_list, args_list, more_symbol); - ast = EVAL(cls->definition, env); - } - return ast; -} - void eval_try(MalType** ast, Env** env) { list lst = (*ast)->value.mal_list; @@ -961,32 +883,3 @@ MalType* apply(MalType* fn, list args) { } } } - -int is_macro_call(MalType* ast, Env* env) { - - /* not a list */ - if (!is_list(ast)) { - return 0; - } - - /* empty list */ - list lst = ast->value.mal_list; - if (!lst) { - return 0; - } - - /* first item not a symbol */ - MalType* first = lst->data; - if (!is_symbol(first)) { - return 0; - } - - /* lookup symbol */ - MalType* val = env_get(env, first); - if (is_error(val)) { - return 0; - } - else { - return (val->is_macro); - } -} diff --git a/impls/c/stepA_mal.c b/impls/c/stepA_mal.c index 75051170f3..2b905726ef 100644 --- a/impls/c/stepA_mal.c +++ b/impls/c/stepA_mal.c @@ -12,7 +12,6 @@ // Declarations MalVal *EVAL(MalVal *ast, Env *env); MalVal *quasiquote(MalVal *ast); -MalVal *macroexpand(MalVal *ast, Env *env); // read MalVal *READ(char prompt[], char *str) { @@ -70,31 +69,18 @@ MalVal *quasiquote(MalVal *ast) { } } -int is_macro_call(MalVal *ast, Env *env) { - if (!ast || ast->type != MAL_LIST || _count(ast) == 0) { return 0; } - MalVal *a0 = _nth(ast, 0); - return (a0->type & MAL_SYMBOL) && - env_find(env, a0) && - env_get(env, a0)->ismacro; -} +MalVal *EVAL(MalVal *ast, Env *env) { + while (TRUE) { -MalVal *macroexpand(MalVal *ast, Env *env) { if (!ast || mal_error) return NULL; - while (is_macro_call(ast, env)) { - MalVal *a0 = _nth(ast, 0); - MalVal *mac = env_get(env, a0); - // TODO: this is weird and limits it to 20. FIXME - ast = _apply(mac, _rest(ast)); - } - return ast; -} + //g_print("EVAL: %s\n", _pr_str(ast,1)); -MalVal *eval_ast(MalVal *ast, Env *env) { - if (!ast || mal_error) return NULL; if (ast->type == MAL_SYMBOL) { //g_print("EVAL symbol: %s\n", ast->val.string); return env_get(env, ast); - } else if ((ast->type == MAL_LIST) || (ast->type == MAL_VECTOR)) { + } else if (ast->type == MAL_LIST) { + // Proceed after this conditional. + } else if (ast->type == MAL_VECTOR) { //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); if (!el || mal_error) return NULL; @@ -119,25 +105,8 @@ MalVal *eval_ast(MalVal *ast, Env *env) { //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); return ast; } -} - -MalVal *EVAL(MalVal *ast, Env *env) { - while (TRUE) { - - if (!ast || mal_error) return NULL; - //g_print("EVAL: %s\n", _pr_str(ast,1)); - if (ast->type != MAL_LIST) { - return eval_ast(ast, env); - } - if (!ast || mal_error) return NULL; // apply list - //g_print("EVAL apply list: %s\n", _pr_str(ast,1)); - ast = macroexpand(ast, env); - if (!ast || mal_error) return NULL; - if (ast->type != MAL_LIST) { - return eval_ast(ast, env); - } if (_count(ast) == 0) { return ast; } int i, len; @@ -175,9 +144,6 @@ MalVal *EVAL(MalVal *ast, Env *env) { strcmp("quote", a0->val.string) == 0) { //g_print("eval apply quote\n"); return _nth(ast, 1); - } else if ((a0->type & MAL_SYMBOL) && - strcmp("quasiquoteexpand", a0->val.string) == 0) { - return quasiquote(_nth(ast, 1)); } else if ((a0->type & MAL_SYMBOL) && strcmp("quasiquote", a0->val.string) == 0) { //g_print("eval apply quasiquote\n"); @@ -194,15 +160,11 @@ MalVal *EVAL(MalVal *ast, Env *env) { res->ismacro = TRUE; env_set(env, a1, res); return res; - } else if ((a0->type & MAL_SYMBOL) && - strcmp("macroexpand", a0->val.string) == 0) { - //g_print("eval apply macroexpand\n"); - MalVal *a1 = _nth(ast, 1); - return macroexpand(a1, env); } else if ((a0->type & MAL_SYMBOL) && strcmp(".", a0->val.string) == 0) { //g_print("eval apply .\n"); - MalVal *el = eval_ast(_slice(ast, 1, _count(ast)), env); + MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, _slice(ast, 1, _count(ast)), env); + if (!el || mal_error) return NULL; return invoke_native(el); } else if ((a0->type & MAL_SYMBOL) && strcmp("try*", a0->val.string) == 0) { @@ -231,7 +193,8 @@ MalVal *EVAL(MalVal *ast, Env *env) { } else if ((a0->type & MAL_SYMBOL) && strcmp("do", a0->val.string) == 0) { //g_print("eval apply do\n"); - eval_ast(_slice(ast, 1, _count(ast)-1), env); + MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, _slice(ast, 1, _count(ast) - 1), env); + if (!el || mal_error) return NULL; ast = _last(ast); // Continue loop } else if ((a0->type & MAL_SYMBOL) && @@ -264,10 +227,15 @@ MalVal *EVAL(MalVal *ast, Env *env) { return mf; } else { //g_print("eval apply\n"); - MalVal *el = eval_ast(ast, env); - if (!el || mal_error) { return NULL; } - MalVal *f = _first(el), - *args = _rest(el); + MalVal *f = EVAL(a0, env); + if (!f || mal_error) { return NULL; } + MalVal *rest = _slice(ast, 1, _count(ast)); + if (f->ismacro) { + ast = _apply(f, rest); + continue; + } + MalVal *args = _map2((MalVal *(*)(void*, void*))EVAL, rest, env); + if (!args || mal_error) { return NULL; } assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, "cannot apply '%s'", _pr_str(f,1)); if (f->type & MAL_FUNCTION_MAL) { diff --git a/impls/clojure/src/mal/stepA_mal.cljc b/impls/clojure/src/mal/stepA_mal.cljc index d6203ef4e8..8eb0628b90 100644 --- a/impls/clojure/src/mal/stepA_mal.cljc +++ b/impls/clojure/src/mal/stepA_mal.cljc @@ -1,5 +1,4 @@ (ns mal.stepA-mal - (:refer-clojure :exclude [macroexpand]) (:require [mal.readline :as readline] #?(:clj [clojure.repl]) [mal.reader :as reader] @@ -34,45 +33,22 @@ (or (symbol? ast) (map? ast)) (list 'quote ast) :else ast)) -(defn is-macro-call [ast env] - (and (seq? ast) - (symbol? (first ast)) - (env/env-find env (first ast)) - (:ismacro (meta (env/env-get env (first ast)))))) - -(defn macroexpand [ast env] - (loop [ast ast] - (if (is-macro-call ast env) - ;; Get original unadorned function because ClojureScript (1.10) - ;; limits functions with meta on them to arity 20 - (let [mac (:orig (meta (env/env-get env (first ast))))] - (recur (apply mac (rest ast)))) - ast))) - -(defn eval-ast [ast env] - (cond - (symbol? ast) (env/env-get env ast) - - (seq? ast) (doall (map #(EVAL % env) ast)) - - (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) + (cond + (symbol? ast) + (env/env-get env ast) + (vector? ast) + (vec (map #(EVAL % env) ast)) + + (map? ast) + (apply hash-map (map #(EVAL % env) (mapcat identity ast))) + + (seq? ast) ;; apply list - (let [ast (macroexpand ast env)] - (if (not (seq? ast)) - (eval-ast ast env) (let [[a0 a1 a2 a3] ast] (condp = a0 @@ -91,9 +67,6 @@ 'quote a1 - 'quasiquoteexpand - (quasiquote a1) - 'quasiquote (recur (quasiquote a1) env) @@ -105,9 +78,6 @@ :ismacro true})] (env/env-set env a1 mac)) - 'macroexpand - (macroexpand a1 env) - 'clj* #?(:clj (eval (reader/read-string a1)) :cljs (throw (ex-info "clj* unsupported in ClojureScript mode" {}))) @@ -134,7 +104,7 @@ (EVAL a1 env)) 'do - (do (eval-ast (->> ast (drop-last) (drop 1)) env) + (do (doall (map #(EVAL % env) (->> ast (drop-last) (drop 1)))) (recur (last ast) env)) 'if @@ -158,13 +128,19 @@ :parameters a1})) ;; apply - (let [el (eval-ast ast env) - f (first el) - args (rest el) + (let [f (EVAL a0 env) + unevaluated_args (rest ast)] + (if (:ismacro (meta f)) + (recur (apply (:orig (meta f)) unevaluated_args) env) + (let [args (map #(EVAL % env) unevaluated_args) {:keys [expression environment parameters]} (meta f)] (if expression (recur expression (env/env environment parameters args)) - (apply f args)))))))))) + (apply f args))))))) + + :else ;; not a list, map, symbol or vector + ast))) + ;; print (defn PRINT [exp] (printer/pr-str exp)) diff --git a/impls/coffee/stepA_mal.coffee b/impls/coffee/stepA_mal.coffee index fde4bf77d9..9d8f2e4eae 100644 --- a/impls/coffee/stepA_mal.coffee +++ b/impls/coffee/stepA_mal.coffee @@ -23,36 +23,21 @@ quasiquote = (ast) -> else if types._symbol_Q(ast) || types._hash_map_Q(ast) then [types._symbol('quote'), ast] else ast -is_macro_call = (ast, env) -> - return types._list_Q(ast) && types._symbol_Q(ast[0]) && - env.find(ast[0]) && env.get(ast[0]).__ismacro__ - -macroexpand = (ast, env) -> - while is_macro_call(ast, env) - ast = env.get(ast[0])(ast[1..]...) - ast - - - -eval_ast = (ast, env) -> - if types._symbol_Q(ast) then env.get ast - else if types._list_Q(ast) then ast.map((a) -> EVAL(a, env)) - else if types._vector_Q(ast) - types._vector(ast.map((a) -> EVAL(a, env))...) - else if types._hash_map_Q(ast) - new_hm = {} - new_hm[k] = EVAL(ast[k],env) for k,v of ast - new_hm - else ast - EVAL = (ast, env) -> loop #console.log "EVAL:", printer._pr_str ast - if !types._list_Q ast then return eval_ast ast, env + if types._symbol_Q(ast) + return env.get ast + else if types._vector_Q(ast) + return types._vector(ast.map((a) -> EVAL(a, env))...) + else if types._hash_map_Q(ast) + new_hm = {} + new_hm[k] = EVAL(v, env) for k,v of ast + return new_hm + else if !types._list_Q(ast) + return ast # apply list - ast = macroexpand ast, env - if !types._list_Q ast then return eval_ast ast, env if ast.length == 0 then return ast [a0, a1, a2, a3] = ast @@ -67,16 +52,12 @@ EVAL = (ast, env) -> env = let_env when "quote" return a1 - when "quasiquoteexpand" - return quasiquote(a1) when "quasiquote" ast = quasiquote(a1) when "defmacro!" f = EVAL(a2, env) f.__ismacro__ = true return env.set(a1, f) - when "macroexpand" - return macroexpand(a1, env) when "try*" try return EVAL(a1, env) catch exc @@ -90,10 +71,10 @@ EVAL = (ast, env) -> res = eval(a1.toString()) return if typeof(res) == 'undefined' then null else res when "." - el = eval_ast(ast[2..], env) + el = ast[2..].map((a) -> EVAL(a, env)) return eval(a1.toString())(el...) when "do" - eval_ast(ast[1..-2], env) + ast[1..-2].map((a) -> EVAL(a, env)) ast = ast[ast.length-1] when "if" cond = EVAL(a1, env) @@ -104,14 +85,17 @@ EVAL = (ast, env) -> when "fn*" return types._function(EVAL, a2, env, a1) else - [f, args...] = eval_ast ast, env + f = EVAL(a0, env) + if f.__ismacro__ + ast = EVAL(f.__ast__, f.__gen_env__(ast[1..])) + continue + args = ast[1..].map((a) -> EVAL(a, env)) if types._function_Q(f) ast = f.__ast__ env = f.__gen_env__(args) else return f(args...) - # print PRINT = (exp) -> printer._pr_str exp, true diff --git a/impls/cpp/stepA_mal.cpp b/impls/cpp/stepA_mal.cpp index 34c940ba81..2de9c53a69 100644 --- a/impls/cpp/stepA_mal.cpp +++ b/impls/cpp/stepA_mal.cpp @@ -15,7 +15,6 @@ static void installFunctions(malEnvPtr env); static void makeArgv(malEnvPtr env, int argc, char* argv[]); static String safeRep(const String& input, malEnvPtr env); static malValuePtr quasiquote(malValuePtr obj); -static malValuePtr macroExpand(malValuePtr obj, malEnvPtr env); static ReadLine s_readLine("~/.mal-history"); @@ -83,13 +82,9 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr env) env = replEnv; } while (1) { - const malList* list = DYNAMIC_CAST(malList, ast); - if (!list || (list->count() == 0)) { - return ast->eval(env); - } + // std::cout << "EVAL: " << PRINT(ast) << "\n"; - ast = macroExpand(ast, env); - list = DYNAMIC_CAST(malList, ast); + const malList* list = DYNAMIC_CAST(malList, ast); if (!list || (list->count() == 0)) { return ast->eval(env); } @@ -167,16 +162,6 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr env) continue; // TCO } - if (special == "macroexpand") { - checkArgsIs("macroexpand", 1, argCount); - return macroExpand(list->item(1), env); - } - - if (special == "quasiquoteexpand") { - checkArgsIs("quasiquote", 1, argCount); - return quasiquote(list->item(1)); - } - if (special == "quasiquote") { checkArgsIs("quasiquote", 1, argCount); ast = quasiquote(list->item(1)); @@ -236,15 +221,20 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr env) } // Now we're left with the case of a regular list to be evaluated. - std::unique_ptr items(list->evalItems(env)); - malValuePtr op = items->at(0); + malValuePtr op = EVAL(list->item(0), env); if (const malLambda* lambda = DYNAMIC_CAST(malLambda, op)) { + if (lambda->isMacro()) { + ast = lambda->apply(list->begin()+1, list->end()); + continue; // TCO + } + malValueVec* items = STATIC_CAST(malList, list->rest())->evalItems(env); ast = lambda->getBody(); - env = lambda->makeEnv(items->begin()+1, items->end()); + env = lambda->makeEnv(items->begin(), items->end()); continue; // TCO } else { - return APPLY(op, items->begin()+1, items->end()); + malValueVec* items = STATIC_CAST(malList, list->rest())->evalItems(env); + return APPLY(op, items->begin(), items->end()); } } } @@ -306,31 +296,6 @@ static malValuePtr quasiquote(malValuePtr obj) return res; } -static const malLambda* isMacroApplication(malValuePtr obj, malEnvPtr env) -{ - const malList* seq = DYNAMIC_CAST(malList, obj); - if (seq && !seq->isEmpty()) { - if (malSymbol* sym = DYNAMIC_CAST(malSymbol, seq->item(0))) { - if (malEnvPtr symEnv = env->find(sym->value())) { - malValuePtr value = sym->eval(symEnv); - if (malLambda* lambda = DYNAMIC_CAST(malLambda, value)) { - return lambda->isMacro() ? lambda : NULL; - } - } - } - } - return NULL; -} - -static malValuePtr macroExpand(malValuePtr obj, malEnvPtr env) -{ - while (const malLambda* macro = isMacroApplication(obj, env)) { - const malSequence* seq = STATIC_CAST(malSequence, obj); - obj = macro->apply(seq->begin() + 1, seq->end()); - } - return obj; -} - static const char* malFunctionTable[] = { "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", "(def! not (fn* (cond) (if cond false true)))", diff --git a/impls/cs/stepA_mal.cs b/impls/cs/stepA_mal.cs index 56f3da0928..16d731cc3e 100644 --- a/impls/cs/stepA_mal.cs +++ b/impls/cs/stepA_mal.cs @@ -59,70 +59,34 @@ class stepA_mal { } } - public static bool is_macro_call(MalVal ast, Env env) { - if (ast is MalList) { - MalVal a0 = ((MalList)ast)[0]; - if (a0 is MalSymbol && - env.find((MalSymbol)a0) != null) { - MalVal mac = env.get((MalSymbol)a0); - if (mac is MalFunc && - ((MalFunc)mac).isMacro()) { - return true; - } - } - } - return false; - } + static MalVal EVAL(MalVal orig_ast, Env env) { + MalVal a0, a1, a2, res; - public static MalVal macroexpand(MalVal ast, Env env) { - while (is_macro_call(ast, env)) { - MalSymbol a0 = (MalSymbol)((MalList)ast)[0]; - MalFunc mac = (MalFunc) env.get(a0); - ast = mac.apply(((MalList)ast).rest()); - } - return ast; - } + while (true) { - static MalVal eval_ast(MalVal ast, Env env) { - if (ast is MalSymbol) { - return env.get((MalSymbol)ast); - } else if (ast is MalList) { - MalList old_lst = (MalList)ast; - MalList new_lst = ast.list_Q() ? new MalList() - : (MalList)new MalVector(); + //Console.WriteLine("EVAL: " + printer._pr_str(orig_ast, true)); + + if (orig_ast is MalSymbol) { + return env.get((MalSymbol)orig_ast); + } else if (orig_ast is MalVector) { + MalVector old_lst = (MalVector)orig_ast; + MalVector new_lst = new MalVector(); foreach (MalVal mv in old_lst.getValue()) { new_lst.conj_BANG(EVAL(mv, env)); } return new_lst; - } else if (ast is MalHashMap) { + } else if (orig_ast is MalHashMap) { var new_dict = new Dictionary(); - foreach (var entry in ((MalHashMap)ast).getValue()) { + foreach (var entry in ((MalHashMap)orig_ast).getValue()) { new_dict.Add(entry.Key, EVAL((MalVal)entry.Value, env)); } return new MalHashMap(new_dict); - } else { - return ast; - } - } - - - static MalVal EVAL(MalVal orig_ast, Env env) { - MalVal a0, a1, a2, res; - MalList el; - - while (true) { - - //Console.WriteLine("EVAL: " + printer._pr_str(orig_ast, true)); - if (!orig_ast.list_Q()) { - return eval_ast(orig_ast, env); + } else if (!(orig_ast is MalList)) { + return orig_ast; } // apply list - MalVal expanded = macroexpand(orig_ast, env); - if (!expanded.list_Q()) { - return eval_ast(expanded, env); - } - MalList ast = (MalList) expanded; + MalList ast = (MalList) orig_ast; if (ast.size() == 0) { return ast; } a0 = ast[0]; @@ -153,8 +117,6 @@ class stepA_mal { break; case "quote": return ast[1]; - case "quasiquoteexpand": - return quasiquote(ast[1]); case "quasiquote": orig_ast = quasiquote(ast[1]); break; @@ -165,9 +127,6 @@ class stepA_mal { ((MalFunc)res).setMacro(); env.set(((MalSymbol)a1), res); return res; - case "macroexpand": - a1 = ast[1]; - return macroexpand(a1, env); case "try*": try { return EVAL(ast[1], env); @@ -190,7 +149,9 @@ class stepA_mal { throw e; } case "do": - eval_ast(ast.slice(1, ast.size()-1), env); + foreach (MalVal mv in ast.slice(1, ast.size()-1).getValue()) { + EVAL(mv, env); + } orig_ast = ast[ast.size()-1]; break; case "if": @@ -215,14 +176,21 @@ class stepA_mal { return new MalFunc(a2f, env, a1f, args => EVAL(a2f, new Env(cur_env, a1f, args)) ); default: - el = (MalList)eval_ast(ast, env); - var f = (MalFunc)el[0]; + MalFunc f = (MalFunc)EVAL(ast[0], env); + if (f.isMacro()) { + orig_ast = f.apply(ast.rest()); + break; + } + MalList arguments = new MalList(); + foreach (MalVal mv in ast.rest().getValue()) { + arguments.conj_BANG(EVAL(mv, env)); + } MalVal fnast = f.getAst(); if (fnast != null) { orig_ast = fnast; - env = f.genEnv(el.rest()); + env = f.genEnv(arguments); } else { - return f.apply(el.rest()); + return f.apply(arguments); } break; } diff --git a/impls/d/stepA_mal.d b/impls/d/stepA_mal.d index 9fdd0f5d5b..ad0a821754 100644 --- a/impls/d/stepA_mal.d +++ b/impls/d/stepA_mal.d @@ -46,50 +46,22 @@ MalType quasiquote(MalType ast) return res; } -bool is_macro_call(MalType ast, Env env) -{ - auto lst = cast(MalList) ast; - if (lst is null) return false; - if (lst.elements.length == 0) return false; - auto sym0 = cast(MalSymbol) lst.elements[0]; - if (sym0 is null) return false; - if (env.find(sym0) is null) return false; - auto val = env.get(sym0); - auto val_func = cast(MalFunc) val; - if (val_func is null) return false; - return val_func.is_macro; -} - -MalType macroexpand(MalType ast, Env env) -{ - while (is_macro_call(ast, env)) - { - auto ast_list = verify_cast!MalList(ast); - auto sym0 = verify_cast!MalSymbol(ast_list.elements[0]); - auto macrofunc = verify_cast!MalFunc(env.get(sym0)); - auto rest = ast_list.elements[1..$]; - auto callenv = new Env(macrofunc.def_env, macrofunc.arg_names, rest); - ast = EVAL(macrofunc.func_body, callenv); - } - return ast; -} - MalType READ(string str) { return read_str(str); } -MalType eval_ast(MalType ast, Env env) +MalType EVAL(MalType ast, Env env) { + for (;;) + { + + // writeln("EVAL: ", pr_str(ast)); + if (auto sym = cast(MalSymbol)ast) { return env.get(sym); } - else if (auto lst = cast(MalList)ast) - { - auto el = array(lst.elements.map!(e => EVAL(e, env))); - return new MalList(el); - } else if (auto lst = cast(MalVector)ast) { auto el = array(lst.elements.map!(e => EVAL(e, env))); @@ -104,29 +76,8 @@ MalType eval_ast(MalType ast, Env env) } return new MalHashmap(new_data); } - else - { - return ast; - } -} - -MalType EVAL(MalType ast, Env env) -{ - for (;;) + else if (auto ast_list = cast(MalList)ast) { - MalList ast_list = cast(MalList) ast; - if (ast_list is null) - { - return eval_ast(ast, env); - } - - ast = macroexpand(ast, env); - ast_list = cast(MalList) ast; - if (ast_list is null) - { - return eval_ast(ast, env); - } - auto aste = ast_list.elements; if (aste.length == 0) { @@ -156,9 +107,6 @@ MalType EVAL(MalType ast, Env env) case "quote": return aste[1]; - case "quasiquoteexpand": - return quasiquote(aste[1]); - case "quasiquote": ast = quasiquote(aste[1]); continue; // TCO @@ -169,9 +117,6 @@ MalType EVAL(MalType ast, Env env) mac.is_macro = true; return env.set(a1, mac); - case "macroexpand": - return macroexpand(aste[1], env); - case "try*": if (aste.length < 2) return mal_nil; if (aste.length < 3) @@ -202,8 +147,9 @@ MalType EVAL(MalType ast, Env env) continue; // TCO case "do": - auto all_but_last = new MalList(aste[1..$-1]); - eval_ast(all_but_last, env); + foreach (elt; aste[1..$-1]) { + EVAL(elt, env); + } ast = aste[$-1]; continue; // TCO @@ -230,15 +176,16 @@ MalType EVAL(MalType ast, Env env) return new MalFunc(args_list.elements, aste[2], env); default: - auto el = verify_cast!MalList(eval_ast(ast, env)); - if (el.elements.length == 0) - { - throw new Exception("Expected a non-empty list"); - } - auto first = el.elements[0]; - auto rest = el.elements[1..$]; + auto first = EVAL(aste[0], env); + auto rest = aste[1..$]; if (auto funcobj = cast(MalFunc)first) { + if (funcobj.is_macro) { + auto callenv = new Env(funcobj.def_env, funcobj.arg_names, rest); + ast = EVAL(funcobj.func_body, callenv); + continue; // TCO + } + rest = array(rest.map!(e => EVAL(e, env))); auto callenv = new Env(funcobj.def_env, funcobj.arg_names, rest); ast = funcobj.func_body; env = callenv; @@ -246,6 +193,7 @@ MalType EVAL(MalType ast, Env env) } else if (auto builtinfuncobj = cast(MalBuiltinFunc)first) { + rest = array(rest.map!(e => EVAL(e, env))); return builtinfuncobj.fn(rest); } else @@ -254,6 +202,11 @@ MalType EVAL(MalType ast, Env env) } } } + else + { + return ast; + } + } } string PRINT(MalType ast) diff --git a/impls/elisp/stepA_mal.el b/impls/elisp/stepA_mal.el index bb0a6bcef7..bbecba2134 100644 --- a/impls/elisp/stepA_mal.el +++ b/impls/elisp/stepA_mal.el @@ -38,35 +38,23 @@ ((map symbol) (mal-list (list (mal-symbol 'quote) ast))) (t ast))) -(defun MACROEXPAND (ast env) - (let (a a0 macro) - (while (and (mal-list-p ast) - (setq a (mal-value ast)) - (setq a0 (car a)) - (mal-symbol-p a0) - (setq macro (mal-env-find env (mal-value a0))) - (mal-func-p macro) - (mal-func-macro-p macro)) - (setq ast (apply (mal-value (mal-func-fn macro)) (cdr a))))) - ast) - (defun READ (input) (read-str input)) (defun EVAL (ast env) (catch 'return (while t - (when (not (mal-list-p ast)) - (throw 'return (eval-ast ast env))) - (setq ast (MACROEXPAND ast env)) - (when (or (not (mal-list-p ast)) (not (mal-value ast))) - (throw 'return (eval-ast ast env))) + ;; (println "EVAL: %s\n" (PRINT ast)) + + (cl-case (mal-type ast) + (list (let* ((a (mal-value ast)) (a1 (cadr a)) (a2 (nth 2 a)) (a3 (nth 3 a))) + (unless a (throw 'return ast)) (cl-case (mal-value (car a)) (def! (let ((identifier (mal-value a1)) @@ -84,8 +72,6 @@ ast form))) ; TCO (quote (throw 'return a1)) - (quasiquoteexpand - (throw 'return (quasiquote a1))) (quasiquote (setq ast (quasiquote a1))) ; TCO (defmacro! @@ -93,8 +79,6 @@ (value (EVAL a2 env))) (setf (aref (aref value 1) 4) t) (throw 'return (mal-env-set env identifier value)))) - (macroexpand - (throw 'return (MACROEXPAND a1 env))) (try* (condition-case err (throw 'return (EVAL a1 env)) @@ -115,8 +99,7 @@ (let* ((a0... (cdr a)) (butlast (butlast a0...)) (last (car (last a0...)))) - (when butlast - (eval-ast (mal-list butlast) env)) + (mapcar (lambda (item) (EVAL item env)) butlast) (setq ast last))) ; TCO (if (let* ((condition (EVAL a1 env)) @@ -139,38 +122,33 @@ (throw 'return (mal-func body binds env fn)))) (t ;; not a special form - (let* ((ast* (mal-value (eval-ast ast env))) - (fn (car ast*)) - (args (cdr ast*))) + (let ((fn (EVAL (car a) env)) + (args (cdr a))) (if (mal-func-p fn) - (let ((env* (mal-env (mal-func-env fn) - (mal-func-params fn) - args))) - (setq env env* - ast (mal-func-ast fn))) ; TCO + (if (mal-func-macro-p fn) + (setq ast (apply (mal-value (mal-func-fn fn)) args)) ; TCO + (setq env (mal-env (mal-func-env fn) + (mal-func-params fn) + (mapcar (lambda (x) (EVAL x env)) args)) + ast (mal-func-ast fn))) ; TCO ;; built-in function - (let ((fn* (mal-value fn))) - (throw 'return (apply fn* args))))))))))) - -(defun eval-ast (ast env) - (let ((value (mal-value ast))) - (cl-case (mal-type ast) + (throw 'return (apply (mal-value fn) (mapcar (lambda (x) (EVAL x env)) args))))))))) (symbol - (let ((definition (mal-env-get env value))) - (or definition (error "Definition not found")))) - (list - (mal-list (mapcar (lambda (item) (EVAL item env)) value))) + (let ((definition (mal-env-get env (mal-value ast)))) + (if definition + (throw 'return definition) + (error "Definition not found")))) (vector - (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) + (throw 'return (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) (mal-value ast)))))) (map - (let ((map (copy-hash-table value))) + (let ((map (copy-hash-table (mal-value ast)))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) - (mal-map map))) + (throw 'return (mal-map map)))) (t ;; return as is - ast)))) + (throw 'return ast)))))) (mal-env-set repl-env 'eval (mal-fn (let ((env repl-env)) (lambda (form) (EVAL form env))))) (mal-env-set repl-env '*ARGV* (mal-list (mapcar 'mal-string (cdr argv)))) diff --git a/impls/elixir/lib/mix/tasks/stepA_mal.ex b/impls/elixir/lib/mix/tasks/stepA_mal.ex index f80375d173..d26f0ba11e 100644 --- a/impls/elixir/lib/mix/tasks/stepA_mal.ex +++ b/impls/elixir/lib/mix/tasks/stepA_mal.ex @@ -75,7 +75,7 @@ defmodule Mix.Tasks.StepAMal do end defp eval_ast({:list, ast, meta}, env) when is_list(ast) do - {:list, Enum.map(ast, fn elem -> eval(elem, env) end), meta} + eval_list(ast, env, meta) end defp eval_ast({:map, ast, meta}, env) do @@ -126,39 +126,11 @@ defmodule Mix.Tasks.StepAMal do defp qq_loop({:list, [{:symbol, "splice-unquote"}| _], _}, _), do: throw({:error, "splice-unquote: arg count"}) defp qq_loop(elt, acc), do: list([{:symbol, "cons"}, quasiquote(elt), acc]) - defp macro_call?({:list, [{:symbol, key} | _tail], _}, env) do - case Mal.Env.get(env, key) do - {:ok, %Function{macro: true}} -> true - _ -> false - end - end - defp macro_call?(_ast, _env), do: false - - defp do_macro_call({:list, [{:symbol, key} | tail], _}, env) do - {:ok, %Function{value: macro, macro: true}} = Mal.Env.get(env, key) - macro.(tail) - |> macroexpand(env) - end - - defp macroexpand(ast, env) do - if macro_call?(ast, env) do - do_macro_call(ast, env) - else - ast - end + defp eval(ast, env) do + # IO.puts("EVAL: #{Mal.Printer.print_str(ast)}") + eval_ast(ast, env) end - defp eval({:list, [], _} = empty_ast, _env), do: empty_ast - defp eval({:list, _list, _meta} = ast, env) do - case macroexpand(ast, env) do - {:list, list, meta} -> eval_list(list, env, meta) - result -> eval_ast(result, env) - end - end - defp eval(ast, env), do: eval_ast(ast, env) - - defp eval_list([{:symbol, "macroexpand"}, ast], env, _), do: macroexpand(ast, env) - defp eval_list([{:symbol, "if"}, condition, if_true | if_false], env, _) do result = eval(condition, env) if result == nil or result == false do @@ -174,8 +146,7 @@ defmodule Mix.Tasks.StepAMal do defp eval_list([{:symbol, "do"} | ast], env, _) do ast |> List.delete_at(-1) - |> list - |> eval_ast(env) + |> Enum.map(fn elem -> eval(elem, env) end) eval(List.last(ast), env) end @@ -212,10 +183,6 @@ defmodule Mix.Tasks.StepAMal do defp eval_list([{:symbol, "quote"}, arg], _env, _), do: arg - defp eval_list([{:symbol, "quasiquoteexpand"}, ast], _, _) do - quasiquote(ast) - end - defp eval_list([{:symbol, "quasiquote"}, ast], env, _) do ast |> quasiquote |> eval(env) @@ -232,11 +199,16 @@ defmodule Mix.Tasks.StepAMal do throw({:error, "try* requires a list as the second parameter"}) end - defp eval_list(ast, env, meta) do - {:list, [func | args], _} = eval_ast({:list, ast, meta}, env) - func.value.(args) + defp eval_list([a0 | args], env, _meta) do + func = eval(a0, env) + case func do + %Function{macro: true} -> func.value.(args) |> eval(env) + _ -> func.value.(Enum.map(args, fn elem -> eval(elem, env) end)) + end end + defp eval_list([], _env, meta), do: {:list, [], meta} + defp eval_try(try_form, [{:symbol, "catch*"}, {:symbol, exception}, catch_form], env) do try do diff --git a/impls/erlang/src/stepA_mal.erl b/impls/erlang/src/stepA_mal.erl index 4a32120ccb..494d166cdb 100644 --- a/impls/erlang/src/stepA_mal.erl +++ b/impls/erlang/src/stepA_mal.erl @@ -49,14 +49,8 @@ read(Input) -> end. eval(Value, Env) -> - case Value of - {list, _L1, _M1} -> - case macroexpand(Value, Env) of - {list, _L2, _M2} = List -> eval_list(List, Env); - AST -> eval_ast(AST, Env) - end; - _ -> eval_ast(Value, Env) - end. + %%% io.format("EVAL: %s~n", printer:pr_str(Value, true)), + eval_ast(Value, Env). eval_list({list, [], _Meta}=AST, _Env) -> AST; @@ -79,7 +73,7 @@ eval_list({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> eval_list({list, [{symbol, "let*"}|_], _Meta}, _Env) -> error("let* requires exactly two arguments"); eval_list({list, [{symbol, "do"}|Args], _Meta}, Env) -> - eval_ast({list, lists:droplast(Args), nil}, Env), + lists:map(fun(Elem) -> eval(Elem, Env) end, lists:droplast(Args)), eval(lists:last(Args), Env); eval_list({list, [{symbol, "if"}, Test, Consequent|Alternate], _Meta}, Env) -> case eval(Test, Env) of @@ -109,10 +103,6 @@ eval_list({list, [{symbol, "quote"}, AST], _Meta}, _Env) -> AST; eval_list({list, [{symbol, "quote"}|_], _Meta}, _Env) -> error("quote requires 1 argument"); -eval_list({list, [{symbol, "quasiquoteexpand"}, AST], _Meta}, Env) -> - quasiquote(AST); -eval_list({list, [{symbol, "quasiquoteexpand"}|_], _Meta}, _Env) -> - error("quasiquoteexpand requires 1 argument"); eval_list({list, [{symbol, "quasiquote"}, AST], _Meta}, Env) -> eval(quasiquote(AST), Env); eval_list({list, [{symbol, "quasiquote"}|_], _Meta}, _Env) -> @@ -130,10 +120,6 @@ eval_list({list, [{symbol, "defmacro!"}, _A1, _A2], _Meta}, _Env) -> error("defmacro! called with non-symbol"); eval_list({list, [{symbol, "defmacro!"}|_], _Meta}, _Env) -> error("defmacro! requires exactly two arguments"); -eval_list({list, [{symbol, "macroexpand"}, Macro], _Meta}, Env) -> - macroexpand(Macro, Env); -eval_list({list, [{symbol, "macroexpand"}], _Meta}, _Env) -> - error("macroexpand requires 1 argument"); eval_list({list, [{symbol, "try*"}, A, {list, [{symbol, "catch*"}, B, C], _M1}], _M2}, Env) -> try eval(A, Env) of Result -> Result @@ -151,23 +137,32 @@ eval_list({list, [{symbol, "try*"}, AST], _Meta}, Env) -> eval(AST, Env); eval_list({list, [{symbol, "try*"}|_], _Meta}, _Env) -> error("try*/catch* must be of the form (try* A (catch* B C))"); -eval_list({list, List, Meta}, Env) -> - case eval_ast({list, List, Meta}, Env) of - {list, [{closure, _Eval, Binds, Body, CE, _MC}|A], _M2} -> +eval_list({list, [A0 | Args], _Meta}, Env) -> + case eval(A0, Env) of + {closure, _Eval, Binds, Body, CE, _MC} -> % The args may be a single element or a list, so always make it % a list and then flatten it so it becomes a list. + A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), NewEnv = env:new(CE), env:bind(NewEnv, Binds, lists:flatten([A])), eval(Body, NewEnv); - {list, [{function, F, _MF}|A], _M3} -> erlang:apply(F, [A]); - {list, [{error, Reason}], _M4} -> {error, Reason}; - _ -> error("expected a list") + {function, F, _MF} -> + A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), + erlang:apply(F, [A]); + {macro, Binds, Body, ME} -> + NewEnv = env:new(ME), + env:bind(NewEnv, Binds, lists:flatten([Args])), + NewAst = eval(Body, NewEnv), + eval(NewAst, Env); + {error, Reason} -> {error, Reason} end. eval_ast({symbol, _Sym}=Value, Env) -> env:get(Env, Value); -eval_ast({Type, Seq, _Meta}, Env) when Type == list orelse Type == vector -> - {Type, lists:map(fun(Elem) -> eval(Elem, Env) end, Seq), nil}; +eval_ast({list, Seq, Meta}, Env) -> + eval_list({list, Seq, Meta}, Env); +eval_ast({vector, Seq, _Meta}, Env) -> + {vector, lists:map(fun(Elem) -> eval(Elem, Env) end, Seq), nil}; eval_ast({map, M, _Meta}, Env) -> {map, maps:map(fun(_Key, Val) -> eval(Val, Env) end, M), nil}; eval_ast(Value, _Env) -> @@ -226,27 +221,3 @@ quasiquote({map, _Map, _Meta} = Arg) -> {list, [{symbol, "quote"}, Arg], nil}; quasiquote(Arg) -> Arg. - -is_macro_call({list, [{symbol, Name}|_], _Meta}, Env) -> - case env:find(Env, {symbol, Name}) of - nil -> false; - Env2 -> - case env:get(Env2, {symbol, Name}) of - {macro, _Binds, _Body, _ME} -> true; - _ -> false - end - end; -is_macro_call(_AST, _Env) -> - false. - -macroexpand(AST, Env) -> - case is_macro_call(AST, Env) of - true -> - {list, [Name|A], _Meta} = AST, - {macro, Binds, Body, ME} = env:get(Env, Name), - NewEnv = env:new(ME), - env:bind(NewEnv, Binds, lists:flatten([A])), - NewAST = eval(Body, NewEnv), - macroexpand(NewAST, Env); - false -> AST - end. diff --git a/impls/es6/stepA_mal.mjs b/impls/es6/stepA_mal.mjs index 8f33c2d0f2..af1386d9fa 100644 --- a/impls/es6/stepA_mal.mjs +++ b/impls/es6/stepA_mal.mjs @@ -34,37 +34,22 @@ const quasiquote = ast => { } } -function macroexpand(ast, env) { - while (_list_Q(ast) && typeof ast[0] === 'symbol' && ast[0] in env) { - let f = env_get(env, ast[0]) - if (!f.ismacro) { break } - ast = f(...ast.slice(1)) - } - return ast -} - +const EVAL = (ast, env) => { + while (true) { + //console.log('EVAL:', pr_str(ast, true)) -const eval_ast = (ast, env) => { if (typeof ast === 'symbol') { return env_get(env, ast) - } else if (ast instanceof Array) { + } else if (ast instanceof Vector) { return ast.map(x => EVAL(x, env)) } else if (ast instanceof Map) { let new_hm = new Map() - ast.forEach((v, k) => new_hm.set(EVAL(k, env), EVAL(v, env))) + ast.forEach((v, k) => new_hm.set(k, EVAL(v, env))) return new_hm - } else { + } else if (!_list_Q(ast)) { return ast } -} -const EVAL = (ast, env) => { - while (true) { - //console.log('EVAL:', pr_str(ast, true)) - if (!_list_Q(ast)) { return eval_ast(ast, env) } - - ast = macroexpand(ast, env) - if (!_list_Q(ast)) { return eval_ast(ast, env) } if (ast.length === 0) { return ast } const [a0, a1, a2, a3] = ast @@ -81,8 +66,6 @@ const EVAL = (ast, env) => { break // continue TCO loop case 'quote': return a1 - case 'quasiquoteexpand': - return quasiquote(a1) case 'quasiquote': ast = quasiquote(a1) break // continue TCO loop @@ -90,8 +73,6 @@ const EVAL = (ast, env) => { let func = _clone(EVAL(a2, env)) func.ismacro = true return env_set(env, a1, func) - case 'macroexpand': - return macroexpand(a1, env) case 'try*': try { return EVAL(a1, env) @@ -104,7 +85,7 @@ const EVAL = (ast, env) => { } } case 'do': - eval_ast(ast.slice(1,-1), env) + ast.slice(1, -1).map(x => EVAL(x, env)) ast = ast[ast.length-1] break // continue TCO loop case 'if': @@ -119,7 +100,12 @@ const EVAL = (ast, env) => { return _malfunc((...args) => EVAL(a2, new_env(env, a1, args)), a2, env, a1) default: - let [f, ...args] = eval_ast(ast, env) + let f = EVAL(a0, env) + if (f.ismacro) { + ast = f(...ast.slice(1)) + break // continue TCO loop + } + let args = ast.slice(1).map(x => EVAL(x, env)) if (_malfunc_Q(f)) { env = new_env(f.env, f.params, args) ast = f.ast diff --git a/impls/factor/stepA_mal/stepA_mal.factor b/impls/factor/stepA_mal/stepA_mal.factor index 438111f5de..73e4808040 100755 --- a/impls/factor/stepA_mal/stepA_mal.factor +++ b/impls/factor/stepA_mal/stepA_mal.factor @@ -11,12 +11,6 @@ SYMBOL: repl-env DEFER: EVAL -GENERIC# eval-ast 1 ( ast env -- ast ) -M: malsymbol eval-ast env-get ; -M: sequence eval-ast '[ _ EVAL ] map ; -M: assoc eval-ast '[ _ EVAL ] assoc-map ; -M: object eval-ast drop ; - :: eval-def! ( key value env -- maltype ) value env EVAL [ key env env-set ] keep ; @@ -32,7 +26,7 @@ M: object eval-ast drop ; exprs [ { } f ] [ - unclip-last [ env eval-ast drop ] dip env + unclip-last [ '[ env EVAL drop ] each ] dip env ] if-empty ; :: eval-if ( params env -- maltype env/f ) @@ -63,7 +57,7 @@ M: object eval-ast drop ; swapd [ over length cut [ zip ] dip ] dip [ swap 2array suffix ] [ drop ] if* >hashtable ; -GENERIC# apply 0 ( args fn -- maltype newenv/f ) +GENERIC: apply ( args fn -- maltype newenv/f ) M: malfn apply [ exprs>> nip ] @@ -100,23 +94,15 @@ M: array quasiquote [ second ] [ qq_foldr ] if ; M: vector quasiquote qq_foldr "vec" swap 2array ; M: malsymbol quasiquote "quote" swap 2array ; -M: assoc quasiquote "quote" swap 2array ; +M: hashtable quasiquote "quote" swap 2array ; M: object quasiquote ; -:: macro-expand ( maltype env -- maltype ) - maltype dup array? [ - dup first { [ malsymbol? ] [ env env-find drop ] } 1&& [ - dup { [ malfn? ] [ macro?>> ] } 1&& [ - [ rest ] dip apply [ EVAL ] keep macro-expand - ] [ drop ] if - ] when* - ] when ; - : READ ( str -- maltype ) read-str ; -: EVAL ( maltype env -- maltype ) - over { [ array? ] [ empty? not ] } 1&& [ - [ macro-expand ] keep over array? [ +GENERIC# EVAL-switch 1 ( maltype env -- maltype ) +M: array EVAL-switch + # "EVAL: " pick PRINT concat print flush + over empty? [ drop ] [ over first dup malsymbol? [ name>> ] when { { "def!" [ [ rest first2 ] dip eval-def! f ] } { "defmacro!" [ [ rest first2 ] dip eval-defmacro! f ] } @@ -125,18 +111,29 @@ M: object quasiquote ; { "if" [ [ rest ] dip eval-if ] } { "fn*" [ [ rest ] dip eval-fn* f ] } { "quote" [ drop second f ] } - { "quasiquoteexpand" [ drop second quasiquote f ] } { "quasiquote" [ [ second quasiquote ] dip ] } - { "macroexpand" [ [ second ] dip macro-expand f ] } { "try*" [ [ rest ] dip eval-try* f ] } - [ drop '[ _ EVAL ] map unclip apply ] + [ drop swap ! env ast + unclip ! env rest first + pick EVAL ! env rest fn + dup { [ malfn? ] [ macro?>> ] } 1&& [ + apply ! env maltype newenv + EVAL swap + ] [ + [ swap '[ _ EVAL ] map ] dip ! args fn + apply + ] if + ] } case [ EVAL ] when* - ] [ - eval-ast - ] if - ] [ - eval-ast ] if ; +M: malsymbol EVAL-switch env-get ; +M: vector EVAL-switch '[ _ EVAL ] map ; +M: hashtable EVAL-switch '[ _ EVAL ] assoc-map ; +M: object EVAL-switch drop ; + +: EVAL ( maltype env -- maltype ) + ! "EVAL: " pick pr-str append print flush + EVAL-switch ; [ apply [ EVAL ] when* ] mal-apply set-global diff --git a/impls/fsharp/stepA_mal.fs b/impls/fsharp/stepA_mal.fs index 6417191ba5..13cae60a1f 100644 --- a/impls/fsharp/stepA_mal.fs +++ b/impls/fsharp/stepA_mal.fs @@ -31,19 +31,7 @@ module REPL | [node] -> node | _ -> raise <| Error.wrongArity () - let rec macroExpand env = function - | Env.IsMacro env (Macro(_, _, f, _, _, _), rest) -> - f rest |> macroExpand env - | node -> node - - let rec eval_ast env = function - | Symbol(sym) -> Env.get env sym - | List(_, lst) -> lst |> List.map (eval env) |> makeList - | Vector(_, seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray - | Map(_, map) -> map |> Map.map (fun k v -> eval env v) |> makeMap - | node -> node - - and defBangForm env = function + let rec defBangForm env = function | [sym; form] -> match sym with | Symbol(sym) -> @@ -67,10 +55,6 @@ module REPL | _ -> raise <| Error.errExpectedX "symbol" | _ -> raise <| Error.wrongArity () - and macroExpandForm env = function - | [form] -> macroExpand env form - | _ -> raise <| Error.wrongArity () - and setBinding env first second = let s = match first with | Symbol(s) -> s @@ -138,13 +122,14 @@ module REPL | Error.MalError(node) -> catchForm env node catchClause | _ -> raise <| Error.wrongArity () - and eval env = function - | List(_, _) as node -> - match macroExpand env node with - | List(_, []) as emptyList -> emptyList + and eval env ast = + // printfn "EVAL: %s" (Printer.pr_str [ast]) + match ast with + | Symbol(sym) -> Env.get env sym + | Vector(_, seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray + | Map(_, map) -> map |> Map.map (fun k v -> eval env v) |> makeMap | List(_, Symbol("def!")::rest) -> defBangForm env rest | List(_, Symbol("defmacro!")::rest) -> defMacroForm env rest - | List(_, Symbol("macroexpand")::rest) -> macroExpandForm env rest | List(_, Symbol("let*")::rest) -> let inner, form = letStarForm env rest form |> eval inner @@ -152,21 +137,18 @@ module REPL | List(_, Symbol("do")::rest) -> doForm env rest |> eval env | List(_, Symbol("fn*")::rest) -> fnStarForm env rest | List(_, Symbol("quote")::rest) -> quoteForm rest - | List(_, [Symbol("quasiquoteexpand");form]) -> quasiquote form - | List(_, Symbol("quasiquoteexpand")::_) -> raise <| Error.wrongArity () | List(_, [Symbol("quasiquote");form]) -> eval env <| quasiquote form | List(_, Symbol("quasiquote")::_) -> raise <| Error.wrongArity () | List(_, Symbol("try*")::rest) -> tryForm env rest - | List(_, _) as node -> - let resolved = node |> eval_ast env - match resolved with - | List(_, BuiltInFunc(_, _, f)::rest) -> f rest - | List(_, Func(_, _, _, body, binds, outer)::rest) -> - let inner = Env.makeNew outer binds rest + | List(_, (a0 :: args)) -> + match eval env a0 with + | BuiltInFunc(_, _, f) -> List.map (eval env) args |> f + | Func(_, _, _, body, binds, outer) -> + let inner = List.map (eval env) args |> Env.makeNew outer binds body |> eval inner + | Macro(_, _, f, _, _, _) -> f args |> eval env | _ -> raise <| Error.errExpectedX "func" - | node -> node |> eval_ast env - | node -> node |> eval_ast env + | node -> node let READ input = Reader.read_str input diff --git a/impls/gnu-smalltalk/stepA_mal.st b/impls/gnu-smalltalk/stepA_mal.st index 4394d5279e..59d46ae125 100644 --- a/impls/gnu-smalltalk/stepA_mal.st +++ b/impls/gnu-smalltalk/stepA_mal.st @@ -21,24 +21,6 @@ Object subclass: MAL [ ^Reader readStr: input ] - MAL class >> evalAst: sexp env: env [ - sexp type = #symbol ifTrue: [ - ^env get: sexp value - ]. - - sexp type = #list ifTrue: [ - ^self evalList: sexp env: env class: MALList - ]. - sexp type = #vector ifTrue: [ - ^self evalList: sexp env: env class: MALVector - ]. - sexp type = #map ifTrue: [ - ^self evalList: sexp env: env class: MALMap - ]. - - ^sexp - ] - MAL class >> evalList: sexp env: env class: aClass [ | items | items := sexp value collect: @@ -86,39 +68,6 @@ Object subclass: MAL [ ^acc ] - MAL class >> isMacroCall: ast env: env [ - | a0 a0_ f | - ast type = #list ifTrue: [ - a0 := ast value first. - a0_ := a0 value. - a0 type = #symbol ifTrue: [ - f := env find: a0_. - (f notNil and: [ f type = #func ]) ifTrue: [ - ^f isMacro - ] - ] - ]. - ^false - ] - - MAL class >> macroexpand: aSexp env: env [ - | sexp | - - "NOTE: redefinition of method arguments is not allowed" - sexp := aSexp. - - [ self isMacroCall: sexp env: env ] whileTrue: [ - | ast a0_ macro rest | - ast := sexp value. - a0_ := ast first value. - macro := env find: a0_. - rest := ast allButFirst. - sexp := macro fn value: rest. - ]. - - ^sexp - ] - MAL class >> EVAL: aSexp env: anEnv [ | sexp env ast a0 a0_ a1 a1_ a2 a2_ a3 forms function args | @@ -128,16 +77,20 @@ Object subclass: MAL [ [ [ :continue | - sexp type ~= #list ifTrue: [ - ^self evalAst: sexp env: env + + " ('EVAL: ' , (Printer prStr: sexp printReadably: true)) displayNl. " + + sexp type = #symbol ifTrue: [ + ^env get: sexp value ]. - sexp value isEmpty ifTrue: [ - ^sexp + sexp type = #vector ifTrue: [ + ^self evalList: sexp env: env class: MALVector ]. - - sexp := self macroexpand: sexp env: env. - sexp type ~= #list ifTrue: [ - ^self evalAst: sexp env: env + sexp type = #map ifTrue: [ + ^self evalList: sexp env: env class: MALMap + ]. + (sexp type ~= #list or: [ sexp value isEmpty ]) ifTrue: [ + ^sexp ]. ast := sexp value. @@ -163,11 +116,6 @@ Object subclass: MAL [ ^result ]. - a0_ = #'macroexpand' ifTrue: [ - a1 := ast second. - ^self macroexpand: a1 env: env - ]. - a0_ = #'let*' ifTrue: [ | env_ | env_ := Env new: env. @@ -218,11 +166,6 @@ Object subclass: MAL [ ^a1 ]. - a0_ = #quasiquoteexpand ifTrue: [ - a1 := ast second. - ^self quasiquote: a1. - ]. - a0_ = #quasiquote ifTrue: [ | result | a1 := ast second. @@ -262,10 +205,13 @@ Object subclass: MAL [ ^Func new: a2 params: binds env: env fn: fn ]. - forms := (self evalAst: sexp env: env) value. - function := forms first. - args := forms allButFirst asArray. - + function := self EVAL: a0 env: env. + forms := ast allButFirst asArray. + (function type = #func and: [ function isMacro ]) ifTrue: [ + sexp := function fn value: forms. + continue value TCO + ]. + args := forms collect: [ :item | self EVAL: item env: env ]. function type = #fn ifTrue: [ ^function fn value: args ]. function type = #func ifTrue: [ | env_ | diff --git a/impls/go/src/stepA_mal/stepA_mal.go b/impls/go/src/stepA_mal/stepA_mal.go index b8e803e614..6f94548eba 100644 --- a/impls/go/src/stepA_mal/stepA_mal.go +++ b/impls/go/src/stepA_mal/stepA_mal.go @@ -67,67 +67,28 @@ func quasiquote(ast MalType) MalType { } } -func is_macro_call(ast MalType, env EnvType) bool { - if List_Q(ast) { - slc, _ := GetSlice(ast) - if len(slc) == 0 { - return false - } - a0 := slc[0] - if Symbol_Q(a0) && env.Find(a0.(Symbol)) != nil { - mac, e := env.Get(a0.(Symbol)) - if e != nil { - return false - } - if MalFunc_Q(mac) { - return mac.(MalFunc).GetMacro() - } - } - } - return false -} - -func macroexpand(ast MalType, env EnvType) (MalType, error) { - var mac MalType - var e error - for is_macro_call(ast, env) { - slc, _ := GetSlice(ast) - a0 := slc[0] - mac, e = env.Get(a0.(Symbol)) - if e != nil { - return nil, e - } - fn := mac.(MalFunc) - ast, e = Apply(fn, slc[1:]) +func map_eval(xs []MalType, env EnvType) ([]MalType, error) { + lst := []MalType{} + for _, a := range xs { + exp, e := EVAL(a, env) if e != nil { return nil, e } + lst = append(lst, exp) } - return ast, nil + return lst, nil } -func eval_ast(ast MalType, env EnvType) (MalType, error) { - //fmt.Printf("eval_ast: %#v\n", ast) +func EVAL(ast MalType, env EnvType) (MalType, error) { + for { + //fmt.Printf("EVAL: %v\n", printer.Pr_str(ast, true)) + if Symbol_Q(ast) { return env.Get(ast.(Symbol)) - } else if List_Q(ast) { - lst := []MalType{} - for _, a := range ast.(List).Val { - exp, e := EVAL(a, env) - if e != nil { - return nil, e - } - lst = append(lst, exp) - } - return List{lst, nil}, nil } else if Vector_Q(ast) { - lst := []MalType{} - for _, a := range ast.(Vector).Val { - exp, e := EVAL(a, env) - if e != nil { - return nil, e - } - lst = append(lst, exp) + lst, e := map_eval(ast.(Vector).Val, env) + if e != nil { + return nil, e } return Vector{lst, nil}, nil } else if HashMap_Q(ast) { @@ -148,30 +109,10 @@ func eval_ast(ast MalType, env EnvType) (MalType, error) { new_hm.Val[ke.(string)] = kv } return new_hm, nil - } else { + } else if !List_Q(ast) { return ast, nil - } -} - -func EVAL(ast MalType, env EnvType) (MalType, error) { - var e error - for { - - //fmt.Printf("EVAL: %v\n", printer.Pr_str(ast, true)) - switch ast.(type) { - case List: // continue - default: - return eval_ast(ast, env) - } - + } else { // apply list - ast, e = macroexpand(ast, env) - if e != nil { - return nil, e - } - if !List_Q(ast) { - return eval_ast(ast, env) - } if len(ast.(List).Val) == 0 { return ast, nil } @@ -224,8 +165,6 @@ func EVAL(ast MalType, env EnvType) (MalType, error) { env = let_env case "quote": return a1, nil - case "quasiquoteexpand": - return quasiquote(a1), nil case "quasiquote": ast = quasiquote(a1) case "defmacro!": @@ -235,8 +174,6 @@ func EVAL(ast MalType, env EnvType) (MalType, error) { return nil, e } return env.Set(a1.(Symbol), fn), nil - case "macroexpand": - return macroexpand(a1, env) case "try*": var exc MalType exp, e := EVAL(a1, env) @@ -267,10 +204,11 @@ func EVAL(ast MalType, env EnvType) (MalType, error) { } case "do": lst := ast.(List).Val - _, e := eval_ast(List{lst[1 : len(lst)-1], nil}, env) + _, e := map_eval(lst[1 : len(lst)-1], env) if e != nil { return nil, e } + if len(lst) == 1 { return nil, nil } @@ -293,27 +231,44 @@ func EVAL(ast MalType, env EnvType) (MalType, error) { fn := MalFunc{EVAL, a2, env, a1, false, NewEnv, nil} return fn, nil default: - el, e := eval_ast(ast, env) + f, e := EVAL(a0, env) if e != nil { return nil, e } - f := el.(List).Val[0] + args := ast.(List).Val[1:] if MalFunc_Q(f) { + + if f.(MalFunc).GetMacro() { + new_ast, e := Apply(f.(MalFunc), args) + if e != nil { + return nil, e + } + ast = new_ast + continue + } + args, e = map_eval(args, env) + if e != nil { + return nil, e + } fn := f.(MalFunc) ast = fn.Exp - env, e = NewEnv(fn.Env, fn.Params, List{el.(List).Val[1:], nil}) + env, e = NewEnv(fn.Env, fn.Params, List{args, nil}) if e != nil { return nil, e } } else { + args, e = map_eval(args, env) + if e != nil { + return nil, e + } fn, ok := f.(Func) if !ok { return nil, errors.New("attempt to call non-function") } - return fn.Fn(el.(List).Val[1:]) + return fn.Fn(args) } } - + } } // TCO loop } diff --git a/impls/groovy/stepA_mal.groovy b/impls/groovy/stepA_mal.groovy index 323976e569..cd8ca038ec 100644 --- a/impls/groovy/stepA_mal.groovy +++ b/impls/groovy/stepA_mal.groovy @@ -13,26 +13,6 @@ READ = { str -> } // EVAL -macro_Q = { ast, env -> - if (types.list_Q(ast) && - ast.size() > 0 && - ast[0].class == MalSymbol && - env.find(ast[0])) { - def obj = env.get(ast[0]) - if (obj instanceof MalFunc && obj.ismacro) { - return true - } - } - return false -} -macroexpand = { ast, env -> - while (macro_Q(ast, env)) { - def mac = env.get(ast[0]) - ast = mac(ast.drop(1)) - } - return ast -} - starts_with = { lst, sym -> lst.size() == 2 && lst[0].class == MalSymbol && lst[0].value == sym } @@ -66,12 +46,17 @@ quasiquote = { ast -> } } -eval_ast = { ast, env -> +EVAL = { ast, env -> + while (true) { + //println("EVAL: ${printer.pr_str(ast,true)}") + switch (ast) { case MalSymbol: return env.get(ast); - case List: return types.vector_Q(ast) ? - types.vector(ast.collect { EVAL(it,env) }) : - ast.collect { EVAL(it,env) } + case List: if (types.vector_Q(ast)) { + return types.vector(ast.collect { EVAL(it,env) }) + } else { + break + } case Map: def new_hm = [:] ast.each { k,v -> new_hm[EVAL(k, env)] = EVAL(v, env) @@ -79,15 +64,7 @@ eval_ast = { ast, env -> return new_hm default: return ast } -} -EVAL = { ast, env -> - while (true) { - //println("EVAL: ${printer.pr_str(ast,true)}") - if (! types.list_Q(ast)) return eval_ast(ast, env) - - ast = macroexpand(ast, env) - if (! types.list_Q(ast)) return eval_ast(ast, env) if (ast.size() == 0) return ast switch (ast[0]) { @@ -103,8 +80,6 @@ EVAL = { ast, env -> break // TCO case { it instanceof MalSymbol && it.value == "quote" }: return ast[1] - case { it instanceof MalSymbol && it.value == "quasiquoteexpand" }: - return quasiquote(ast[1]) case { it instanceof MalSymbol && it.value == "quasiquote" }: ast = quasiquote(ast[1]) break // TCO @@ -112,8 +87,6 @@ EVAL = { ast, env -> def f = EVAL(ast[2], env) f.ismacro = true return env.set(ast[1], f) - case { it instanceof MalSymbol && it.value == "macroexpand" }: - return macroexpand(ast[1], env) case { it instanceof MalSymbol && it.value == "try*" }: try { return EVAL(ast[1], env) @@ -133,7 +106,7 @@ EVAL = { ast, env -> } } case { it instanceof MalSymbol && it.value == "do" }: - ast.size() > 2 ? eval_ast(ast[1..-2], env) : null + ast.size() > 2 ? ast[1..-2].collect { EVAL(it,env) } : null ast = ast[-1] break // TCO case { it instanceof MalSymbol && it.value == "if" }: @@ -152,13 +125,19 @@ EVAL = { ast, env -> case { it instanceof MalSymbol && it.value == "fn*" }: return new MalFunc(EVAL, ast[2], env, ast[1]) default: - def el = eval_ast(ast, env) - def (f, args) = [el[0], el.drop(1)] + def f = EVAL(ast[0], env) + def args = ast.drop(1) if (f instanceof MalFunc) { + if (f.ismacro) { + ast = f(args) + break // TCO + } + args = args.collect { EVAL(it, env) } env = new Env(f.env, f.params, args) ast = f.ast break // TCO } else { + args = args.collect { EVAL(it, env) } return f(args) } } diff --git a/impls/guile/stepA_mal.scm b/impls/guile/stepA_mal.scm index 7885078bae..255b3489ca 100644 --- a/impls/guile/stepA_mal.scm +++ b/impls/guile/stepA_mal.scm @@ -32,20 +32,6 @@ (define (READ str) (read_str str)) -(define (eval_ast ast env) - (define (_eval x) (EVAL x env)) - (match ast - ((? _nil? obj) obj) - ((? symbol? sym) (env-has sym env)) - ((? list? lst) (map _eval lst)) - ((? vector? vec) (vector-map (lambda (i x) (_eval x)) vec)) - ((? hash-table? ht) - ;; NOTE: we must allocate a new hashmap here to avoid any side-effects, or - ;; there'll be strange bugs!!! - (list->hash-map (hash-fold (lambda (k v p) (cons k (cons (_eval v) p))) '() ht))) - (else ast))) - - (define (eval_seq ast env) (cond ((null? ast) nil) @@ -67,20 +53,6 @@ ((? symbol?) (list 'quote ast)) (else ast))) -(define (is_macro_call ast env) - (and (list? ast) - (> (length ast) 0) - (and=> (env-check (car ast) env) is-macro))) - -(define (_macroexpand ast env) - (cond - ((is_macro_call ast env) - => (lambda (c) - ;; NOTE: Macros are normal-order, so we shouldn't eval args here. - ;; Or it's applicable-order. - (_macroexpand (callable-apply c (cdr ast)) env))) - (else ast))) - (define (EVAL ast env) (define (%unzip2 kvs) (let lp((next kvs) (k '()) (v '())) @@ -91,17 +63,21 @@ (throw 'mal-error (format #f "let*: Invalid binding form '~a'" kvs))) (else (lp (cddr next) (cons (car next) k) (cons (cadr next) v)))))) (let tco-loop((ast ast) (env env)) ; expand as possible - (let ((ast (_macroexpand ast env))) + ;; (format #t "EVAL: ~a~%" (pr_str exp #t)) (match ast - ((? non-list?) (eval_ast ast env)) + ((? symbol? sym) (env-has sym env)) + ((? vector? vec) (vector-map (lambda (i x) (EVAL x env)) vec)) + ((? hash-table? ht) + (define new-ht (make-hash-table)) + (hash-for-each (lambda (k v) (hash-set! new-ht k (EVAL v env))) ht) + new-ht) + ((? non-list?) ast) (() ast) (('defmacro! k v) (let ((c (EVAL v env))) (callable-is_macro-set! c #t) ((env 'set) k c))) - (('macroexpand obj) (_macroexpand obj env)) (('quote obj) obj) - (('quasiquoteexpand obj) (_quasiquote obj)) (('quasiquote obj) (EVAL (_quasiquote obj) env)) (('def! k v) ((env 'set) k (EVAL v env))) (('let* kvs body) @@ -151,8 +127,11 @@ (let ((nenv (make-Env #:outer env #:binds (list B) #:exprs (cdr e)))) (EVAL C nenv))))) (else - (let ((el (map (lambda (x) (EVAL x env)) ast))) - (callable-apply (car el) (cdr el)))))))) + (let ((f (EVAL (car ast) env)) + (args (cdr ast))) + (if (is-macro f) + (EVAL (callable-apply f args) env) + (callable-apply f (map (lambda (x) (EVAL x env)) args)))))))) (define (EVAL-string str) (EVAL (read_str str) *toplevel*)) diff --git a/impls/haskell/stepA_mal.hs b/impls/haskell/stepA_mal.hs index 3e3517282d..91c1da83db 100644 --- a/impls/haskell/stepA_mal.hs +++ b/impls/haskell/stepA_mal.hs @@ -41,14 +41,6 @@ quasiquote ast@(MalHashMap _ _) = return $ toList [MalSymbol "quote", ast] quasiquote ast@(MalSymbol _) = return $ toList [MalSymbol "quote", ast] quasiquote ast = return ast -macroexpand :: Env -> MalVal -> IOThrows MalVal -macroexpand env ast@(MalSeq _ (Vect False) (MalSymbol a0 : args)) = do - maybeMacro <- liftIO $ env_get env a0 - case maybeMacro of - Just (MalMacro f) -> macroexpand env =<< f args - _ -> return ast -macroexpand _ ast = return ast - let_bind :: Env -> [MalVal] -> IOThrows () let_bind _ [] = return () let_bind env (MalSymbol b : e : xs) = do @@ -73,9 +65,6 @@ apply_ast (MalSymbol "let*") _ _ = throwStr "invalid let*" apply_ast (MalSymbol "quote") [a1] _ = return a1 apply_ast (MalSymbol "quote") _ _ = throwStr "invalid quote" -apply_ast (MalSymbol "quasiquoteexpand") [a1] _ = quasiquote a1 -apply_ast (MalSymbol "quasiquoteexpand") _ _ = throwStr "invalid quasiquote" - apply_ast (MalSymbol "quasiquote") [a1] env = eval env =<< quasiquote a1 apply_ast (MalSymbol "quasiquote") _ _ = throwStr "invalid quasiquote" @@ -89,9 +78,6 @@ apply_ast (MalSymbol "defmacro!") [MalSymbol a1, a2] env = do _ -> throwStr "defmacro! on non-function" apply_ast (MalSymbol "defmacro!") _ _ = throwStr "invalid defmacro!" -apply_ast (MalSymbol "macroexpand") [a1] env = macroexpand env a1 -apply_ast (MalSymbol "macroexpand") _ _ = throwStr "invalid macroexpand" - apply_ast (MalSymbol "try*") [a1] env = eval env a1 apply_ast (MalSymbol "try*") [a1, MalSeq _ (Vect False) [MalSymbol "catch*", a21, a22]] env = do res <- liftIO $ runExceptT $ eval env a1 diff --git a/impls/haxe/StepA_mal.hx b/impls/haxe/StepA_mal.hx index 7a89cda115..1ef08a49e2 100644 --- a/impls/haxe/StepA_mal.hx +++ b/impls/haxe/StepA_mal.hx @@ -40,56 +40,30 @@ class StepA_mal { } } - static function is_macro(ast:MalType, env:Env) { - return switch(ast) { - case MalList([]): false; - case MalList(a): - var a0 = a[0]; - return symbol_Q(a0) && - env.find(a0) != null && - _macro_Q(env.get(a0)); - case _: false; - } - } + static function EVAL(ast:MalType, env:Env):MalType { + while (true) { - static function macroexpand(ast:MalType, env:Env) { - while (is_macro(ast, env)) { - var mac = env.get(first(ast)); - switch (mac) { - case MalFunc(f,_,_,_,_,_): - ast = f(_list(ast).slice(1)); - case _: break; - } - } - return ast; - } + // Compat.println("EVAL: " + PRINT(ast)); - static function eval_ast(ast:MalType, env:Env) { - return switch (ast) { - case MalSymbol(s): env.get(ast); + var alst; + + switch (ast) { + case MalSymbol(s): return env.get(ast); case MalList(l): - MalList(l.map(function(x) { return EVAL(x, env); })); + alst = l; case MalVector(l): - MalVector(l.map(function(x) { return EVAL(x, env); })); + return MalVector(l.map(function(x) { return EVAL(x, env); })); case MalHashMap(m): var new_map = new Map(); for (k in m.keys()) { new_map[k] = EVAL(m[k], env); } - MalHashMap(new_map); - case _: ast; + return MalHashMap(new_map); + case _: return ast; } - } - - static function EVAL(ast:MalType, env:Env):MalType { - while (true) { - if (!list_Q(ast)) { return eval_ast(ast, env); } // apply - ast = macroexpand(ast, env); - if (!list_Q(ast)) { return eval_ast(ast, env); } - var alst = _list(ast); if (alst.length == 0) { return ast; } switch (alst[0]) { case MalSymbol("def!"): @@ -109,8 +83,6 @@ class StepA_mal { continue; // TCO case MalSymbol("quote"): return alst[1]; - case MalSymbol("quasiquoteexpand"): - return quasiquote(alst[1]); case MalSymbol("quasiquote"): ast = quasiquote(alst[1]); continue; // TCO @@ -122,8 +94,6 @@ class StepA_mal { case _: throw "Invalid defmacro! call"; } - case MalSymbol("macroexpand"): - return macroexpand(alst[1], env); case MalSymbol("try*"): try { return EVAL(alst[1], env); @@ -146,7 +116,8 @@ class StepA_mal { } } case MalSymbol("do"): - var el = eval_ast(MalList(alst.slice(1, alst.length-1)), env); + for (i in 1...alst.length-1) + EVAL(alst[i], env); ast = last(ast); continue; // TCO case MalSymbol("if"): @@ -164,11 +135,15 @@ class StepA_mal { return EVAL(alst[2], new Env(env, _list(alst[1]), args)); },alst[2],env,alst[1],false,nil); case _: - var el = eval_ast(ast, env); - var lst = _list(el); - switch (first(el)) { - case MalFunc(f,a,e,params,_,_): - var args = _list(el).slice(1); + var fn = EVAL(alst[0], env); + var args = alst.slice(1); + switch (fn) { + case MalFunc(f,a,e,params,ismacro,_): + if (ismacro) { + ast = f(args); + continue; // TCO + } + args = args.map(function(x) { return EVAL(x, env); }); if (a != null) { ast = a; env = new Env(e, _list(params), args); diff --git a/impls/java/src/main/java/mal/stepA_mal.java b/impls/java/src/main/java/mal/stepA_mal.java index 498bc930c0..d369ef0f7b 100644 --- a/impls/java/src/main/java/mal/stepA_mal.java +++ b/impls/java/src/main/java/mal/stepA_mal.java @@ -4,10 +4,9 @@ import java.io.StringWriter; import java.io.PrintWriter; +import java.util.ArrayList; 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; @@ -54,54 +53,12 @@ public static MalVal quasiquote(MalVal ast) { return res; } - public static Boolean is_macro_call(MalVal ast, Env env) - throws MalThrowable { - if (ast instanceof MalList) { - MalVal a0 = ((MalList)ast).nth(0); - if (a0 instanceof MalSymbol && - env.find(((MalSymbol)a0)) != null) { - MalVal mac = env.get(((MalSymbol)a0)); - if (mac instanceof MalFunction && - ((MalFunction)mac).isMacro()) { - return true; - } - } - } - return false; - } - - public static MalVal macroexpand(MalVal ast, Env env) - throws MalThrowable { - while (is_macro_call(ast, env)) { - MalSymbol a0 = (MalSymbol)((MalList)ast).nth(0); - MalFunction mac = (MalFunction) env.get(a0); - ast = mac.apply(((MalList)ast).rest()); - } - return ast; - } - - public static MalVal eval_ast(MalVal ast, Env env) throws MalThrowable { - if (ast instanceof MalSymbol) { - return env.get((MalSymbol)ast); - } else if (ast instanceof MalList) { - MalList old_lst = (MalList)ast; - MalList new_lst = ast.list_Q() ? new MalList() - : (MalList)new MalVector(); - for (MalVal mv : (List)old_lst.value) { - new_lst.conj_BANG(EVAL(mv, env)); - } - return new_lst; - } else if (ast instanceof MalHashMap) { - MalHashMap new_hm = new MalHashMap(); - Iterator it = ((MalHashMap)ast).value.entrySet().iterator(); - while (it.hasNext()) { - Map.Entry entry = (Map.Entry)it.next(); - new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); - } - return new_hm; - } else { - return ast; - } + public static List eval_ast(MalList old_lst, Env env) throws MalThrowable { + List new_lst = new ArrayList(); + for (MalVal mv : (List)old_lst.value) { + new_lst.add(EVAL(mv, env)); + } + return new_lst; } public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { @@ -111,17 +68,23 @@ public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { while (true) { //System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); - if (!orig_ast.list_Q()) { - return eval_ast(orig_ast, env); + + if (orig_ast instanceof MalSymbol) { + return env.get((MalSymbol)orig_ast); + } else if (orig_ast instanceof MalVector) { + return new MalVector(eval_ast((MalList)orig_ast, env)); + } else if (orig_ast instanceof MalHashMap) { + MalHashMap new_hm = new MalHashMap(); + for (Map.Entry entry : ((Map)((MalHashMap)orig_ast).value).entrySet()) { + new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); + } + return new_hm; + } else if (! orig_ast.list_Q()) { + return orig_ast; } - if (((MalList)orig_ast).size() == 0) { return orig_ast; } // apply list - MalVal expanded = macroexpand(orig_ast, env); - if (!expanded.list_Q()) { - return eval_ast(expanded, env); - } - MalList ast = (MalList) expanded; + MalList ast = (MalList)orig_ast; if (ast.size() == 0) { return ast; } a0 = ast.nth(0); String a0sym = a0 instanceof MalSymbol ? ((MalSymbol)a0).getName() @@ -149,8 +112,6 @@ public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { break; case "quote": return ast.nth(1); - case "quasiquoteexpand": - return quasiquote(ast.nth(1)); case "quasiquote": orig_ast = quasiquote(ast.nth(1)); break; @@ -161,9 +122,6 @@ public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { ((MalFunction)res).setMacro(); env.set((MalSymbol)a1, res); return res; - case "macroexpand": - a1 = ast.nth(1); - return macroexpand(a1, env); case "try*": try { return EVAL(ast.nth(1), env); @@ -217,14 +175,19 @@ public MalVal apply(MalList args) throws MalThrowable { } }; default: - el = (MalList)eval_ast(ast, env); - MalFunction f = (MalFunction)el.nth(0); + MalFunction f = (MalFunction)EVAL(a0, env); + el = ast.rest(); + if (f.isMacro()) { + orig_ast = f.apply(el); + continue; + } + el = new MalList(eval_ast(el, env)); MalVal fnast = f.getAst(); if (fnast != null) { orig_ast = fnast; - env = f.genEnv(el.slice(1)); + env = f.genEnv(el); } else { - return f.apply(el.rest()); + return f.apply(el); } } diff --git a/impls/js/stepA_mal.js b/impls/js/stepA_mal.js index d10f9ef636..4686674434 100644 --- a/impls/js/stepA_mal.js +++ b/impls/js/stepA_mal.js @@ -36,26 +36,13 @@ function quasiquote(ast) { } } -function is_macro_call(ast, env) { - return types._list_Q(ast) && - types._symbol_Q(ast[0]) && - env.find(ast[0]) && - env.get(ast[0])._ismacro_; -} +function _EVAL(ast, env) { + while (true) { -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; -} + //printer.println("EVAL:", printer._pr_str(ast, true)); -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; @@ -66,24 +53,10 @@ function eval_ast(ast, env) { new_hm[EVAL(k, env)] = EVAL(ast[k], env); } return new_hm; - } else { + } else if (!types._list_Q(ast)) { return ast; } -} - -function _EVAL(ast, env) { - while (true) { - - //printer.println("EVAL:", printer._pr_str(ast, true)); - if (!types._list_Q(ast)) { - return eval_ast(ast, env); - } - // apply list - ast = macroexpand(ast, env); - if (!types._list_Q(ast)) { - return eval_ast(ast, env); - } if (ast.length === 0) { return ast; } @@ -103,8 +76,6 @@ function _EVAL(ast, env) { break; case "quote": return a1; - case "quasiquoteexpand": - return quasiquote(a1); case "quasiquote": ast = quasiquote(a1); break; @@ -112,8 +83,6 @@ function _EVAL(ast, env) { var func = types._clone(EVAL(a2, env)); func._ismacro_ = true; return env.set(a1, func); - case 'macroexpand': - return macroexpand(a1, env); case "try*": try { return EVAL(a1, env); @@ -126,7 +95,9 @@ function _EVAL(ast, env) { } } case "do": - eval_ast(ast.slice(1, -1), env); + for (var i=1; i < ast.length - 1; i++) { + EVAL(ast[i], env); + } ast = ast[ast.length-1]; break; case "if": @@ -140,12 +111,18 @@ function _EVAL(ast, env) { case "fn*": return types._function(EVAL, Env, a2, env, a1); default: - var el = eval_ast(ast, env), f = el[0]; + var f = EVAL(a0, env); + var args = ast.slice(1) + if (f._ismacro_) { + ast = f.apply(f, args); + break; + } + args = args.map(function(a) { return EVAL(a, env); }); if (f.__ast__) { ast = f.__ast__; - env = f.__gen_env__(el.slice(1)); + env = f.__gen_env__(args); } else { - return f.apply(f, el.slice(1)); + return f.apply(f, args); } } diff --git a/impls/logo/stepA_mal.lg b/impls/logo/stepA_mal.lg index c3d1340444..09a5305e9e 100644 --- a/impls/logo/stepA_mal.lg +++ b/impls/logo/stepA_mal.lg @@ -32,47 +32,18 @@ if (obj_type :ast) = "vector [make "result (mal_list symbol_new "vec :result)] output :result end -to macrocallp :ast :env -if (obj_type :ast) = "list [ - if (_count :ast) > 0 [ - localmake "a0 nth :ast 0 - if (obj_type :a0) = "symbol [ - if not emptyp env_find :env :a0 [ - localmake "f env_get :env :a0 - if (obj_type :f) = "fn [ - output fn_is_macro :f - ] - ] - ] - ] -] -output "false -end - -to _macroexpand :ast :env -if not macrocallp :ast :env [output :ast] -localmake "a0 nth :ast 0 -localmake "f env_get :env :a0 -output _macroexpand invoke_fn :f rest :ast :env -end - -to eval_ast :ast :env -output case (obj_type :ast) [ - [[symbol] env_get :env :ast] - [[list] obj_new "list map [_eval ? :env] obj_val :ast] - [[vector] obj_new "vector map [_eval ? :env] obj_val :ast] - [[hashmap] obj_new "hashmap map [_eval ? :env] obj_val :ast] - [else :ast] -] -end - to _eval :a_ast :a_env localmake "ast :a_ast localmake "env :a_env forever [ - if (obj_type :ast) <> "list [output eval_ast :ast :env] - make "ast _macroexpand :ast :env - if (obj_type :ast) <> "list [output eval_ast :ast :env] + ; (print "EVAL: pr_str :ast "true) + case (obj_type :ast) [ + [[symbol] output env_get :env :ast] + [[vector] output obj_new "vector map [_eval ? :env] obj_val :ast] + [[hashmap] output obj_new "hashmap map [_eval ? :env] obj_val :ast] + [[list]] + [else output :ast] + ] if emptyp obj_val :ast [output :ast] localmake "a0 nth :ast 0 case list obj_type :a0 obj_val :a0 [ @@ -98,9 +69,6 @@ forever [ [[[symbol quasiquote]] make "ast quasiquote nth :ast 1 ] ; TCO - [[[symbol quasiquoteexpand]] - output quasiquote nth :ast 1] - [[[symbol defmacro!]] localmake "a1 nth :ast 1 localmake "a2 nth :ast 2 @@ -108,9 +76,6 @@ forever [ fn_set_macro :macro_fn output env_set :env :a1 :macro_fn ] - [[[symbol macroexpand]] - output _macroexpand nth :ast 1 :env ] - [[[symbol try*]] localmake "a1 nth :ast 1 if (_count :ast) < 3 [ @@ -154,14 +119,18 @@ forever [ output fn_new nth :ast 1 :env nth :ast 2 ] [else - localmake "el eval_ast :ast :env - localmake "f nth :el 0 + localmake "f _eval :a0 :env + localmake "args rest :ast case obj_type :f [ [[nativefn] - output apply obj_val :f butfirst obj_val :el ] + output apply obj_val :f map [_eval ? :env] obj_val :args ] [[fn] - make "env env_new fn_env :f fn_args :f rest :el - make "ast fn_body :f ] ; TCO + ifelse (fn_is_macro :f) [ + make "ast invoke_fn :f :args + ] [ + make "env env_new fn_env :f fn_args :f obj_new "list map [_eval ? :env] obj_val :args + make "ast fn_body :f ] ; TCO + ] [else (throw "error [Wrong type for apply])] ] ] diff --git a/impls/make/stepA_mal.mk b/impls/make/stepA_mal.mk index fb5c4648b6..9f2462a34f 100644 --- a/impls/make/stepA_mal.mk +++ b/impls/make/stepA_mal.mk @@ -36,18 +36,6 @@ QUASIQUOTE = $(strip \ $(if $(_vector?), $(call _list,$(call _symbol,vec) $(QQ_FOLD)),\ $(if $(_symbol?)$(_hash_map?), $(call _list,$(call _symbol,quote) $1),\ $1)))) -define IS_MACRO_CALL -$(if $(call _list?,$(1)),$(if $(call ENV_FIND,$(2),$($(call _nth,$(1),0)_value)),$(_macro_$(call ENV_GET,$(2),$($(call _nth,$(1),0)_value))),),) -endef - -define MACROEXPAND -$(strip $(if $(__ERROR),,\ - $(if $(call IS_MACRO_CALL,$(1),$(2)),\ - $(foreach mac,$(call ENV_GET,$(2),$($(call _nth,$(1),0)_value)),\ - $(call MACROEXPAND,$(call apply,$(mac),$(call srest,$(1))),$(2))),\ - $(1)))) -endef - define LET $(strip \ $(word 1,$(2) \ @@ -60,25 +48,6 @@ $(strip \ $(call LET,$(left),$(2)))))))) endef -define EVAL_AST -$(strip \ - $(and $(EVAL_DEBUG),$(info EVAL_AST: $(call _pr_str,$(1))))\ - $(if $(call _symbol?,$(1)),\ - $(foreach key,$($(1)_value),\ - $(call ENV_GET,$(2),$(key))),\ - $(if $(call _list?,$(1)),\ - $(call _smap,EVAL,$(1),$(2)),\ - $(if $(call _vector?,$(1)),\ - $(call _smap_vec,EVAL,$(1),$(2)),\ - $(if $(call _hash_map?,$(1)),\ - $(foreach new_hmap,$(call __new_obj,hmap),\ - $(foreach v,$(call __get_obj_values,$(1)),\ - $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ - $(eval $(new_hmap)_size := $($(1)_size))\ - $(new_hmap)),\ - $(1)))))) -endef - define EVAL_INVOKE $(if $(__ERROR),,\ $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1)))) @@ -95,8 +64,6 @@ $(if $(__ERROR),,\ $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ $(if $(call _EQ,quote,$($(a0)_value)),\ $(call _nth,$(1),1),\ - $(if $(call _EQ,quasiquoteexpand,$($(a0)_value)),\ - $(call QUASIQUOTE,$(call _nth,$(1),1)),\ $(if $(call _EQ,quasiquote,$($(a0)_value)),\ $(call EVAL,$(call QUASIQUOTE,$(call _nth,$(1),1)),$(2)),\ $(if $(call _EQ,defmacro!,$($(a0)_value)),\ @@ -105,8 +72,6 @@ $(if $(__ERROR),,\ $(foreach res,$(call EVAL,$(a2),$(2)),\ $(eval _macro_$(res) = true)\ $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),)))),\ - $(if $(call _EQ,macroexpand,$($(a0)_value)),\ - $(call MACROEXPAND,$(call _nth,$(1),1),$(2)),\ $(if $(call _EQ,make*,$($(a0)_value)),\ $(foreach a1,$(call _nth,$(1),1),\ $(and $(EVAL_DEBUG),$(info make*: $$(eval __result := $(call str_decode,$(value $(a1)_value)))))\ @@ -127,7 +92,7 @@ $(if $(__ERROR),,\ $(res)))),\ $(res)))),\ $(if $(call _EQ,do,$($(a0)_value)),\ - $(call slast,$(call EVAL_AST,$(call srest,$(1)),$(2))),\ + $(call slast,$(call _smap,EVAL,$(call srest,$(1)),$(2))),\ $(if $(call _EQ,if,$($(a0)_value)),\ $(foreach a1,$(call _nth,$(1),1),\ $(foreach a2,$(call _nth,$(1),2),\ @@ -139,24 +104,32 @@ $(if $(__ERROR),,\ $(foreach a1,$(call _nth,$(1),1),\ $(foreach a2,$(call _nth,$(1),2),\ $(call _function,$$(call EVAL,$(a2),$$(call ENV,$(2),$(a1),$$1))))),\ - $(foreach el,$(call EVAL_AST,$(1),$(2)),\ - $(and $(EVAL_DEBUG),$(info invoke: $(call _pr_str,$(el))))\ - $(foreach f,$(call sfirst,$(el)),\ - $(foreach args,$(call srest,$(el)),\ - $(call apply,$(f),$(args))))))))))))))))))) + $(foreach f,$(call EVAL,$(a0),$(2)),\ + $(foreach args,$(call srest,$(1)),\ + $(if $(_macro_$(f)),\ + $(call EVAL,$(call apply,$(f),$(args)),$(2)),\ + $(call apply,$(f),$(call _smap,EVAL,$(args),$(2)))))))))))))))))) endef define EVAL $(strip $(if $(__ERROR),,\ $(and $(EVAL_DEBUG),$(info EVAL: $(call _pr_str,$(1))))\ + $(if $(call _symbol?,$(1)),\ + $(foreach key,$($(1)_value),\ + $(call ENV_GET,$(2),$(key))),\ + $(if $(call _vector?,$(1)),\ + $(call _smap_vec,EVAL,$(1),$(2)),\ + $(if $(call _hash_map?,$(1)),\ + $(foreach new_hmap,$(call __new_obj,hmap),\ + $(foreach v,$(call __get_obj_values,$(1)),\ + $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ + $(eval $(new_hmap)_size := $($(1)_size))\ + $(new_hmap)),\ $(if $(call _list?,$(1)),\ - $(foreach ast,$(call MACROEXPAND,$(1),$(2)), - $(if $(call _list?,$(ast)),\ - $(if $(call _EQ,0,$(call _count,$(ast))),\ - $(ast),\ - $(word 1,$(strip $(call EVAL_INVOKE,$(ast),$(2)) $(__nil)))),\ - $(call EVAL_AST,$(ast),$(2)))),\ - $(call EVAL_AST,$(1),$(2))))) + $(if $(call _EQ,0,$(call _count,$(1))),\ + $(1),\ + $(word 1,$(strip $(call EVAL_INVOKE,$(1),$(2)) $(__nil)))),\ + $(1))))))) endef diff --git a/impls/mal/stepA_mal.mal b/impls/mal/stepA_mal.mal index 14107acd6f..06fa0cf677 100644 --- a/impls/mal/stepA_mal.mal +++ b/impls/mal/stepA_mal.mal @@ -28,30 +28,6 @@ (= (first ast) 'unquote) (nth ast 1) "else" (qq-foldr ast)))) -(def! MACROEXPAND (fn* [ast env] - (let* [a0 (if (list? ast) (first ast)) - e (if (symbol? a0) (env-find env a0)) - m (if e (env-get e a0))] - (if (_macro? m) - (MACROEXPAND (apply (get m :__MAL_MACRO__) (rest ast)) env) - ast)))) - -(def! eval-ast (fn* [ast env] - ;; (do (prn "eval-ast" ast "/" (keys @env)) ) - (cond - (symbol? ast) (env-get env ast) - - (list? ast) (map (fn* [exp] (EVAL exp env)) ast) - - (vector? ast) (vec (map (fn* [exp] (EVAL exp env)) ast)) - - (map? ast) (apply hash-map - (apply concat - (map (fn* [k] [k (EVAL (get ast k) env)]) - (keys ast)))) - - "else" ast))) - (def! LET (fn* [env binds form] (if (empty? binds) (EVAL form env) @@ -62,10 +38,19 @@ (def! EVAL (fn* [ast env] ;; (do (prn "EVAL" ast "/" (keys @env)) ) (try* - (let* [ast (MACROEXPAND ast env)] - (if (not (list? ast)) - (eval-ast ast env) + (cond + (symbol? ast) + (env-get env ast) + + (vector? ast) + (vec (map (fn* [exp] (EVAL exp env)) ast)) + + (map? ast) + (apply hash-map + (apply concat + (map (fn* [k] [k (EVAL (get ast k) env)]) (keys ast)))) + (list? ast) ;; apply list (let* [a0 (first ast)] (cond @@ -81,9 +66,6 @@ (= 'quote a0) (nth ast 1) - (= 'quasiquoteexpand a0) - (QUASIQUOTE (nth ast 1)) - (= 'quasiquote a0) (EVAL (QUASIQUOTE (nth ast 1)) env) @@ -91,9 +73,6 @@ (env-set env (nth ast 1) (hash-map :__MAL_MACRO__ (EVAL (nth ast 2) env))) - (= 'macroexpand a0) - (MACROEXPAND (nth ast 1) env) - (= 'try* a0) (if (< (count ast) 3) (EVAL (nth ast 1) env) @@ -106,7 +85,7 @@ (EVAL (nth a2 2) (new-env env [(nth a2 1)] [exc]))))))) (= 'do a0) - (let* [el (eval-ast (rest ast) env)] + (let* [el (map (fn* [exp] (EVAL exp env)) (rest ast))] (nth el (- (count el) 1))) (= 'if a0) @@ -119,8 +98,14 @@ (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) "else" - (let* [el (eval-ast ast env)] - (apply (first el) (rest el))))))) + (let* [f (EVAL a0 env) + args (rest ast)] + (if (_macro? f) + (EVAL (apply (get f :__MAL_MACRO__) args) env) + (apply f (map (fn* [exp] (EVAL exp env)) args)))))) + + "else" + ast) (catch* exc (do diff --git a/impls/miniMAL/stepA_mal.json b/impls/miniMAL/stepA_mal.json index 4212b93522..423856c1e2 100644 --- a/impls/miniMAL/stepA_mal.json +++ b/impls/miniMAL/stepA_mal.json @@ -36,25 +36,16 @@ ["list", ["symbol", ["`", "quote"]], "ast"], "ast"]]]]], -["def", "macro?", ["fn", ["ast", "env"], - ["and", ["list?", "ast"], - ["symbol?", ["first", "ast"]], - ["not", ["=", null, ["env-find", "env", ["first", "ast"]]]], - ["let", ["fn", ["env-get", "env", ["first", "ast"]]], - ["and", ["malfunc?", "fn"], - ["get", "fn", ["`", "macro?"]]]]]]], - -["def", "macroexpand", ["fn", ["ast", "env"], - ["if", ["macro?", "ast", "env"], - ["let", ["mac", ["get", ["env-get", "env", ["first", "ast"]], ["`", "fn"]]], - ["macroexpand", ["apply", "mac", ["rest", "ast"]], "env"]], - "ast"]]], - -["def", "eval-ast", ["fn", ["ast", "env"], +["def", "LET", ["fn", ["env", "args"], + ["if", [">", ["count", "args"], 0], + ["do", + ["env-set", "env", ["nth", "args", 0], + ["EVAL", ["nth", "args", 1], "env"]], + ["LET", "env", ["rest", ["rest", "args"]]]]]]], + +["def", "EVAL", ["fn", ["ast", "env"], ["if", ["symbol?", "ast"], ["env-get", "env", "ast"], - ["if", ["list?", "ast"], - ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], ["if", ["vector?", "ast"], ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], ["if", ["map?", "ast"], @@ -65,21 +56,8 @@ ["EVAL", ["get", "ast", "k"], "env"]]], ["keys", "ast"]], "new-hm"]], - "ast"]]]]]], - -["def", "LET", ["fn", ["env", "args"], - ["if", [">", ["count", "args"], 0], - ["do", - ["env-set", "env", ["nth", "args", 0], - ["EVAL", ["nth", "args", 1], "env"]], - ["LET", "env", ["rest", ["rest", "args"]]]]]]], - -["def", "EVAL", ["fn", ["ast", "env"], ["if", ["not", ["list?", "ast"]], - ["eval-ast", "ast", "env"], - ["let", ["ast", ["macroexpand", "ast", "env"]], - ["if", ["not", ["list?", "ast"]], - ["eval-ast", "ast", "env"], + "ast", ["if", ["empty?", "ast"], "ast", ["let", ["a0", ["get", ["first", "ast"], ["`", "val"]]], @@ -93,8 +71,6 @@ ["EVAL", ["nth", "ast", 2], "let-env"]]], ["if", ["=", ["`", "quote"], "a0"], ["nth", "ast", 1], - ["if", ["=", ["`", "quasiquoteexpand"], "a0"], - ["quasiquote", ["nth", "ast", 1]], ["if", ["=", ["`", "quasiquote"], "a0"], ["EVAL", ["quasiquote", ["nth", "ast", 1]], "env"], ["if", ["=", ["`", "defmacro!"], "a0"], @@ -102,8 +78,6 @@ ["do", ["set", "func", ["`", "macro?"], true], ["env-set", "env", ["nth", "ast", 1], "func"]]], - ["if", ["=", ["`", "macroexpand"], "a0"], - ["macroexpand", ["nth", "ast", 1], "env"], ["if", ["=", ["`", "try*"], "a0"], ["if", ["and", [">", ["count", "ast"], 2], ["=", ["`", "catch*"], @@ -119,7 +93,7 @@ ["EVAL", ["nth", "ast", 1], "env"]], ["if", ["=", ["`", "do"], "a0"], ["do", - ["eval-ast", ["slice", "ast", 1, ["-", ["count", "ast"], 1]], "env"], + ["map", ["fn", ["x"], ["EVAL", "x", "env"]], ["slice", "ast", 1, ["-", ["count", "ast"], 1]], "env"], ["EVAL", ["nth", "ast", ["-", ["count", "ast"], 1]], "env"]], ["if", ["=", ["`", "if"], "a0"], ["let", ["cond", ["EVAL", ["nth", "ast", 1], "env"]], @@ -134,15 +108,16 @@ ["let", ["e", ["env-new", "env", ["nth", "ast", 1], "args"]], ["EVAL", ["nth", "ast", 2], "e"]]], ["nth", "ast", 2], "env", ["nth", "ast", 1]], - ["let", ["el", ["eval-ast", "ast", "env"], - "f", ["first", "el"], - "args", ["rest", "el"]], + ["let", ["f", ["EVAL", ["first", "ast"], "env"], + "args", ["rest", "ast"]], ["if", ["malfunc?", "f"], - ["EVAL", ["get", "f", ["`", "ast"]], + ["if", ["get", "f", ["`", "macro?"]], + ["EVAL", ["apply", ["get", "f", ["`", "fn"]], "args"], "env"], + ["EVAL", ["get", "f", ["`", "ast"]], ["env-new", ["get", "f", ["`", "env"]], ["get", "f", ["`", "params"]], - "args"]], - ["apply", "f", "args"]]]]]]]]]]]]]]]]]]]]], + ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "args"]]]], + ["apply", "f", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "args"]]]]]]]]]]]]]]]]]]]]], ["def", "PRINT", ["fn", ["exp"], ["pr-str", "exp", true]]], diff --git a/impls/nasm/stepA_mal.asm b/impls/nasm/stepA_mal.asm index 571f14cda4..97b4dae7e4 100644 --- a/impls/nasm/stepA_mal.asm +++ b/impls/nasm/stepA_mal.asm @@ -27,6 +27,9 @@ section .data static prompt_string, db 10,"user> " ; The string to print at the prompt + static eval_debug_string, db "EVAL: " + static eval_debug_cr, db 10 + static error_string, db 27,'[31m',"Error",27,'[0m',": " static not_found_string, db " not found" @@ -62,7 +65,6 @@ section .data static_symbol if_symbol, 'if' static_symbol fn_symbol, 'fn*' static_symbol defmacro_symbol, 'defmacro!' - static_symbol macroexpand_symbol, 'macroexpand' static_symbol try_symbol, 'try*' static_symbol catch_symbol, 'catch*' @@ -70,7 +72,6 @@ section .data static_symbol quote_symbol, 'quote' static_symbol quasiquote_symbol, 'quasiquote' - static_symbol quasiquoteexpand_symbol, 'quasiquoteexpand' static_symbol unquote_symbol, 'unquote' static_symbol splice_unquote_symbol, 'splice-unquote' static_symbol concat_symbol, 'concat' @@ -121,9 +122,32 @@ car_and_incref: ;; ;; Inputs: RSI Form to evaluate ;; RDI Environment +;; Returns: Result in RAX +;; Note: Both the form and environment will have their reference count +;; reduced by one (released). This is for tail call optimisation (Env), +;; quasiquote and macroexpand (AST) ;; -eval_ast: +eval: +;; ---------------------------------------------------------------------- +;; Uncomment these instructions to see most EVAL cycles +;; (values are not displayed, but quasiquote and macroexpand are :-) +;; ---------------------------------------------------------------------- + ;; push rdi + ;; mov r15, rsi + ;; print_str_mac eval_debug_string ; -> rsi, rdx -> + ;; mov rdi, 1 + ;; mov rsi, r15 + ;; call pr_str ; rdi, rsi -> rcx, r8, r12, r13, r14 -> rax + ;; mov rsi, rax + ;; call print_string ; rsi -> -> + ;; call release_array ; rsi -> [rsi], rax, rbx -> + ;; print_str_mac eval_debug_cr ; -> rsi, rdx -> + ;; mov rsi, r15 + ;; pop rdi + mov r15, rdi ; Save Env in r15 + + push rsi ; AST pushed, must be popped before return ; Check the type mov al, BYTE [rsi] @@ -148,7 +172,7 @@ eval_ast: call incref_object ; Increment reference count mov rax, rsi - ret + jmp .return .symbol: ; Check if first character of symbol is ':' @@ -205,16 +229,104 @@ eval_ast: ; Just return keywords unaltered call incref_object mov rax, rsi - ret + jmp .return ; ------------------------------ -.list: - ; Evaluate each element of the list - ; - xor r8, r8 ; The list to return - ; r9 contains head of list +.list_map_eval: + + ;; Some code is duplicated for the first element because + ;; the iteration must stop if its evaluation products a macro, + ;; else a new list must be constructed. + + ; Evaluate first element of the list + + mov al, BYTE [rsi] ; Check type + mov ah, al + and ah, content_mask + cmp ah, content_pointer + je .list_pointer_first + + ; A value in RSI, so copy + + call alloc_cons + mov bl, BYTE [rsi] + and bl, content_mask + add bl, (block_cons + container_list) + mov [rax], BYTE bl ; set type + mov rbx, [rsi + Cons.car] + mov [rax + Cons.car], rbx ; copy value + + ; Result in RAX + jmp .list_append_first +.list_pointer_first: + ; List element is a pointer to something + push rsi + push r15 ; Env + mov rdi, [rsi + Cons.car] ; Get the address + mov rsi, r15 + + call incref_object ; Environment increment refs + xchg rsi, rdi ; Env in RDI, AST in RSI + + call incref_object ; AST increment refs + + call eval ; Evaluate it, result in rax + pop r15 + pop rsi + + ; Check the type it's evaluated to + mov bl, BYTE [rax] + ;; If the evaluated first element is a macro, exit the loop. + cmp bl, maltype_macro + je macroexpand + mov bh, bl + and bh, (block_mask + container_mask) + cmp bh, (block_cons + container_value) + je .list_eval_value_first + + ; Not a value, so need a pointer to it + push rax + call alloc_cons + mov [rax], BYTE (block_cons + container_list + content_pointer) + pop rbx ; Address to point to + mov [rax + Cons.car], rbx + jmp .list_append_first + +.list_eval_value_first: + ; Got value in RAX, so copy + push rax + call alloc_cons ; Copy in RAX + pop rbx ; Value to copy in RBX + mov cl, BYTE [rbx] + and cl, content_mask + or cl, (block_cons + container_list) + mov [rax], BYTE cl ; set type + mov rcx, [rbx + Cons.car] + mov [rax + Cons.car], rcx ; copy value + ; Release the value in RBX + push rsi + push rax + mov rsi, rbx + call release_cons + pop rax + pop rsi + ; Fall through to .list_append_first +.list_append_first: + ; In RAX + ; r8 contains the head of the constructed list + ; append to r9 + mov r8, rax + mov r9, rax .list_loop: + ; Evaluate each element of the remaining list + + ; Check if there's another + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .list_done ; finished list + mov rsi, [rsi + Cons.cdr] ; next in list + mov al, BYTE [rsi] ; Check type mov ah, al and ah, content_mask @@ -292,32 +404,15 @@ eval_ast: ; Fall through to .list_append .list_append: ; In RAX - - cmp r8, 0 ; Check if this is the first - je .list_first - ; append to r9 mov [r9 + Cons.cdr], rax mov [r9 + Cons.typecdr], BYTE content_pointer mov r9, rax - jmp .list_next - -.list_first: - mov r8, rax - mov r9, rax - ; fall through to .list_next - -.list_next: - ; Check if there's another - mov al, BYTE [rsi + Cons.typecdr] - cmp al, content_pointer - jne .list_done ; finished list - mov rsi, [rsi + Cons.cdr] ; next in list jmp .list_loop .list_done: mov rax, r8 ; Return the list - ret + jmp eval.return_from_list_map_eval ; --------------------- .map: @@ -330,7 +425,7 @@ eval_ast: ; map empty. Just return it call incref_object mov rax, rsi - ret + jmp .return .map_not_empty: @@ -456,11 +551,11 @@ eval_ast: .map_done: mov rax, r12 - ret + jmp .return .map_error_missing_value: mov rax, r12 - ret + jmp .return ; ------------------------------ .vector: @@ -571,11 +666,11 @@ eval_ast: .vector_done: mov rax, r8 ; Return the vector - ret + jmp .return ; --------------------- .done: - ret + jmp .return ; Releases Env @@ -594,65 +689,15 @@ eval_ast: test rax, rax ; ZF set if rax = 0 (equal) %endmacro -;; ---------------------------------------------------- -;; Evaluates a form -;; -;; Input: RSI AST to evaluate [ Released ] -;; RDI Environment [ Released ] -;; -;; Returns: Result in RAX -;; -;; Note: Both the form and environment will have their reference count -;; reduced by one (released). This is for tail call optimisation (Env), -;; quasiquote and macroexpand (AST) -;; -eval: - mov r15, rdi ; Env - - push rsi ; AST pushed, must be popped before return - - ; Check type - mov al, BYTE [rsi] - cmp al, maltype_empty_list - je .empty_list ; empty list, return unchanged - - and al, container_mask - cmp al, container_list - je .list - - ; Not a list. Evaluate and return - call eval_ast - jmp .return ; Releases Env - ; -------------------- .list: ; A list - ; Macro expand - pop rax ; Old AST, discard from stack - call macroexpand ; Replaces RSI - push rsi ; New AST - - ; Check if RSI is a list, and if + ; Check if ; the first element is a symbol - mov al, BYTE [rsi] - - ; Check type - mov al, BYTE [rsi] cmp al, maltype_empty_list je .empty_list ; empty list, return unchanged - mov ah, al - and ah, container_mask - cmp ah, container_list - je .list_still_list - - ; Not a list, so call eval_ast on it - mov rdi, r15 ; Environment - call eval_ast - jmp .return - -.list_still_list: and al, content_mask cmp al, content_pointer jne .list_eval @@ -684,18 +729,12 @@ eval: eval_cmp_symbol quote_symbol ; quote je .quote_symbol - eval_cmp_symbol quasiquoteexpand_symbol - je .quasiquoteexpand_symbol - eval_cmp_symbol quasiquote_symbol ; quasiquote je .quasiquote_symbol eval_cmp_symbol defmacro_symbol ; defmacro! je .defmacro_symbol - eval_cmp_symbol macroexpand_symbol ; macroexpand - je .macroexpand_symbol - eval_cmp_symbol try_symbol ; try* je .try_symbol @@ -1468,20 +1507,6 @@ eval: ; ----------------------------- -;;; Like quasiquote, but do not evaluate the result. -.quasiquoteexpand_symbol: - ;; Return nil if no cdr - mov cl, BYTE [rsi + Cons.typecdr] - cmp cl, content_pointer - jne .return_nil - - mov rsi, [rsi + Cons.cdr] - call car_and_incref - call quasiquote - jmp .return - - ; ----------------------------- - .quasiquote_symbol: ; call quasiquote function with first argument @@ -1523,37 +1548,6 @@ eval: jmp eval ; Tail call - ; ----------------------------- -.macroexpand_symbol: - ; Check if we have a second list element - - mov al, BYTE [rsi + Cons.typecdr] - cmp al, content_pointer - jne .return_nil ; No argument - - mov rsi, [rsi + Cons.cdr] - - ; Check if this is a value or pointer - mov al, BYTE [rsi + Cons.typecar] - and al, content_mask - cmp al, content_pointer - je .macroexpand_pointer - - ; RSI contains a value. Remove the list container - mov [rsi + Cons.typecar], BYTE al - call incref_object - mov rax, rsi - jmp .return - -.macroexpand_pointer: - mov rsi, [rsi + Cons.car] - call incref_object ; Since RSI will be released - - call macroexpand ; May release and replace RSI - - mov rax, rsi - jmp .return ; Releases original AST - ; ----------------------------- .try_symbol: @@ -1773,7 +1767,8 @@ eval: push rsi mov rdi, r15 ; Environment push r15 - call eval_ast ; List of evaluated forms in RAX + jmp .list_map_eval ; List of evaluated forms in RAX +.return_from_list_map_eval pop r15 pop rsi @@ -2198,83 +2193,13 @@ qq_loop: ret - -;; Tests if an AST in RSI is a list containing -;; a macro defined in the ENV in R15 -;; -;; Inputs: AST in RSI (not modified) -;; ENV in R15 (not modified) -;; -;; Returns: Sets ZF if macro call. If set (true), -;; then the macro object is in RAX -;; -;; Modifies: -;; RAX -;; RBX -;; RCX -;; RDX -;; R8 -;; R9 -is_macro_call: - ; Test if RSI is a list which contains a pointer - mov al, BYTE [rsi] - cmp al, (block_cons + container_list + content_pointer) - jne .false - - ; Test if this is a symbol - mov rbx, [rsi + Cons.car] - mov al, BYTE [rbx] - cmp al, maltype_symbol - jne .false - - ; Look up symbol in Env - push rsi - push r15 - mov rdi, rbx ; symbol in RDI - mov rsi, r15 ; Environment in RSI - call env_get - pop r15 - pop rsi - jne .false ; Not in environment - - ; Object in RAX - ; If this is not a macro then needs to be released - mov dl, BYTE [rax] - - cmp dl, maltype_macro - je .true - - ; Not a macro, so release - mov r8, rsi - mov rsi, rax - call release_object - mov rsi, r8 - -.false: - lahf ; flags in AH - and ah, 255-64 ; clear zero flag - sahf - ret -.true: - mov rbx, rax ; Returning Macro object - lahf ; flags in AH - or ah, 64 ; set zero flag - sahf - mov rax, rbx - ret - ;; Expands macro calls ;; -;; Input: AST in RSI (released and replaced) -;; Env in R15 (not modified) -;; -;; Result: New AST in RSI +;; A part of eval, written here for historical reasons. +;; RSI: AST, a non-empty list (released and replaced) +;; RAX: evaluated first element of AST, a macro +;; R15: env macroexpand: - push r15 - - call is_macro_call - jne .done - mov r13, rsi mov rdi, rax ; Macro in RDI @@ -2312,13 +2237,11 @@ macroexpand: call apply_fn - mov rsi, rax ; Result in RSI - - pop r15 - jmp macroexpand -.done: - pop r15 - ret + mov rsi, rax ; Result in RSI + pop rdi ; env pushed as r15 by .list_eval + pop rax ; (ignored) ast pushed as r15 by .list_eval + pop rax ; (ignored) ast pushed as rsi by eval + jmp eval ;; Read and eval read_eval: diff --git a/impls/nim/stepA_mal.nim b/impls/nim/stepA_mal.nim index 509422ca93..cba751df0b 100644 --- a/impls/nim/stepA_mal.nim +++ b/impls/nim/stepA_mal.nim @@ -29,57 +29,33 @@ proc quasiquote(ast: MalType): MalType = else: result = ast -proc is_macro_call(ast: MalType, env: Env): bool = - ast.kind == List and ast.list.len > 0 and ast.list[0].kind == Symbol and - env.find(ast.list[0].str) != nil and env.get(ast.list[0].str).fun_is_macro - -proc macroexpand(ast: MalType, env: Env): MalType = - result = ast - while result.is_macro_call(env): - let mac = env.get(result.list[0].str) - result = mac.malfun.fn(result.list[1 .. ^1]).macroexpand(env) - -proc eval(ast: MalType, env: Env): MalType - -proc eval_ast(ast: MalType, env: var Env): MalType = - case ast.kind - of Symbol: - result = env.get(ast.str) - of List: - result = list ast.list.mapIt(it.eval(env)) - of Vector: - result = vector ast.list.mapIt(it.eval(env)) - of HashMap: - result = hash_map() - for k, v in ast.hash_map.pairs: - result.hash_map[k] = v.eval(env) - else: - result = ast - proc eval(ast: MalType, env: Env): MalType = var ast = ast var env = env - template defaultApply = - let el = ast.eval_ast(env) - let f = el.list[0] - case f.kind - of MalFun: - ast = f.malfun.ast - env = initEnv(f.malfun.env, f.malfun.params, list(el.list[1 .. ^1])) - else: - return f.fun(el.list[1 .. ^1]) - while true: - if ast.kind != List: return ast.eval_ast(env) - ast = ast.macroexpand(env) - if ast.kind != List: return ast.eval_ast(env) + # echo "EVAL: " & ast.pr_str + + case ast.kind + of Symbol: + return env.get(ast.str) + of List: + discard(nil) # Proceed after the case statement + of Vector: + return vector ast.list.mapIt(it.eval(env)) + of HashMap: + result = hash_map() + for k, v in ast.hash_map.pairs: + result.hash_map[k] = v.eval(env) + return result + else: + return ast + if ast.list.len == 0: return ast let a0 = ast.list[0] - case a0.kind - of Symbol: + if a0.kind == Symbol: case a0.str of "def!": let @@ -100,50 +76,44 @@ proc eval(ast: MalType, env: Env): MalType = else: raise newException(ValueError, "Illegal kind in let*") ast = a2 env = let_env - # Continue loop (TCO) + continue # TCO of "quote": return ast.list[1] - of "quasiquoteexpand": - return ast.list[1].quasiquote - of "quasiquote": ast = ast.list[1].quasiquote - # Continue loop (TCO) + continue # TCO of "defmacro!": var fun = ast.list[2].eval(env) fun.malfun.is_macro = true return env.set(ast.list[1].str, fun) - of "macroexpand": - return ast.list[1].macroexpand(env) - of "try*": let a1 = ast.list[1] if ast.list.len <= 2: - return a1.eval(env) + ast = a1 + continue # TCO let a2 = ast.list[2] - if a2.list[0].str == "catch*": - try: - return a1.eval(env) - except MalError: - let exc = (ref MalError) getCurrentException() - var catchEnv = initEnv(env, list a2.list[1], exc.t) - return a2.list[2].eval(catchEnv) - except: - let exc = getCurrentExceptionMsg() - var catchEnv = initEnv(env, list a2.list[1], list str(exc)) - return a2.list[2].eval(catchEnv) - else: + try: return a1.eval(env) + except MalError: + let exc = (ref MalError) getCurrentException() + env = initEnv(env, list a2.list[1], exc.t) + ast = a2.list[2] + continue # TCO + except: + let exc = getCurrentExceptionMsg() + env = initEnv(env, list a2.list[1], list str (exc)) + ast = a2.list[2] + continue # TCO of "do": let last = ast.list.high - discard (list ast.list[1 ..< last]).eval_ast(env) + discard (ast.list[1 ..< last].mapIt(it.eval(env))) ast = ast.list[last] - # Continue loop (TCO) + continue # TCO of "if": let @@ -152,9 +122,14 @@ proc eval(ast: MalType, env: Env): MalType = cond = a1.eval(env) if cond.kind in {Nil, False}: - if ast.list.len > 3: ast = ast.list[3] - else: ast = nilObj - else: ast = a2 + if ast.list.len > 3: + ast = ast.list[3] + continue # TCO + else: + return nilObj + else: + ast = a2 + continue # TCO of "fn*": let @@ -166,9 +141,17 @@ proc eval(ast: MalType, env: Env): MalType = a2.eval(newEnv) return malfun(fn, a2, a1, env) - else: defaultApply() + let f = eval(a0, env) + if f.fun_is_macro: + ast = f.malfun.fn(ast.list[1 .. ^1]) + continue # TCO + let args = ast.list[1 .. ^1].mapIt(it.eval(env)) + if f.kind == MalFun: + ast = f.malfun.ast + env = initEnv(f.malfun.env, f.malfun.params, list(args)) + continue # TCO - else: defaultApply() + return f.fun(args) proc print(exp: MalType): string = exp.pr_str diff --git a/impls/objpascal/stepA_mal.pas b/impls/objpascal/stepA_mal.pas index 1de57f5955..613a33f155 100644 --- a/impls/objpascal/stepA_mal.pas +++ b/impls/objpascal/stepA_mal.pas @@ -71,91 +71,6 @@ function quasiquote(Ast: TMal) : TMal; Exit(Res); end; -function is_macro_call(Ast: TMal; Env: TEnv): Boolean; -var - A0 : TMal; - Mac : TMal; -begin - is_macro_call := false; - if (Ast.ClassType = TMalList) and - (Length((Ast as TMalList).Val) > 0) then - begin - A0 := (Ast as TMalList).Val[0]; - if (A0 is TMalSymbol) and - (Env.Find(A0 as TMalSymbol) <> nil) then - begin - Mac := Env.Get((A0 as TMalSymbol)); - if Mac is TMalFunc then - is_macro_call := (Mac as TMalFunc).isMacro; - end; - end; - -end; - -// Forward declation since eval_ast call it -function EVAL(Ast: TMal; Env: TEnv) : TMal; forward; - -function macroexpand(Ast: TMal; Env: TEnv): TMal; -var - A0 : TMal; - Arr : TMalArray; - Args : TMalArray; - Mac : TMalFunc; -begin - while is_macro_call(Ast, Env) do - begin - Arr := (Ast as TMalList).Val; - A0 := Arr[0]; - Mac := Env.Get((A0 as TMalSymbol)) as TMalFunc; - Args := (Ast as TMalList).Rest.Val; - if Mac.Ast = nil then - Ast := Mac.Val(Args) - else - Ast := EVAL(Mac.Ast, - TEnv.Create(Mac.Env, Mac.Params, Args)); - end; - macroexpand := Ast; -end; - -function eval_ast(Ast: TMal; Env: TEnv) : TMal; -var - OldArr, NewArr : TMalArray; - OldDict, NewDict : TMalDict; - I : longint; -begin - if Ast is TMalSymbol then - begin - eval_ast := Env.Get((Ast as TMalSymbol)); - end - else if Ast is TMalList then - begin - OldArr := (Ast as TMalList).Val; - SetLength(NewArr, Length(OldArr)); - for I := 0 to Length(OldArr)-1 do - begin - NewArr[I] := EVAL(OldArr[I], Env); - end; - if Ast is TMalVector then - eval_ast := TMalVector.Create(NewArr) - else - eval_ast := TMalList.Create(NewArr); - end - else if Ast is TMalHashMap then - begin - OldDict := (Ast as TMalHashMap).Val; - NewDict := TMalDict.Create; - I := 0; - while I < OldDict.Count do - begin - NewDict[OldDict.Keys[I]] := EVAL(OldDict[OldDict.Keys[I]], Env); - I := I + 1; - end; - eval_ast := TMalHashMap.Create(NewDict); - end - else - eval_ast := Ast; -end; - function EVAL(Ast: TMal; Env: TEnv) : TMal; var Lst : TMalList; @@ -168,15 +83,33 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; Fn : TMalFunc; Args : TMalArray; Err : TMalArray; + OldDict, NewDict : TMalDict; begin while true do begin - if Ast.ClassType <> TMalList then - Exit(eval_ast(Ast, Env)); - Ast := macroexpand(Ast, Env); - if Ast.ClassType <> TMalList then - Exit(eval_ast(Ast, Env)); + // WriteLn('EVAL: ' + PRINT(Ast)); + + if Ast is TMalSymbol then + Exit(Env.Get((Ast as TMalSymbol))) + else if Ast is TMalVector then + begin + Arr := (Ast as TMalVector).Val; + SetLength(Arr1, Length(Arr)); + for I := 0 to Length(Arr)-1 do + Arr1[I]:= EVAL(Arr[I], Env); + Exit(TMalVector.Create(Arr1)); + end + else if Ast is TMalHashMap then + begin + OldDict := (Ast as TMalHashMap).Val; + NewDict := TMalDict.Create; + for I := 0 to OldDict.Count-1 do + NewDict[OldDict.Keys[I]]:= EVAL(OldDict[OldDict.Keys[I]], Env); + Exit(TMalHashMap.Create(NewDict)); + end + else if not (Ast is TMalList) then + Exit(Ast); // Apply list Lst := (Ast as TMalList); @@ -206,8 +139,6 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; end; 'quote': Exit(Arr[1]); - 'quasiquoteexpand': - Exit(quasiquote(Arr[1])); 'quasiquote': Ast := quasiquote(Arr[1]); 'defmacro!': @@ -216,8 +147,6 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; Fn.isMacro := true; Exit(Env.Add((Arr[1] as TMalSymbol), Fn)); end; - 'macroexpand': - Exit(macroexpand(Arr[1], Env)); 'try*': begin try @@ -241,7 +170,8 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; end; 'do': begin - eval_ast(TMalList.Create(copy(Arr,1, Length(Arr)-2)), Env); + for I := 1 to Length(Arr) - 2 do + Cond := EVAL(Arr[I], Env); Ast := Arr[Length(Arr)-1]; // TCO end; 'if': @@ -261,14 +191,21 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; end; else begin - Arr := (eval_ast(Ast, Env) as TMalList).Val; - if Arr[0] is TMalFunc then + Cond := EVAL(Arr[0], Env); + Args := copy(Arr, 1, Length(Arr) - 1); + if Cond is TMalFunc then begin - Fn := Arr[0] as TMalFunc; - if Length(Arr) < 2 then - SetLength(Args, 0) - else - Args := copy(Arr, 1, Length(Arr)-1); + Fn := Cond as TMalFunc; + if Fn.isMacro then + begin + if Fn.Ast =nil then + Ast := Fn.Val(Args) + else + Ast := EVAL(Fn.Ast, Tenv.Create(Fn.Env, Fn.Params, Args)); + continue; // TCO + end; + for I := 0 to Length(Args) - 1 do + Args[I]:= EVAL(Args[I], Env); if Fn.Ast = nil then Exit(Fn.Val(Args)) else diff --git a/impls/ocaml/stepA_mal.ml b/impls/ocaml/stepA_mal.ml index 9c4689f3a8..ce948daaa2 100644 --- a/impls/ocaml/stepA_mal.ml +++ b/impls/ocaml/stepA_mal.ml @@ -16,31 +16,11 @@ and qq_folder elt acc = | T.List {T.value = [T.Symbol {T.value = "splice-unquote"}; x]} -> Types.list [Types.symbol "concat"; x; acc] | _ -> Types.list [Types.symbol "cons"; quasiquote elt; acc] -let is_macro_call ast env = - match ast with - | T.List { T.value = s :: args } -> - (match (try Env.get env s with _ -> T.Nil) with - | T.Fn { T.meta = T.Map { T.value = meta } } - -> Types.MalMap.mem Core.kw_macro meta && Types.to_bool (Types.MalMap.find Core.kw_macro meta) - | _ -> false) - | _ -> false - -let rec macroexpand ast env = - if is_macro_call ast env - then match ast with - | T.List { T.value = s :: args } -> - (match (try Env.get env s with _ -> T.Nil) with - | T.Fn { T.value = f } -> macroexpand (f args) env - | _ -> ast) - | _ -> ast - else ast - -let rec eval_ast ast env = +let rec eval ast env = + (* output_string stderr ("EVAL: " ^ (Printer.pr_str ast true) ^ "\n"); *) + (* flush stderr; *) match ast with | T.Symbol s -> Env.get env ast - | T.List { T.value = xs; T.meta = meta } - -> T.List { T.value = (List.map (fun x -> eval x env) xs); - T.meta = meta } | T.Vector { T.value = xs; T.meta = meta } -> T.Vector { T.value = (List.map (fun x -> eval x env) xs); T.meta = meta } @@ -51,10 +31,6 @@ let rec eval_ast ast env = -> Types.MalMap.add (eval k env) (eval v env) m) xs Types.MalMap.empty)} - | _ -> ast -and eval ast env = - match macroexpand ast env with - | T.List { T.value = [] } -> ast | T.List { T.value = [(T.Symbol { T.value = "def!" }); key; expr] } -> let value = (eval expr env) in Env.set env key value; value @@ -97,12 +73,8 @@ and eval ast env = in bind_args arg_names args; eval expr sub_env) | T.List { T.value = [T.Symbol { T.value = "quote" }; ast] } -> ast - | T.List { T.value = [T.Symbol { T.value = "quasiquoteexpand" }; ast] } -> - quasiquote ast | T.List { T.value = [T.Symbol { T.value = "quasiquote" }; ast] } -> eval (quasiquote ast) env - | T.List { T.value = [T.Symbol { T.value = "macroexpand" }; ast] } -> - macroexpand ast env | T.List { T.value = [T.Symbol { T.value = "try*" }; scary]} -> (eval scary env) | T.List { T.value = [T.Symbol { T.value = "try*" }; scary ; @@ -117,11 +89,15 @@ and eval ast env = let sub_env = Env.make (Some env) in Env.set sub_env local value; eval handler sub_env) - | T.List _ as ast -> - (match eval_ast ast env with - | T.List { T.value = ((T.Fn { T.value = f }) :: args) } -> f args + | T.List { T.value = (a0 :: args) } -> + (match eval a0 env with + | T.Fn { T.value = f; T.meta = T.Map { T.value = meta } } -> + if Types.MalMap.mem Core.kw_macro meta && Types.to_bool (Types.MalMap.find Core.kw_macro meta) + then eval (f args) env + else f (List.map (fun x -> eval x env) args) + | T.Fn { T.value = f } -> f (List.map (fun x -> eval x env) args) | _ -> raise (Invalid_argument "Cannot invoke non-function")) - | ast -> eval_ast ast env + | _ -> ast let read str = Reader.read_str str let print exp = Printer.pr_str exp true diff --git a/impls/perl/stepA_mal.pl b/impls/perl/stepA_mal.pl index f62aa5a7d8..b0d63f2500 100644 --- a/impls/perl/stepA_mal.pl +++ b/impls/perl/stepA_mal.pl @@ -54,56 +54,21 @@ sub quasiquote { } } -sub is_macro_call { - my ($ast, $env) = @_; - if ($ast->isa('Mal::List') && - $ast->[0]->isa('Mal::Symbol') && - $env->find($ast->[0])) { - my ($f) = $env->get($ast->[0]); - return $f->isa('Mal::Macro'); - } - return 0; -} - -sub macroexpand { - my ($ast, $env) = @_; - while (is_macro_call($ast, $env)) { - my @args = @$ast; - my $mac = $env->get(shift @args); - $ast = &$mac(@args); - } - return $ast; -} - - -sub eval_ast { +sub EVAL { my($ast, $env) = @_; + #print "EVAL: " . printer::_pr_str($ast) . "\n"; + if ($ast->isa('Mal::Symbol')) { return $env->get($ast); - } elsif ($ast->isa('Mal::Sequence')) { + } elsif ($ast->isa('Mal::Vector')) { return ref($ast)->new([ map { EVAL($_, $env) } @$ast ]); } elsif ($ast->isa('Mal::HashMap')) { return Mal::HashMap->new({ pairmap { $a => EVAL($b, $env) } %$ast }); - } else { + } elsif (! $ast->isa('Mal::List')) { return $ast; } -} - -sub EVAL { - my($ast, $env) = @_; - - #print "EVAL: " . printer::_pr_str($ast) . "\n"; - if (! $ast->isa('Mal::List')) { - goto &eval_ast; - } - @$ast or return $ast; # apply list - $ast = macroexpand($ast, $env); - if (! $ast->isa('Mal::List')) { - @_ = ($ast, $env); - goto &eval_ast; - } unless (@$ast) { return $ast; } my ($a0) = @$ast; @@ -125,9 +90,6 @@ sub EVAL { when ('quote') { return $ast->[1]; } - when ('quasiquoteexpand') { - return quasiquote($ast->[1]); - } when ('quasiquote') { @_ = (quasiquote($ast->[1]), $env); goto &EVAL; @@ -136,10 +98,6 @@ sub EVAL { my (undef, $sym, $val) = @$ast; return $env->set($sym, Mal::Macro->new(EVAL($val, $env)->clone)); } - when ('macroexpand') { - @_ = ($ast->[1], $env); - goto ¯oexpand; - } when ('try*') { my (undef, $try, $catch) = @$ast; local $@; @@ -164,7 +122,7 @@ sub EVAL { when ('do') { my (undef, @todo) = @$ast; my $last = pop @todo; - eval_ast(Mal::List->new(\@todo), $env); + map { EVAL($_, $env) } @todo; @_ = ($last, $env); goto &EVAL; } @@ -187,8 +145,13 @@ sub EVAL { }); } default { - @_ = @{eval_ast($ast, $env)}; - my $f = shift; + my $f = EVAL($a0, $env); + my (undef, @args) = @$ast; + if ($f->isa('Mal::Macro')) { + @_ = (&$f(@args), $env); + goto &EVAL; + } + @_ = map { EVAL($_, $env) } @args; goto &$f; } } diff --git a/impls/perl6/stepA_mal.pl b/impls/perl6/stepA_mal.pl index e6854348c3..07db86ce32 100644 --- a/impls/perl6/stepA_mal.pl +++ b/impls/perl6/stepA_mal.pl @@ -10,16 +10,6 @@ ($str) return read_str($str); } -sub eval_ast ($ast, $env) { - given $ast { - when MalSymbol { $env.get($ast.val) || die X::MalNotFound.new(name => $ast.val) } - when MalList { MalList([$ast.map({ eval($_, $env) })]) } - when MalVector { MalVector([$ast.map({ eval($_, $env) })]) } - when MalHashMap { MalHashMap($ast.kv.map({ $^a => eval($^b, $env) }).Hash) } - default { $ast // $NIL } - } -} - sub qqLoop ($ast) { my $acc = MalList([]); for |$ast.val.reverse -> $elt { @@ -50,24 +40,19 @@ ($ast) } } -sub is_macro_call ($ast, $env) { - return so $ast ~~ MalList && $ast[0] ~~ MalSymbol - && $env.find($ast[0].val).?get($ast[0].val).?is_macro; -} - -sub macroexpand ($ast is copy, $env is copy) { - while is_macro_call($ast, $env) { - my $func = $env.get($ast[0].val); - $ast = $func.apply($ast[1..*]); - } - return $ast; -} - sub eval ($ast is copy, $env is copy) { loop { - return eval_ast($ast, $env) if $ast !~~ MalList; - $ast = macroexpand($ast, $env); - return eval_ast($ast, $env) if $ast !~~ MalList; + + # say "EVAL" ~ print($line); + + given $ast { + when MalSymbol { return $env.get($ast.val) || die X::MalNotFound.new(name => $ast.val) } + when MalList { } + when MalVector { return MalVector([$ast.map({ eval($_, $env) })]) } + when MalHashMap { return MalHashMap($ast.kv.map({ $^a => eval($^b, $env) }).Hash) } + default { return $ast // $NIL } + } + return $ast if !$ast.elems; my ($a0, $a1, $a2, $a3) = $ast.val; @@ -84,7 +69,7 @@ ($ast is copy, $env is copy) $ast = $a2; } when 'do' { - eval_ast(MalList([$ast[1..*-2]]), $env); + $ast[1..*-2].map({ eval($_, $env) }); $ast = $ast[*-1]; } when 'if' { @@ -104,14 +89,12 @@ ($ast is copy, $env is copy) return MalFunction($a2, $env, @binds, &fn); } when 'quote' { return $a1 } - when 'quasiquoteexpand' { return quasiquote($a1) } when 'quasiquote' { $ast = quasiquote($a1) } when 'defmacro!' { my $func = eval($a2, $env); $func.is_macro = True; return $env.set($a1.val, $func); } - when 'macroexpand' { return macroexpand($a1, $env) } when 'try*' { return eval($a1, $env); CATCH { @@ -123,7 +106,13 @@ ($ast is copy, $env is copy) } } default { - my ($func, @args) = eval_ast($ast, $env).val; + my $func = eval($a0, $env); + my @args = $ast[1..*]; + if $func.?is_macro { + $ast = $func.apply(@args); + next; + } + @args = @args.map({ eval($_, $env) }); return $func.apply(|@args) if $func !~~ MalFunction; $ast = $func.ast; $env = MalEnv.new($func.env, $func.params, @args); diff --git a/impls/php/stepA_mal.php b/impls/php/stepA_mal.php index 3565a3d9ae..e9c4532499 100644 --- a/impls/php/stepA_mal.php +++ b/impls/php/stepA_mal.php @@ -47,32 +47,15 @@ function quasiquote($ast) { } } -function is_macro_call($ast, $env) { - return _list_Q($ast) && - count($ast) >0 && - _symbol_Q($ast[0]) && - $env->find($ast[0]) && - $env->get($ast[0])->ismacro; -} +function MAL_EVAL($ast, $env) { + while (true) { -function macroexpand($ast, $env) { - while (is_macro_call($ast, $env)) { - $mac = $env->get($ast[0]); - $args = array_slice($ast->getArrayCopy(),1); - $ast = $mac->apply($args); - } - return $ast; -} + #echo "EVAL: " . _pr_str($ast) . "\n"; -function eval_ast($ast, $env) { if (_symbol_Q($ast)) { return $env->get($ast); - } elseif (_sequential_Q($ast)) { - if (_list_Q($ast)) { - $el = _list(); - } else { - $el = _vector(); - } + } elseif (_vector_Q($ast)) { + $el = _vector(); foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; } elseif (_hash_map_Q($ast)) { @@ -81,24 +64,10 @@ function eval_ast($ast, $env) { $new_hm[$key] = MAL_EVAL($ast[$key], $env); } return $new_hm; - } else { + } elseif (!_list_Q($ast)) { return $ast; } -} - -function MAL_EVAL($ast, $env) { - while (true) { - #echo "MAL_EVAL: " . _pr_str($ast) . "\n"; - if (!_list_Q($ast)) { - return eval_ast($ast, $env); - } - - // apply list - $ast = macroexpand($ast, $env); - if (!_list_Q($ast)) { - return eval_ast($ast, $env); - } if ($ast->count() === 0) { return $ast; } @@ -120,8 +89,6 @@ function MAL_EVAL($ast, $env) { break; // Continue loop (TCO) case "quote": return $ast[1]; - case "quasiquoteexpand": - return quasiquote($ast[1]); case "quasiquote": $ast = quasiquote($ast[1]); break; // Continue loop (TCO) @@ -129,8 +96,6 @@ function MAL_EVAL($ast, $env) { $func = MAL_EVAL($ast[2], $env); $func->ismacro = true; return $env->set($ast[1], $func); - case "macroexpand": - return macroexpand($ast[1], $env); case "php*": $res = eval($ast[1]); return _to_mal($res); @@ -153,7 +118,7 @@ function MAL_EVAL($ast, $env) { return MAL_EVAL($a1, $env); } case "do": - eval_ast($ast->slice(1, -1), $env); + foreach ($ast->slice(1, -1) as $a) { MAL_EVAL($a, $env); } $ast = $ast[count($ast)-1]; break; // Continue loop (TCO) case "if": @@ -171,9 +136,14 @@ function MAL_EVAL($ast, $env) { case "to-native": return _to_native($ast[1]->value, $env); default: - $el = eval_ast($ast, $env); - $f = $el[0]; - $args = array_slice($el->getArrayCopy(), 1); + $f = MAL_EVAL($a0, $env); + $unevaluated_args = array_slice($ast->getArrayCopy(), 1); + if ($f->ismacro) { + $ast = $f->apply($unevaluated_args); + continue; // TCO + } + $args = []; + foreach ($unevaluated_args as $a) { $args[] = MAL_EVAL($a, $env); } if ($f->type === 'native') { $ast = $f->ast; $env = $f->gen_env($args); diff --git a/impls/picolisp/stepA_mal.l b/impls/picolisp/stepA_mal.l index ab54bb255d..8e4e05c6dd 100644 --- a/impls/picolisp/stepA_mal.l +++ b/impls/picolisp/stepA_mal.l @@ -41,29 +41,14 @@ ((map symbol) (MAL-list (list (MAL-symbol 'quote) Ast))) (T Ast))) -(de is-macro-call (Ast Env) - (when (= (MAL-type Ast) 'list) - (let A0 (car (MAL-value Ast)) - (when (= (MAL-type A0) 'symbol) - (let Value (find> Env (MAL-value A0)) - (and (isa '+Func Value) (get Value 'is-macro) T) ) ) ) ) ) - -(de macroexpand (Ast Env) - (while (is-macro-call Ast Env) - (let (Ast* (MAL-value Ast) - Macro (get (find> Env (MAL-value (car Ast*))) 'fn) - Args (cdr Ast*) ) - (setq Ast (apply (MAL-value Macro) Args)) ) ) - Ast ) - (de EVAL (Ast Env) (catch 'done (while t - (when (not (= (MAL-type Ast) 'list)) - (throw 'done (eval-ast Ast Env)) ) - (setq Ast (macroexpand Ast Env)) - (when (or (not (= (MAL-type Ast) 'list)) (not (MAL-value Ast))) - (throw 'done (eval-ast Ast Env)) ) + # (prinl "EVAL: " (pr-str Ast)) + (case (MAL-type Ast) + (list + + (if (MAL-value Ast) (let (Ast* (MAL-value Ast) A0* (MAL-value (car Ast*)) A1 (cadr Ast*) @@ -75,16 +60,12 @@ (throw 'done (set> Env A1* (EVAL A2 Env))) ) ((= A0* 'quote) (throw 'done A1) ) - ((= A0* 'quasiquoteexpand) - (throw 'done (quasiquote A1))) ((= A0* 'quasiquote) (setq Ast (quasiquote A1)) ) # TCO ((= A0* 'defmacro!) (let Form (EVAL A2 Env) (put Form 'is-macro T) (throw 'done (set> Env A1* Form)) ) ) - ((= A0* 'macroexpand) - (throw 'done (macroexpand A1 Env)) ) ((= A0* 'try*) (let Result (catch 'err (throw 'done (EVAL A1 Env))) (if (isa '+MALError Result) @@ -123,22 +104,21 @@ (EVAL Body Env*) ) ) ) ) (throw 'done (MAL-func Env Body Binds Fn)) ) ) (T - (let (Ast* (MAL-value (eval-ast Ast Env)) - Fn (car Ast*) + (let (Fn (EVAL (car Ast*) Env) Args (cdr Ast*) ) + (if (get Fn 'is-macro) + (setq Ast (apply (MAL-value (get Fn 'fn)) Args)) # TCO + (let Args (mapcar '((Form) (EVAL Form Env)) Args) (if (isa '+MALFn Fn) (throw 'done (apply (MAL-value Fn) Args)) (let Env* (MAL-env (get Fn 'env) (get Fn 'params) Args) - (setq Ast (get Fn 'ast) Env Env*) ) ) ) ) ) ) ) ) ) - -(de eval-ast (Ast Env) - (let Value (MAL-value Ast) - (case (MAL-type Ast) - (symbol (get> Env Value)) - (list (MAL-list (mapcar '((Form) (EVAL Form Env)) Value))) - (vector (MAL-vector (mapcar '((Form) (EVAL Form Env)) Value))) - (map (MAL-map (mapcar '((Form) (EVAL Form Env)) Value))) - (T Ast) ) ) ) + (setq Ast (get Fn 'ast) Env Env*) ) ) ) ) ) ) ) ) + (throw 'done Ast))) ; () + + (symbol (throw 'done (get> Env (MAL-value Ast)))) + (vector (throw 'done (MAL-vector (mapcar '((Form) (EVAL Form Env)) (MAL-value Ast))))) + (map (throw 'done (MAL-map (mapcar '((Form) (EVAL Form Env)) (MAL-value Ast))))) + (T (throw 'done Ast)) ) ) ) ) (set> *ReplEnv 'eval (MAL-fn (curry (*ReplEnv) (Form) (EVAL Form *ReplEnv)))) (set> *ReplEnv '*ARGV* (MAL-list (mapcar MAL-string (cdr (argv))))) diff --git a/impls/pike/stepA_mal.pike b/impls/pike/stepA_mal.pike index f2a9c64a63..035293983e 100644 --- a/impls/pike/stepA_mal.pike +++ b/impls/pike/stepA_mal.pike @@ -50,37 +50,18 @@ Val quasiquote(Val ast) } } -bool is_macro_call(Val ast, Env env) -{ - if(ast.mal_type == MALTYPE_LIST && - !ast.emptyp() && - ast.data[0].mal_type == MALTYPE_SYMBOL && - env.find(ast.data[0])) - { - Val v = env.get(ast.data[0]); - if(objectp(v) && v.macro) return true; - } - return false; -} - -Val macroexpand(Val ast, Env env) +Val EVAL(Val ast, Env env) { - while(is_macro_call(ast, env)) + while(true) { - Val macro = env.get(ast.data[0]); - ast = macro(@ast.data[1..]); - } - return ast; -} + // write(({ "EVAL: ", PRINT(ast), "\n" })); -Val eval_ast(Val ast, Env env) -{ switch(ast.mal_type) { case MALTYPE_SYMBOL: return env.get(ast); case MALTYPE_LIST: - return List(map(ast.data, lambda(Val e) { return EVAL(e, env); })); + break; case MALTYPE_VECTOR: return Vector(map(ast.data, lambda(Val e) { return EVAL(e, env); })); case MALTYPE_MAP: @@ -92,16 +73,8 @@ Val eval_ast(Val ast, Env env) return Map(elements); default: return ast; - } -} + } -Val EVAL(Val ast, Env env) -{ - while(true) - { - if(ast.mal_type != MALTYPE_LIST) return eval_ast(ast, env); - ast = macroexpand(ast, env); - if(ast.mal_type != MALTYPE_LIST) return eval_ast(ast, env); if(ast.emptyp()) return ast; if(ast.data[0].mal_type == MALTYPE_SYMBOL) { switch(ast.data[0].value) @@ -120,16 +93,12 @@ Val EVAL(Val ast, Env env) continue; // TCO case "quote": return ast.data[1]; - case "quasiquoteexpand": - return quasiquote(ast.data[1]); case "quasiquote": ast = quasiquote(ast.data[1]); continue; // TCO case "defmacro!": Val macro = EVAL(ast.data[2], env).clone_as_macro(); return env.set(ast.data[1], macro); - case "macroexpand": - return macroexpand(ast.data[1], env); case "try*": if(ast.count() < 3) return EVAL(ast.data[1], env); if(mixed err = catch { return EVAL(ast.data[1], env); } ) @@ -168,15 +137,20 @@ Val EVAL(Val ast, Env env) lambda(Val ... a) { return EVAL(ast.data[2], Env(env, ast.data[1], List(a))); }); } } - Val evaled_ast = eval_ast(ast, env); - Val f = evaled_ast.data[0]; + Val f = EVAL(ast.data[0], env); + array(Val) args = ast.data[1..]; switch(f.mal_type) { case MALTYPE_BUILTINFN: - return f(@evaled_ast.data[1..]); + return f(@map(args, lambda(Val e) { return EVAL(e, env);})); case MALTYPE_FN: + if(f.macro) + { + ast = f(@args); + continue; // TCO + } ast = f.ast; - env = Env(f.env, f.params, List(evaled_ast.data[1..])); + env = Env(f.env, f.params, List(map(args, lambda(Val e) { return EVAL(e, env);}))); continue; // TCO default: throw("Unknown function type"); diff --git a/impls/prolog/stepA_mal.pl b/impls/prolog/stepA_mal.pl index 0f713d70f6..d87a9f7fdc 100644 --- a/impls/prolog/stepA_mal.pl +++ b/impls/prolog/stepA_mal.pl @@ -68,10 +68,6 @@ eval_list(_, quote, Args, Res) :- !, check(Args = [Res], "quote: expects 1 argument, got ~L", [Args]). -eval_list(_, quasiquoteexpand, Args, Res) :- !, - check(Args = [X], "quasiquoteexpand: expects 1 argument, got: ~L", [Args]), - quasiquote(X, Res). - eval_list(Env, quasiquote, Args, Res) :- !, check(Args = [X], "quasiquote: expects 1 argument, got: ~L", [Args]), quasiquote(X, Y), @@ -126,19 +122,6 @@ mal_macro(Fn, Res), env_set(Env, Key, Res). -eval_list(Env, macroexpand, Args, Res) :- !, - check(Args = [X], "macroexpand: expects 1 argument, got: ~L", [Args]), - macroexpand(Env, X, Res). - -macroexpand(Env, Ast, Res) :- - list([Key | Args], Ast), - env_get(Env, Key, Macro), - mal_macro(Fn, Macro), !, - mal_fn(Goal, Fn), - call(Goal, Args, New_Ast), - macroexpand(Env, New_Ast, Res). -macroexpand(_, Ast, Ast). - % apply phase eval_list(Env, First, Rest, Res) :- diff --git a/impls/ps/stepA_mal.ps b/impls/ps/stepA_mal.ps index 21be2f1b82ee1f51aa3a3de2822d348923cae4ef..fedb8a7b3627c87062a5499b31273799b7791583 100644 GIT binary patch delta 608 zcmZqk`R}qppLKEr7YC!!Tw;u3}UjKt!M z_}oOGnbniGarQ`p1#>csOY9Z$@=Fw|!HPkaOb+5!o7};wxLKa(1=Hpv{usv1!h**b zmGn~*OA-~*Q-Nv~QuE3bKu%F8$S+W+RY=P(O3caOn(QknyO~|skc&If0IpXIm*G7Nr*}1?!XjQzFK#U4vL)4Q*;{mRlNBg!u+3vQx+Xm7QJb5xP zW`2NNO*|O;1N7uY6AvbyP5cF(J>bmSwOy)BwmbRW_h!ENX7=db^Nn|9V^#%LLsWgw zstU)cKo^#wrm7)q%er!L%UHnIqdDwk<{k%ojcrd;O3DVY2r7UGGa>PlZif%)W!cKD zf!lT*a3y6PTvINe7ezzhB zxefB+xP^TJyTa)-3rK1Ri(t9o6T;aaZi#Cq+=DW+__2IR|9snaJW+%DTk9LdPTBZ% zq>z!jDx`b(Y-DN)9M5Zl&O#T>WG}KK9E-DcVQFZt#nRQkrz@}kO<%cD;k7mVWZb$BpBlTw{m}~#XJ&BT$fcI?rZJlW+%#74rE%j{%!y=F!1cIu-aC$j zR^NA zS+9{9KQSMddtb8O zQsYS((Da(UkEb7*6J<%|lTHZyH8MFzXtaPF*vcnHiNuQP&I;4fD(3M@VGTbNPU6q$ YbzCjp>3uF{Q#6@V_ MalVal { } } -fn is_macro_call(ast: &MalVal, env: &Env) -> Option<(MalVal, MalArgs)> { - match ast { - List(v, _) => match v[0] { - Sym(ref s) => match env_find(env, s) { - Some(e) => match env_get(&e, &v[0]) { - Ok(f @ MalFunc { is_macro: true, .. }) => Some((f, v[1..].to_vec())), - _ => None, - }, - _ => None, - }, - _ => None, - }, - _ => None, - } +fn eval_ast(v: &MalArgs, env: &Env) -> Result { + let mut lst: MalArgs = vec![]; + for a in v.iter() { + match eval(a.clone(), env.clone()) { + Ok(elt) => lst.push(elt), + Err(e) => return Err(e), + } + } + return Ok(lst); } -fn macroexpand(mut ast: MalVal, env: &Env) -> (bool, MalRet) { - let mut was_expanded = false; - while let Some((mf, args)) = is_macro_call(&ast, env) { - //println!("macroexpand 1: {:?}", ast); - ast = match mf.apply(args) { - Err(e) => return (false, Err(e)), - Ok(a) => a, - }; - //println!("macroexpand 2: {:?}", ast); - was_expanded = true; - } - ((was_expanded, Ok(ast))) -} +fn eval(mut ast: MalVal, mut env: Env) -> MalRet { + let ret: MalRet; -fn eval_ast(ast: &MalVal, env: &Env) -> MalRet { - match ast { + 'tco: loop { + // println(print(ast)); + ret = match ast { Sym(_) => Ok(env_get(&env, &ast)?), - List(v, _) => { - let mut lst: MalArgs = vec![]; - for a in v.iter() { - lst.push(eval(a.clone(), env.clone())?) - } - Ok(list!(lst)) - } - Vector(v, _) => { - let mut lst: MalArgs = vec![]; - for a in v.iter() { - lst.push(eval(a.clone(), env.clone())?) - } - Ok(vector!(lst)) + Vector(ref v, _) => match eval_ast(&v, &env) { + Ok(lst) => Ok(vector!(lst)), + Err(e) => Err(e), } Hash(hm, _) => { let mut new_hm: FnvHashMap = FnvHashMap::default(); @@ -124,28 +99,7 @@ fn eval_ast(ast: &MalVal, env: &Env) -> MalRet { } Ok(Hash(Rc::new(new_hm), Rc::new(Nil))) } - _ => Ok(ast.clone()), - } -} - -fn eval(mut ast: MalVal, mut env: Env) -> MalRet { - let ret: MalRet; - - 'tco: loop { - ret = match ast.clone() { - List(l, _) => { - if l.len() == 0 { - return Ok(ast); - } - match macroexpand(ast.clone(), &env) { - (true, Ok(new_ast)) => { - ast = new_ast; - continue 'tco; - } - (_, Err(e)) => return Err(e), - _ => (), - } - + List(ref l, _) => { if l.len() == 0 { return Ok(ast); } @@ -182,7 +136,6 @@ fn eval(mut ast: MalVal, mut env: Env) -> MalRet { continue 'tco; } Sym(ref a0sym) if a0sym == "quote" => Ok(l[1].clone()), - Sym(ref a0sym) if a0sym == "quasiquoteexpand" => Ok(quasiquote(&l[1])), Sym(ref a0sym) if a0sym == "quasiquote" => { ast = quasiquote(&l[1]); continue 'tco; @@ -212,12 +165,6 @@ fn eval(mut ast: MalVal, mut env: Env) -> MalRet { _ => error("set_macro on non-function"), } } - Sym(ref a0sym) if a0sym == "macroexpand" => { - match macroexpand(l[1].clone(), &env) { - (_, Ok(new_ast)) => Ok(new_ast), - (_, e) => return e, - } - } Sym(ref a0sym) if a0sym == "try*" => match eval(l[1].clone(), env.clone()) { Err(ref e) if l.len() >= 3 => { let exc = match e { @@ -239,12 +186,12 @@ fn eval(mut ast: MalVal, mut env: Env) -> MalRet { res => res, }, Sym(ref a0sym) if a0sym == "do" => { - match eval_ast(&list!(l[1..l.len() - 1].to_vec()), &env)? { - List(_, _) => { + match eval_ast(&l[1..l.len() - 1].to_vec(), &env) { + Ok(_) => { ast = l.last().unwrap_or(&Nil).clone(); continue 'tco; } - _ => error("invalid do form"), + Err(e) => return Err(e), } } Sym(ref a0sym) if a0sym == "if" => { @@ -280,32 +227,39 @@ fn eval(mut ast: MalVal, mut env: Env) -> MalRet { } continue 'tco; } - _ => match eval_ast(&ast, &env)? { - List(ref el, _) => { - let ref f = el[0].clone(); - let args = el[1..].to_vec(); - match f { - Func(_, _) => f.apply(args), - MalFunc { - ast: mast, - env: menv, - params, + _ => match eval(a0.clone(), env.clone()) { + Ok(f @ MalFunc { is_macro: true, .. }) => match f.apply(l[1..].to_vec()) { + Ok(new_ast) => { + ast = new_ast; + continue 'tco; + } + Err(e) => return Err(e), + } + Ok(f @ Func(_, _)) => match eval_ast(&l[1..].to_vec(), &env) { + Ok(args) => f.apply(args), + Err(e) => return Err(e), + } + Ok(MalFunc { + ast: ref mast, + env: ref menv, + params : ref mparams, .. - } => { + }) => match eval_ast(&l[1..].to_vec(), &env) { + Ok(args) => { let a = &**mast; - let p = &**params; - env = env_bind(Some(menv.clone()), p.clone(), args)?; + let p = &**mparams; + env = env_bind(Some(menv.clone()), p.clone(), args.to_vec())?; ast = a.clone(); continue 'tco; + } + Err(e) => return Err(e), } - _ => error("attempt to call non-function"), - } - } - _ => error("expected a list"), + Ok(_) => error("attempt to call non-function"), + Err(e) => return Err(e), }, } - } - _ => eval_ast(&ast, &env), + } + _ => Ok(ast.clone()), }; break; diff --git a/impls/skew/stepA_mal.sk b/impls/skew/stepA_mal.sk index 891f10d7b2..e70921fa36 100644 --- a/impls/skew/stepA_mal.sk +++ b/impls/skew/stepA_mal.sk @@ -33,33 +33,15 @@ def quasiquote(ast MalVal) MalVal { } } -def isMacro(ast MalVal, env Env) bool { - if !(ast is MalList) { return false } - const astList = ast as MalList - if astList.isEmpty { return false } - const a0 = astList[0] - if !(a0 is MalSymbol) { return false } - const a0Sym = a0 as MalSymbol - if env.find(a0Sym) == null { return false } - const f = env.get(a0Sym) - if !(f is MalFunc) { return false } - return (f as MalFunc).isMacro -} +def EVAL(ast MalVal, env Env) MalVal { + while true { -def macroexpand(ast MalVal, env Env) MalVal { - while isMacro(ast, env) { - const astList = ast as MalList - const mac = env.get(astList[0] as MalSymbol) as MalFunc - ast = mac.call((astList.rest as MalSequential).val) - } - return ast -} + # printLn("EVAL: " + PRINT(ast)) -def eval_ast(ast MalVal, env Env) MalVal { if ast is MalSymbol { return env.get(ast as MalSymbol) } else if ast is MalList { - return MalList.new((ast as MalList).val.map(e => EVAL(e, env))) + # proceed further after this conditional } else if ast is MalVector { return MalVector.new((ast as MalVector).val.map(e => EVAL(e, env))) } else if ast is MalHashMap { @@ -72,13 +54,7 @@ def eval_ast(ast MalVal, env Env) MalVal { } else { return ast } -} -def EVAL(ast MalVal, env Env) MalVal { - while true { - if !(ast is MalList) { return eval_ast(ast, env) } - ast = macroexpand(ast, env) - if !(ast is MalList) { return eval_ast(ast, env) } const astList = ast as MalList if astList.isEmpty { return ast } const a0sym = astList[0] as MalSymbol @@ -95,8 +71,6 @@ def EVAL(ast MalVal, env Env) MalVal { continue # TCO } else if a0sym.val == "quote" { return astList[1] - } else if a0sym.val == "quasiquoteexpand" { - return quasiquote(astList[1]) } else if a0sym.val == "quasiquote" { ast = quasiquote(astList[1]) continue # TCO @@ -104,8 +78,6 @@ def EVAL(ast MalVal, env Env) MalVal { var macro = EVAL(astList[2], env) as MalFunc macro.setAsMacro return env.set(astList[1] as MalSymbol, macro) - } else if a0sym.val == "macroexpand" { - return macroexpand(astList[1], env) } else if a0sym.val == "try*" { if astList.count < 3 { return EVAL(astList[1], env) @@ -121,9 +93,10 @@ def EVAL(ast MalVal, env Env) MalVal { var catchEnv = Env.new(env, [catchClause[1] as MalSymbol], [exc]) return EVAL(catchClause[2], catchEnv) } else if a0sym.val == "do" { - const parts = astList.val.slice(1) - eval_ast(MalList.new(parts.slice(0, parts.count - 1)), env) - ast = parts[parts.count - 1] + for i = 1; i < astList.count - 1; i += 1 { + EVAL(astList[i], env) + } + ast = astList[astList.count - 1] continue # TCO } else if a0sym.val == "if" { const condRes = EVAL(astList[1], env) @@ -137,9 +110,13 @@ def EVAL(ast MalVal, env Env) MalVal { const argsNames = astList[1] as MalSequential return MalFunc.new(astList[2], argsNames, env, (args List) => EVAL(astList[2], Env.new(env, argsNames.val, args))) } else { - const evaledList = eval_ast(ast, env) as MalList - const fn = evaledList[0] - const callArgs = evaledList.val.slice(1) + const fn = EVAL(astList[0], env) + const args = astList.val.slice(1) + if fn is MalFunc && (fn as MalFunc).isMacro { + ast = (fn as MalFunc).call(args) + continue # TCO + } + const callArgs = args.map(e => EVAL(e, env)) if fn is MalNativeFunc { return (fn as MalNativeFunc).call(callArgs) } else if fn is MalFunc { diff --git a/impls/tcl/stepA_mal.tcl b/impls/tcl/stepA_mal.tcl index 1857a9a5ef..718ce9af9c 100644 --- a/impls/tcl/stepA_mal.tcl +++ b/impls/tcl/stepA_mal.tcl @@ -55,51 +55,18 @@ proc quasiquote {ast} { } } -proc is_macro_call {ast env} { - if {![list_q $ast]} { - return 0 - } - set a0 [lindex [obj_val $ast] 0] - if {$a0 == "" || ![symbol_q $a0]} { - return 0 - } - set varname [obj_val $a0] - set foundenv [$env find $varname] - if {$foundenv == 0} { - return 0 - } - macro_q [$env get $varname] -} +proc EVAL {ast env} { + while {true} { -proc macroexpand {ast env} { - while {[is_macro_call $ast $env]} { - set a0 [mal_first [list $ast]] - set macro_name [obj_val $a0] - set macro_obj [$env get $macro_name] - set macro_args [obj_val [mal_rest [list $ast]]] + # set img [PRINT $ast] + # puts "EVAL: ${img}" - set funcdict [obj_val $macro_obj] - set body [dict get $funcdict body] - set env [dict get $funcdict env] - set binds [dict get $funcdict binds] - set funcenv [Env new $env $binds $macro_args] - set ast [EVAL $body $funcenv] - } - return $ast -} - -proc eval_ast {ast env} { switch [obj_type $ast] { "symbol" { set varname [obj_val $ast] return [$env get $varname] } "list" { - set res {} - foreach element [obj_val $ast] { - lappend res [EVAL $element $env] - } - return [list_new $res] } "vector" { set res {} @@ -116,18 +83,6 @@ proc eval_ast {ast env} { return [hashmap_new $res] } default { return $ast } - } -} - -proc EVAL {ast env} { - while {true} { - if {![list_q $ast]} { - return [eval_ast $ast $env] - } - - set ast [macroexpand $ast $env] - if {![list_q $ast]} { - return [eval_ast $ast $env] } lassign [obj_val $ast] a0 a1 a2 a3 @@ -153,9 +108,6 @@ proc EVAL {ast env} { "quote" { return $a1 } - "quasiquoteexpand" { - return [quasiquote $a1] - } "quasiquote" { set ast [quasiquote $a1] } @@ -164,9 +116,6 @@ proc EVAL {ast env} { set value [EVAL $a2 $env] return [$env set $varname [macro_new $value]] } - "macroexpand" { - return [macroexpand $a1 $env] - } "tcl*" { return [string_new [eval [obj_val $a1]]] } @@ -189,8 +138,9 @@ proc EVAL {ast env} { } } "do" { - set el [list_new [lrange [obj_val $ast] 1 end-1]] - eval_ast $el $env + foreach element [lrange [obj_val $ast] 1 end-1] { + EVAL $element $env + } set ast [lindex [obj_val $ast] end] # TCO: Continue loop } @@ -214,10 +164,21 @@ proc EVAL {ast env} { return [function_new $a2 $env $binds] } default { - set lst_obj [eval_ast $ast $env] - set lst [obj_val $lst_obj] - set f [lindex $lst 0] - set call_args [lrange $lst 1 end] + set f [EVAL $a0 $env] + set unevaluated_args [lrange [obj_val $ast] 1 end] + if {[macro_q $f]} { + set fn [obj_val $f] + set f_ast [dict get $fn body] + set f_env [dict get $fn env] + set f_binds [dict get $fn binds] + set apply_env [Env new $f_env $f_binds $unevaluated_args] + set ast [EVAL $f_ast $apply_env] + continue + } + set call_args {} + foreach element $unevaluated_args { + lappend call_args [EVAL $element $env] + } switch [obj_type $f] { function { set fn [obj_val $f] diff --git a/impls/tests/step7_quote.mal b/impls/tests/step7_quote.mal index ef80c8259a..b30c7c7f9e 100644 --- a/impls/tests/step7_quote.mal +++ b/impls/tests/step7_quote.mal @@ -277,73 +277,3 @@ a ;=>[unquote 0] `[splice-unquote 0] ;=>[splice-unquote 0] - -;; Debugging quasiquote -(quasiquoteexpand nil) -;=>nil -(quasiquoteexpand 7) -;=>7 -(quasiquoteexpand a) -;=>(quote a) -(quasiquoteexpand {"a" b}) -;=>(quote {"a" b}) -(quasiquoteexpand ()) -;=>() -(quasiquoteexpand (1 2 3)) -;=>(cons 1 (cons 2 (cons 3 ()))) -(quasiquoteexpand (a)) -;=>(cons (quote a) ()) -(quasiquoteexpand (1 2 (3 4))) -;=>(cons 1 (cons 2 (cons (cons 3 (cons 4 ())) ()))) -(quasiquoteexpand (nil)) -;=>(cons nil ()) -(quasiquoteexpand (1 ())) -;=>(cons 1 (cons () ())) -(quasiquoteexpand (() 1)) -;=>(cons () (cons 1 ())) -(quasiquoteexpand (1 () 2)) -;=>(cons 1 (cons () (cons 2 ()))) -(quasiquoteexpand (())) -;=>(cons () ()) -(quasiquoteexpand (f () g (h) i (j k) l)) -;=>(cons (quote f) (cons () (cons (quote g) (cons (cons (quote h) ()) (cons (quote i) (cons (cons (quote j) (cons (quote k) ())) (cons (quote l) ()))))))) -(quasiquoteexpand (unquote 7)) -;=>7 -(quasiquoteexpand a) -;=>(quote a) -(quasiquoteexpand (unquote a)) -;=>a -(quasiquoteexpand (1 a 3)) -;=>(cons 1 (cons (quote a) (cons 3 ()))) -(quasiquoteexpand (1 (unquote a) 3)) -;=>(cons 1 (cons a (cons 3 ()))) -(quasiquoteexpand (1 b 3)) -;=>(cons 1 (cons (quote b) (cons 3 ()))) -(quasiquoteexpand (1 (unquote b) 3)) -;=>(cons 1 (cons b (cons 3 ()))) -(quasiquoteexpand ((unquote 1) (unquote 2))) -;=>(cons 1 (cons 2 ())) -(quasiquoteexpand (a (splice-unquote (b c)) d)) -;=>(cons (quote a) (concat (b c) (cons (quote d) ()))) -(quasiquoteexpand (1 c 3)) -;=>(cons 1 (cons (quote c) (cons 3 ()))) -(quasiquoteexpand (1 (splice-unquote c) 3)) -;=>(cons 1 (concat c (cons 3 ()))) -(quasiquoteexpand (1 (splice-unquote c))) -;=>(cons 1 (concat c ())) -(quasiquoteexpand ((splice-unquote c) 2)) -;=>(concat c (cons 2 ())) -(quasiquoteexpand ((splice-unquote c) (splice-unquote c))) -;=>(concat c (concat c ())) -(quasiquoteexpand []) -;=>(vec ()) -(quasiquoteexpand [[]]) -;=>(vec (cons (vec ()) ())) -(quasiquoteexpand [()]) -;=>(vec (cons () ())) -(quasiquoteexpand ([])) -;=>(cons (vec ()) ()) -(quasiquoteexpand [1 a 3]) -;=>(vec (cons 1 (cons (quote a) (cons 3 ())))) -(quasiquoteexpand [a [] b [c] d [e f] g]) -;=>(vec (cons (quote a) (cons (vec ()) (cons (quote b) (cons (vec (cons (quote c) ())) (cons (quote d) (cons (vec (cons (quote e) (cons (quote f) ()))) (cons (quote g) ())))))))) diff --git a/impls/tests/step8_macros.mal b/impls/tests/step8_macros.mal index 6fd1ef9d94..8b828b3937 100644 --- a/impls/tests/step8_macros.mal +++ b/impls/tests/step8_macros.mal @@ -18,20 +18,8 @@ (unless2 true 7 8) ;=>8 -;; Testing macroexpand -(macroexpand (one)) -;=>1 -(macroexpand (unless PRED A B)) -;=>(if PRED B A) -(macroexpand (unless2 PRED A B)) -;=>(if (not PRED) A B) -(macroexpand (unless2 2 3 4)) -;=>(if (not 2) 3 4) - ;; Testing evaluation of macro result (defmacro! identity (fn* (x) x)) -(let* (a 123) (macroexpand (identity a))) -;=>a (let* (a 123) (identity a)) ;=>123 @@ -84,18 +72,12 @@ x ;; Testing cond macro -(macroexpand (cond)) -;=>nil (cond) ;=>nil -(macroexpand (cond X Y)) -;=>(if X Y (cond)) (cond true 7) ;=>7 (cond false 7) ;=>nil -(macroexpand (cond X Y Z T)) -;=>(if X Y (cond Z T)) (cond true 7 true 8) ;=>7 (cond false 7 true 8) diff --git a/impls/ts/stepA_mal.ts b/impls/ts/stepA_mal.ts index e61f8ce30f..fafa672a67 100644 --- a/impls/ts/stepA_mal.ts +++ b/impls/ts/stepA_mal.ts @@ -57,47 +57,12 @@ function quasiquote(ast: MalType): MalType { } } -function isMacro(ast: MalType, env: Env): boolean { - if (!isSeq(ast)) { - return false; - } - const s = ast.list[0]; - if (s.type !== Node.Symbol) { - return false; - } - const foundEnv = env.find(s); - if (!foundEnv) { - return false; - } - - const f = foundEnv.get(s); - if (f.type !== Node.Function) { - return false; - } - - return f.isMacro; -} - -function macroexpand(ast: MalType, env: Env): MalType { - while (isMacro(ast, env)) { - if (!isSeq(ast)) { - throw new Error(`unexpected token type: ${ast.type}, expected: list or vector`); - } - const s = ast.list[0]; - if (s.type !== Node.Symbol) { - throw new Error(`unexpected token type: ${s.type}, expected: symbol`); - } - const f = env.get(s); - if (f.type !== Node.Function) { - throw new Error(`unexpected token type: ${f.type}, expected: function`); - } - ast = f.func(...ast.list.slice(1)); - } +// EVAL +function evalMal(ast: MalType, env: Env): MalType { + loop: while (true) { - return ast; -} + // console.log("EVAL: ", prStr(ast)); -function evalAST(ast: MalType, env: Env): MalType { switch (ast.type) { case Node.Symbol: const f = env.get(ast); @@ -105,8 +70,6 @@ function evalAST(ast: MalType, env: Env): MalType { throw new Error(`unknown symbol: ${ast.v}`); } return f; - case Node.List: - return new MalList(ast.list.map(ast => evalMal(ast, env))); case Node.Vector: return new MalVector(ast.list.map(ast => evalMal(ast, env))); case Node.HashMap: @@ -116,29 +79,16 @@ function evalAST(ast: MalType, env: Env): MalType { list.push(evalMal(value, env)); } return new MalHashMap(list); + case Node.List: + break; default: return ast; } -} -// EVAL -function evalMal(ast: MalType, env: Env): MalType { - loop: while (true) { - if (ast.type !== Node.List) { - return evalAST(ast, env); - } if (ast.list.length === 0) { return ast; } - ast = macroexpand(ast, env); - if (!isSeq(ast)) { - return evalAST(ast, env); - } - - if (ast.list.length === 0) { - return ast; - } const first = ast.list[0]; switch (first.type) { case Node.Symbol: @@ -177,9 +127,6 @@ function evalMal(ast: MalType, env: Env): MalType { case "quote": { return ast.list[1]; } - case "quasiquoteexpand": { - return quasiquote(ast.list[1]); - } case "quasiquote": { ast = quasiquote(ast.list[1]); continue loop; @@ -198,9 +145,6 @@ function evalMal(ast: MalType, env: Env): MalType { } return env.set(key, f.toMacro()); } - case "macroexpand": { - return macroexpand(ast.list[1], env); - } case "try*": { try { return evalMal(ast.list[1], env); @@ -228,7 +172,7 @@ function evalMal(ast: MalType, env: Env): MalType { } case "do": { const list = ast.list.slice(1, -1); - evalAST(new MalList(list), env); + list.map(x => evalMal(x, env)); ast = ast.list[ast.list.length - 1]; continue loop; } @@ -265,14 +209,15 @@ function evalMal(ast: MalType, env: Env): MalType { } } } - const result = evalAST(ast, env); - if (!isSeq(result)) { - throw new Error(`unexpected return type: ${result.type}, expected: list or vector`); - } - const [f, ...args] = result.list; + const f = evalMal(first, env); if (f.type !== Node.Function) { throw new Error(`unexpected token: ${f.type}, expected: function`); } + if (f.isMacro) { + ast = f.func(...ast.list.slice(1)); + continue loop; + } + const args = ast.list.slice(1).map(x => evalMal(x, env)); if (f.ast) { ast = f.ast; env = f.newEnv(args); diff --git a/impls/vhdl/stepA_mal.vhdl b/impls/vhdl/stepA_mal.vhdl index bcbaadcd29..a8fcd4833c 100644 --- a/impls/vhdl/stepA_mal.vhdl +++ b/impls/vhdl/stepA_mal.vhdl @@ -97,40 +97,6 @@ architecture test of stepA_mal is procedure apply_func(fn: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr); - procedure is_macro_call(ast: inout mal_val_ptr; env: inout env_ptr; is_macro: out boolean) is - variable f, env_err: mal_val_ptr; - begin - is_macro := false; - if ast.val_type = mal_list and - ast.seq_val'length > 0 and - ast.seq_val(0).val_type = mal_symbol then - env_get(env, ast.seq_val(0), f, env_err); - if env_err = null and f /= null and - f.val_type = mal_fn and f.func_val.f_is_macro then - is_macro := true; - end if; - end if; - end procedure is_macro_call; - - procedure macroexpand(in_ast: inout mal_val_ptr; env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is - variable ast, macro_fn, call_args, macro_err: mal_val_ptr; - variable is_macro: boolean; - begin - ast := in_ast; - is_macro_call(ast, env, is_macro); - while is_macro loop - env_get(env, ast.seq_val(0), macro_fn, macro_err); - seq_drop_prefix(ast, 1, call_args); - apply_func(macro_fn, call_args, ast, macro_err); - if macro_err /= null then - err := macro_err; - return; - end if; - is_macro_call(ast, env, is_macro); - end loop; - result := ast; - end procedure macroexpand; - procedure fn_eval(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin EVAL(args.seq_val(0), repl_env, result, err); @@ -221,12 +187,16 @@ architecture test of stepA_mal is end case; end procedure apply_func; - procedure eval_ast_seq(ast_seq: inout mal_seq_ptr; env: inout env_ptr; result: inout mal_seq_ptr; err: out mal_val_ptr) is + procedure eval_ast_seq(ast_seq : inout mal_seq_ptr; + skip : in natural; + env : inout env_ptr; + result : inout mal_seq_ptr; + err : out mal_val_ptr) is variable eval_err: mal_val_ptr; begin - result := new mal_seq(0 to ast_seq'length - 1); + result := new mal_seq(0 to ast_seq'length - 1 - skip); for i in result'range loop - EVAL(ast_seq(i), env, result(i), eval_err); + EVAL(ast_seq(skip + i), env, result(i), eval_err); if eval_err /= null then err := eval_err; return; @@ -234,12 +204,28 @@ architecture test of stepA_mal is end loop; end procedure eval_ast_seq; - procedure eval_ast(ast: inout mal_val_ptr; env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + procedure EVAL(in_ast : inout mal_val_ptr; + in_env : inout env_ptr; + result : out mal_val_ptr; + err : out mal_val_ptr) is variable key, val, eval_err, env_err: mal_val_ptr; - variable new_seq: mal_seq_ptr; + variable new_seq, evaled_ast: mal_seq_ptr; variable i: integer; + variable ast, a0, call_args, vars, sub_err, fn: mal_val_ptr; + variable env, let_env, catch_env, fn_env: env_ptr; + variable s: line; begin - case ast.val_type is + ast := in_ast; + env := in_env; + loop + + -- mal_printstr("EVAL: "); + -- PRINT (ast, s); + -- mal_printline(s.all); + -- deallocate(s); + -- mal_printline(""); + + case ast.val_type is when mal_symbol => env_get(env, ast, val, env_err); if env_err /= null then @@ -248,8 +234,10 @@ architecture test of stepA_mal is end if; result := val; return; - when mal_list | mal_vector | mal_hashmap => - eval_ast_seq(ast.seq_val, env, new_seq, eval_err); + when mal_list => + null; + when mal_vector | mal_hashmap => + eval_ast_seq(ast.seq_val, 0, env, new_seq, eval_err); if eval_err /= null then err := eval_err; return; @@ -259,31 +247,8 @@ architecture test of stepA_mal is when others => result := ast; return; - end case; - end procedure eval_ast; - - procedure EVAL(in_ast: inout mal_val_ptr; in_env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is - variable i: integer; - variable ast, evaled_ast, a0, call_args, val, vars, sub_err, fn: mal_val_ptr; - variable env, let_env, catch_env, fn_env: env_ptr; - begin - ast := in_ast; - env := in_env; - loop - if ast.val_type /= mal_list then - eval_ast(ast, env, result, err); - return; - end if; + end case; - macroexpand(ast, env, ast, sub_err); - if sub_err /= null then - err := sub_err; - return; - end if; - if ast.val_type /= mal_list then - eval_ast(ast, env, result, err); - return; - end if; if ast.seq_val'length = 0 then result := ast; return; @@ -322,10 +287,6 @@ architecture test of stepA_mal is result := ast.seq_val(1); return; - elsif a0.string_val.all = "quasiquoteexpand" then - quasiquote(ast.seq_val(1), result); - return; - elsif a0.string_val.all = "quasiquote" then quasiquote(ast.seq_val(1), ast); next; -- TCO @@ -342,10 +303,6 @@ architecture test of stepA_mal is result := val; return; - elsif a0.string_val.all = "macroexpand" then - macroexpand(ast.seq_val(1), env, result, err); - return; - elsif a0.string_val.all = "try*" then EVAL(ast.seq_val(1), env, result, sub_err); if sub_err /= null then @@ -400,18 +357,43 @@ architecture test of stepA_mal is end if; end if; - eval_ast(ast, env, evaled_ast, sub_err); + EVAL (ast.seq_val(0), env, fn, sub_err); if sub_err /= null then err := sub_err; return; end if; - seq_drop_prefix(evaled_ast, 1, call_args); - fn := evaled_ast.seq_val(0); case fn.val_type is when mal_nativefn => + -- Evaluate arguments + eval_ast_seq(ast.seq_val, 1, env, evaled_ast, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + new_seq_obj(mal_list, evaled_ast, call_args); + -- Apply core function apply_native_func(fn, call_args, result, err); return; when mal_fn => + if fn.func_val.f_is_macro then + -- Apply macro + seq_drop_prefix(ast, 1, call_args); + new_env(fn_env, fn.func_val.f_env, fn.func_val.f_args, call_args); + apply_func(fn, call_args, ast, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + next; -- TCO + end if; + -- Evaluate arguments + eval_ast_seq(ast.seq_val, 1, env, evaled_ast, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + new_seq_obj(mal_list, evaled_ast, call_args); + -- Apply fn* function new_env(fn_env, fn.func_val.f_env, fn.func_val.f_args, call_args); env := fn_env; ast := fn.func_val.f_body; diff --git a/impls/vimscript/stepA_mal.vim b/impls/vimscript/stepA_mal.vim index 68ee6407b9..1b32c6e664 100644 --- a/impls/vimscript/stepA_mal.vim +++ b/impls/vimscript/stepA_mal.vim @@ -46,54 +46,6 @@ function Quasiquote(ast) endif endfunction -function IsMacroCall(ast, env) - if !ListQ(a:ast) - return 0 - endif - let a0 = ListFirst(a:ast) - if !SymbolQ(a0) - return 0 - endif - let macroname = a0.val - if empty(a:env.find(macroname)) - return 0 - endif - return MacroQ(a:env.get(macroname)) -endfunction - -function MacroExpand(ast, env) - let ast = a:ast - while IsMacroCall(ast, a:env) - let macroobj = a:env.get(ListFirst(ast).val) - let macroargs = ListRest(ast) - let ast = FuncInvoke(macroobj, macroargs) - endwhile - return ast -endfunction - -function EvalAst(ast, env) - if SymbolQ(a:ast) - let varname = a:ast.val - return a:env.get(varname) - elseif ListQ(a:ast) - return ListNew(map(copy(a:ast.val), {_, e -> EVAL(e, a:env)})) - elseif VectorQ(a:ast) - return VectorNew(map(copy(a:ast.val), {_, e -> EVAL(e, a:env)})) - elseif HashQ(a:ast) - let ret = {} - for [k,v] in items(a:ast.val) - let keyobj = HashParseKey(k) - let newkey = EVAL(keyobj, a:env) - let newval = EVAL(v, a:env) - let keystring = HashMakeKey(newkey) - let ret[keystring] = newval - endfor - return HashNew(ret) - else - return a:ast - end -endfunction - function GetCatchClause(ast) if ListCount(a:ast) < 3 return "" @@ -111,13 +63,24 @@ function EVAL(ast, env) let env = a:env while 1 - if !ListQ(ast) - return EvalAst(ast, env) - end - let ast = MacroExpand(ast, env) + " call PrintLn("EVAL: " . PRINT(ast)) + + if SymbolQ(ast) + let varname = ast.val + return env.get(varname) + elseif VectorQ(ast) + return VectorNew(map(copy(ast.val), {_, e -> EVAL(e, env)})) + elseif HashQ(ast) + let ret = {} + for [k,v] in items(ast.val) + let newval = EVAL(v, env) + let ret[k] = newval + endfor + return HashNew(ret) + endif if !ListQ(ast) - return EvalAst(ast, env) + return ast end if EmptyQ(ast) return ast @@ -143,8 +106,6 @@ function EVAL(ast, env) " TCO elseif first_symbol == "quote" return ListNth(ast, 1) - elseif first_symbol == "quasiquoteexpand" - return Quasiquote(ListNth(ast, 1)) elseif first_symbol == "quasiquote" let ast = Quasiquote(ListNth(ast, 1)) " TCO @@ -153,8 +114,6 @@ function EVAL(ast, env) let a2 = ListNth(ast, 2) let macro = MarkAsMacro(EVAL(a2, env)) return env.set(a1.val, macro) - elseif first_symbol == "macroexpand" - return MacroExpand(ListNth(ast, 1), env) elseif first_symbol == "if" let condvalue = EVAL(ast.val[1], env) if FalseQ(condvalue) || NilQ(condvalue) @@ -187,7 +146,9 @@ function EVAL(ast, env) endtry elseif first_symbol == "do" let astlist = ast.val - call EvalAst(ListNew(astlist[1:-2]), env) + for elt in astlist[1:-2] + let ignored = EVAL(elt, env) + endfor let ast = astlist[-1] " TCO elseif first_symbol == "fn*" @@ -199,9 +160,14 @@ function EVAL(ast, env) " TCO else " apply list - let el = EvalAst(ast, env) - let funcobj = ListFirst(el) - let args = ListRest(el) + let funcobj = EVAL(first, env) + let args = ListRest(ast) + if MacroQ(funcobj) + let ast = FuncInvoke(funcobj, args) + continue + " TCO + endif + let args = ListNew(map(copy(args.val), {_, e -> EVAL(e, env)})) if NativeFunctionQ(funcobj) return NativeFuncInvoke(funcobj, args) elseif FunctionQ(funcobj) diff --git a/process/guide.md b/process/guide.md index cdb7a32659..e4d72ace08 100644 --- a/process/guide.md +++ b/process/guide.md @@ -541,24 +541,16 @@ repl_env = {'+': lambda a,b: a+b, * Modify the `rep` function to pass the REPL environment as the second parameter for the `EVAL` call. -* Create a new function `eval_ast` which takes `ast` (mal data type) - and an associative structure (the environment from above). - `eval_ast` switches on the type of `ast` as follows: +* In `EVAL`, switch on the type of the first parameter `ast` as follows: * symbol: lookup the symbol in the environment structure and return the value or raise an error if no value is found - * list: return a new list that is the result of calling `EVAL` on - each of the members of the list + * `ast` is a non-empty list: + call `EVAL` on each of the members of the list. + Take the first evaluated item and call it as function using + the rest of the evaluated items as its arguments. * otherwise just return the original `ast` value -* Modify `EVAL` to check if the first parameter `ast` is a list. - * `ast` is not a list: then return the result of calling `eval_ast` - on it. - * `ast` is a empty list: return ast unchanged. - * `ast` is a list: call `eval_ast` to get a new evaluated list. Take - the first item of the evaluated list and call it as function using - the rest of the evaluated list as its arguments. - If your target language does not have full variable length argument support (e.g. variadic, vararg, splats, apply) then you will need to pass the full list of arguments as a single parameter and split apart @@ -585,8 +577,17 @@ You now have a simple prefix notation calculator! #### Deferrable: -* `eval_ast` should evaluate elements of vectors and hash-maps. Add the - following cases in `eval_ast`: +* It is recommended to add a print statement at the top of the main + `eval` function. This statement should be disabled in normal + circumstances (commented out, enabled by an environment variable…). + + This information may be quite useful when debugging an issue, or + simply figuring how evaluation works. For consistence with existing + implementations, it should print "EVAL: " followed by the current + value of `ast`, formatted with `pr_str`. + +* `EVAL` should evaluate elements of vectors and hash-maps. Add the + following cases in `EVAL`: * If `ast` is a vector: return a new vector that is the result of calling `EVAL` on each of the members of the vector. * If `ast` is a hash-map: return a new hash-map which consists of key-value @@ -643,7 +644,7 @@ diff -urp ../process/step2_eval.txt ../process/step3_env.txt repl_env (with a `nil` outer value) and use the `set` method to add the numeric functions. -* Modify `eval_ast` to call the `get` method on the `env` parameter. +* Modify `EVAL` to call the `get` method on the `env` parameter. * Modify the apply section of `EVAL` to switch on the first element of the list: @@ -664,8 +665,7 @@ diff -urp ../process/step2_eval.txt ../process/step3_env.txt original `let*` form is evaluated using the new "let\*" environment and the result is returned as the result of the `let*` (the new let environment is discarded upon completion). - * otherwise: call `eval_ast` on the list and apply the first element - to the rest as before. + * otherwise: proceed as before. `def!` and `let*` are Lisp "specials" (or "special atoms") which means that they are language level features and more specifically that the @@ -754,7 +754,7 @@ diff -urp ../process/step3_env.txt ../process/step4_if_fn_do.txt * Add the following special forms to `EVAL`: - * `do`: Evaluate all the elements of the list using `eval_ast` + * `do`: Evaluate all the elements of the list and return the final evaluated element. * `if`: Evaluate the first parameter (second element). If the result (condition) is anything other than `nil` or `false`, then evaluate @@ -902,7 +902,7 @@ diff -urp ../process/step4_if_fn_do.txt ../process/step5_tco.txt `ast` (i.e. the local variable passed in as first parameter of `EVAL`) to be the second `ast` argument. Continue at the beginning of the loop (no return). - * `do`: change the `eval_ast` call to evaluate all the parameters + * `do`: change the implementation to evaluate all the parameters except for the last (2nd list element up to but not including last). Set `ast` to the last element of `ast`. Continue at the beginning of the loop (`env` stays unchanged). @@ -927,7 +927,7 @@ diff -urp ../process/step4_if_fn_do.txt ../process/step5_tco.txt * The default "apply"/invoke case of `EVAL` must now be changed to account for the new object/structure returned by the `fn*` form. - Continue to call `eval_ast` on `ast`. The first element of the + Once each element of `ast` is evaluated, the first element of the result of `eval_ast` is `f` and the remaining elements are in `args`. Switch on the type of `f`: * regular function (not one defined by `fn*`): apply/invoke it as @@ -1213,15 +1213,11 @@ Mal borrows most of its syntax and feature-set). Such forms are not affected by evaluation, so you may quote them as in the previous case if implementation is easyer. -* Optionally, add a the `quasiquoteexpand` special form. - This form calls the `quasiquote` function using the first `ast` - argument (second list element) and returns the result. - It has no other practical purpose than testing your implementation - of the `quasiquote` internal function. - * Add the `quasiquote` special form. - This form does the same than `quasiquoteexpand`, - but evaluates the result in the current environment before returning it, + + This form calls the `quasiquote` function using the first `ast` + argument (second list element), + then evaluates the result in the current environment, either by recursively calling `EVAL` with the result and `env`, or by assigning `ast` with the result and continuing execution at the top of the loop (TCO). @@ -1231,6 +1227,11 @@ Now go to the top level, run the step 7 tests: make "test^quux^step7" ``` +If some tests do not pass, it may be convenient to enable the debug +print statement at the top of your main `eval` function (inside the +TCO loop). The quasiquoted but yet unevaluated AST will often reveal +the source of the issue. + Quoting is one of the more mundane functions available in mal, but do not let that discourage you. Your mal implementation is almost complete, and quoting sets the stage for the next very exciting step: @@ -1310,35 +1311,28 @@ simple. `def!` form, but before the evaluated value (mal function) is set in the environment, the `is_macro` attribute should be set to true. -* Add a `is_macro_call` function: This function takes arguments `ast` - and `env`. It returns true if `ast` is a list that contains a symbol - as the first element and that symbol refers to a function in the - `env` environment and that function has the `is_macro` attribute set - to true. Otherwise, it returns false. - -* Add a `macroexpand` function: This function takes arguments `ast` - and `env`. It calls `is_macro_call` with `ast` and `env` and loops - while that condition is true. Inside the loop, the first element of - the `ast` list (a symbol), is looked up in the environment to get - the macro function. This macro function is then called/applied with - the rest of the `ast` elements (2nd through the last) as arguments. - The return value of the macro call becomes the new value of `ast`. - When the loop completes because `ast` no longer represents a macro - call, the current value of `ast` is returned. - -* In the evaluator (`EVAL`) before the special forms switch (apply - section), perform macro expansion by calling the `macroexpand` - function with the current value of `ast` and `env`. Set `ast` to the - result of that call. If the new value of `ast` is no longer a list - after macro expansion, then return the result of calling `eval_ast` - on it, otherwise continue with the rest of the apply section - (special forms switch). - -* Add a new special form condition for `macroexpand`. Call the - `macroexpand` function using the first `ast` argument (second list - element) and `env`. Return the result. This special form allows - a mal program to do explicit macro expansion without applying the - result (which can be useful for debugging macro expansion). +* In `EVAL`, + when `ast` is a non-empty list without leading special form, + the normal apply phase evaluates all elements of `ast`. + + Start by evaluating the first element separately. + The result must be a function. + If this function does have the `is_macro` attribute set, + + * apply the function to the (unevaluated) remaining elements of + `ast`, producing a new form. + + * evaluate the new form in the `env` environment. + Of course, instead of recursively calling `EVAL`, replace `ast` + with the new form and restart the TCO loop. + + For functions without the attribute, proceed as before: evaluate the + remaining elements of `ast`, then apply the function to them. + + +If you check existing implementations, be warned that former versions +of this guide were describing a slightly different macro expansion +mechanism. Now go to the top level, run the step 8 tests: ``` @@ -1349,14 +1343,14 @@ There is a reasonably good chance that the macro tests will not pass the first time. Although the implementation of macros is fairly simple, debugging runtime bugs with macros can be fairly tricky. If you do run into subtle problems that are difficult to solve, let me -recommend a couple of approaches: - -* Use the macroexpand special form to eliminate one of the layers of - indirection (to expand but skip evaluate). This will often reveal - the source of the issue. -* Add a debug print statement to the top of your main `eval` function - (inside the TCO loop) to print the current value of `ast` (hint use - `pr_str` to get easier to debug output). Pull up the step8 +recommend an approach: + +* Enable the debug print statement at the top of your main `eval` + function (inside the TCO loop). + The expanded but yet unevaluated AST will often reveal the source of + the issue. + +* Pull up the step8 implementation from another language and uncomment its `eval` function (yes, I give you permission to violate the rule this once). Run the two side-by-side. The first difference is likely to point to diff --git a/process/stepA_mal.txt b/process/stepA_mal.txt index 1f3ac41203..9528005288 100644 --- a/process/stepA_mal.txt +++ b/process/stepA_mal.txt @@ -5,38 +5,39 @@ READ(str): return reader.read_str(str) quasiquote(ast): return ... // quasiquote -macro?(ast, env): return ... // true if macro call -macroexpand(ast, env): return ... // recursive macro expansion - -eval_ast(ast,env): - switch type(ast): - symbol: return env.get(ast) - list,vector: return ast.map((x) -> EVAL(x,env)) - hash: return ast.map((k,v) -> list(k, EVAL(v,env))) - _default_: return ast - -EVAL(ast,env): - while true: - if not list?(ast): return eval_ast(ast, env) - - ast = macroexpand(ast, env) - if not list?(ast): return eval_ast(ast, env) - if empty?(ast): return ast - - switch ast[0]: - 'def!: return env.set(ast[1], EVAL(ast[2], env)) - 'let*: env = ...; ast = ast[2] // TCO - 'quote: return ast[1] - 'quasiquote: ast = quasiquote(ast[1]) // TCO - 'defmacro!: return ... // like def!, but set macro property - 'macroexpand: return macroexpand(ast[1], env) - 'try*: return ... // try/catch native and malval exceptions - 'do: ast = eval_ast(ast[1..-1], env)[-1] // TCO - 'if: EVAL(ast[1], env) ? ast = ast[2] : ast = ast[3] // TCO - 'fn*: return new MalFunc(...) - _default_: f, args = eval_ast(ast, env) - if malfunc?(f): ast = f.fn; env = ... // TCO - else: return apply(f, args) +EVAL(ast, env): + loop: + ;; prn("EVAL: " ast) + match ast: + 'key: return env.get(key) + [form1 ..]: return [EVAL(form1, env) ..] + {key1 value1 ..}: return {key1 EVAL(value1, env) ..} + ('def! 'key value): return env.set(key, EVAL(value, env)) + ('let* (k1 v1 ..) form): env = new Env(env) + env.set(k1, EVAL(v1, env)) + .. + ast = form + ('let* [k1 v1 ..] form): // idem + ('do form1 .. last): EVAL(form1, env) + .. + ast = last + ('if cond yes no): if EVAL(cond, env) then: ast = yes else: ast = no + ('if cond yes): if EVAL(cond, env) then: ast = yes else: return nil + ('fn* ('key1 ..) impl): return new MalFunc(env, impl, params=[key1 ..]) + ('fn* ['key1 ..] impl): // idem + ('quote form): return form + ('quasiquote form): ast = quasiquote(form) + ('defmacro! 'key value): return env.set(key, as_macro(EVAL(value, env))) + ('try* f ('catch* 'k h)): try returning EVAL(f, env) + if native or malval exception: env = new Env(env, [k], [exception]) + ast = h + ('try* f): ast = f + (callable arg1 ..): f = EVAL(callable, env) + if macro?(f): ast = apply(f, [arg1 ..]) + else if core?(f): return apply(f, [EVAL(arg1, env) ..]) + else: env = new Env(f.env, f.params, [EVAL(arg1, env) ..]) + ast = f.impl + otherwise: return ast PRINT(exp): return printer.pr_str(exp)