#!/usr/bin/env bash source $[dirname $0]/reader.sh source $[dirname $0]/printer.sh source $[dirname $0]/env.sh source $[dirname $0]/core.sh # read proc READ { test $(1) && setglobal r = $(1) || READLINE READ_STR $(r) } # eval proc IS_PAIR { if _sequential? $(1) { _count $(1) [[ "${r}" > 0 ]] && return 0 } return 1 } proc QUASIQUOTE { if ! IS_PAIR $(1) { _symbol quote _list $(r) $(1) return } else { _nth $(1) 0; local a0="$(r)" if [[ "${ANON["${a0}"]}" == "unquote" ]] { _nth $(1) 1 return } elif IS_PAIR $(a0) { _nth $(a0) 0; local a00="$(r)" if [[ "${ANON["${a00}"]}" == "splice-unquote" ]] { _symbol concat; local a="$(r)" _nth $(a0) 1; local b="$(r)" _rest $(1) QUASIQUOTE $(r); local c="$(r)" _list $(a) $(b) $(c) return } } } _symbol cons; local a="$(r)" QUASIQUOTE $(a0); local b="$(r)" _rest $(1) QUASIQUOTE $(r); local c="$(r)" _list $(a) $(b) $(c) return } proc IS_MACRO_CALL { if ! _list? $(1) { return 1; } _nth $(1) 0; local a0="$(r)" if _symbol? $(a0) { ENV_FIND $(2) $(a0) if [[ "${r}" ]] { ENV_GET $(2) $(a0) test $(ANON["${r}_ismacro_"]) return $? } } return 1 } proc MACROEXPAND { local ast="$(1)" env="$(2)" while IS_MACRO_CALL $(ast) $(env) { _nth $(ast) 0; local a0="$(r)" ENV_GET $(env) $(a0); local mac="$(ANON["${r}"])" _rest $(ast) $(mac%%@*) $(ANON["${r}"]) setglobal ast = $(r) } setglobal r = $(ast) } proc EVAL_AST { local ast="$(1)" env="$(2)" #_pr_str "${ast}"; echo "EVAL_AST '${ast}:${r} / ${env}'" _obj_type $(ast); local ot="$(r)" match $(ot) { with symbol ENV_GET $(env) $(ast) return with list _map_with_type _list EVAL $(ast) $(env) with vector _map_with_type _vector EVAL $(ast) $(env) with hash_map local res="" key= val="" hm="$(ANON["${ast}"])" _hash_map; local new_hm="$(r)" eval local keys="\${!$(hm)[@]}" for key in [$(keys)] { eval val="\${$(hm)[\"$(key)\"]}" EVAL $(val) $(env) _assoc! $(new_hm) $(key) $(r) } setglobal r = $(new_hm) with * setglobal r = $(ast) } } proc EVAL { local ast="$(1)" env="$(2)" while true { setglobal r = '' [[ "${__ERROR}" ]] && return 1 #_pr_str "${ast}"; echo "EVAL '${r} / ${env}'" if ! _list? $(ast) { EVAL_AST $(ast) $(env) return } # apply list MACROEXPAND $(ast) $(env) setglobal ast = $(r) if ! _list? $(ast) { EVAL_AST $(ast) $(env) return } _empty? $(ast) && setglobal r = $(ast) && return _nth $(ast) 0; local a0="$(r)" _nth $(ast) 1; local a1="$(r)" _nth $(ast) 2; local a2="$(r)" match $(ANON["${a0}"]) { with def! EVAL $(a2) $(env) [[ "${__ERROR}" ]] && return 1 ENV_SET $(env) $(a1) $(r) return with let* ENV $(env); local let_env="$(r)" local let_pairs=(${ANON["${a1}"]}) local idx=0 { EVAL $(let_pairs[$(( idx + 1))]) $(let_env) ENV_SET $(let_env) $(let_pairs[${idx}]) $(r) setglobal idx = $shExpr(' idx + 2') } setglobal ast = $(a2) setglobal env = $(let_env) # Continue loop with quote setglobal r = $(a1) return with quasiquote QUASIQUOTE $(a1) setglobal ast = $(r) # Continue loop with defmacro! EVAL $(a2) $(env) [[ "${__ERROR}" ]] && return 1 compat array-assign ANON '"${r}_ismacro_"' '"yes'" ENV_SET $(env) $(a1) $(r) return with macroexpand MACROEXPAND $(a1) $(env) return with try* EVAL $(a1) $(env) [[ -z "${__ERROR}" ]] && return _nth $(a2) 0; local a20="$(r)" if test $(ANON["${a20}"]) == "catch__STAR__" { _nth $(a2) 1; local a21="$(r)" _nth $(a2) 2; local a22="$(r)" _list $(a21); local binds="$(r)" ENV $(env) $(binds) $(__ERROR) local try_env="$(r)" setglobal __ERROR = '' EVAL $(a22) $(try_env) } # if no catch* clause, just propagate __ERROR return with do _count $(ast) _slice $(ast) 1 $shExpr(' ${r} - 2 ') EVAL_AST $(r) $(env) [[ "${__ERROR}" ]] && setglobal r = '' && return 1 _last $(ast) setglobal ast = $(r) # Continue loop with if EVAL $(a1) $(env) [[ "${__ERROR}" ]] && return 1 if [[ "${r}" == "${__false}" || "${r}" == "${__nil}" ]] { # eval false form _nth $(ast) 3; local a3="$(r)" if [[ "${a3}" ]] { setglobal ast = $(a3) } else { setglobal r = $(__nil) return } } else { # eval true condition setglobal ast = $(a2) } # Continue loop with fn* _function "ENV \"$(env)\" \"$(a1)\" \"\${@}\"; \ EVAL \"$(a2)\" \"\${r}\"" \ $(a2) $(env) $(a1) return with * EVAL_AST $(ast) $(env) [[ "${__ERROR}" ]] && setglobal r = '' && return 1 local el="$(r)" _first $(el); local f="$(ANON["${r}"])" _rest $(el); local args="$(ANON["${r}"])" #echo "invoke: [${f}] ${args}" if [[ "${f//@/ }" != "${f}" ]] { set -- $(f//@/ ) setglobal ast = $(2) ENV $(3) $(4) $(args) setglobal env = $(r) } else { eval $(f%%@*) $(args) return } # Continue loop } } } # print proc PRINT { if [[ "${__ERROR}" ]] { _pr_str $(__ERROR) yes setglobal r = ""Error: $(r)"" setglobal __ERROR = '' } else { _pr_str $(1) yes } } # repl ENV; setglobal REPL_ENV = $(r) proc REP { setglobal r = '' READ $(1) EVAL $(r) $(REPL_ENV) PRINT $(r) } # core.sh: defined using bash proc _fref { _symbol $(1); local sym="$(r)" _function "$(2) \"\${@}\"" ENV_SET $(REPL_ENV) $(sym) $(r) } for n in [$(!core_ns[@])] { _fref $(n) $(core_ns["${n}"]); } proc _eval { EVAL $(1) $(REPL_ENV); } _fref "eval" _eval _list; setglobal argv = $(r) for _arg in [$(@:2)] { _string $(_arg); _conj! $(argv) $(r); } _symbol "__STAR__ARGV__STAR__" ENV_SET $(REPL_ENV) $(r) $(argv); # core.mal: defined using the language itself REP "(def! not (fn* (a) (if a false true)))" REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" REP "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" REP "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) \`(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))" # load/run file from command line (then exit) if [[ "${1}" ]] { REP "(load-file \"$(1)\")" exit 0 } # repl loop while true { READLINE "user> " || exit "$?" [[ "${r}" ]] && REP $(r) && echo $(r) }