kanaka/mal
1
1
Fork 0
mirror of https://github.com/kanaka/mal.git synced 2024-08-16 17:20:23 +03:00
Code Issues Projects Releases Wiki Activity

Merge branch 'master' into bjh21-unterminated-strings

Browse Source 
This should fix ocaml.
This commit is contained in:
Ben Harris 2019-07-26 00:08:48 +01:00
commit a94c795da6
323 changed files with 3036 additions and 3314 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.travis.yml
View File

@ -109,4 +109,5 @@ script:
# Build, test, perf
- ./.travis_test.sh build ${IMPL}
- ./.travis_test.sh test ${IMPL}
- STEP=stepA REGRESS=1 HARD=1 OPTIONAL=0 ./.travis_test.sh test ${IMPL}
- ./.travis_test.sh perf ${IMPL}

3
.travis_test.sh
View File

@ -61,6 +61,9 @@ test|perf)
if ! ${MAKE} TEST_OPTS="${TEST_OPTS}" \
${MAL_IMPL:+MAL_IMPL=${MAL_IMPL}} \
${REGRESS:+REGRESS=${REGRESS}} \
${HARD:+HARD=${HARD}} \
${DEFERRABLE:+DEFERRABLE=${DEFERRABLE}} \
${OPTIONAL:+OPTIONAL=${OPTIONAL}} \
${ACTION}^${IMPL}${STEP:+^${STEP}}; then
# print debug-file on error
cat ${ACTION}.err

6
Makefile
View File

@ -77,6 +77,7 @@ TEST_OPTS =
# later steps.
REGRESS =
HARD=
DEFERRABLE=1
OPTIONAL=1
@ -142,6 +143,8 @@ dist_EXCLUDES += guile io julia matlab swift
# Extra options to pass to runtest.py
bbc-basic_TEST_OPTS = --test-timeout 60
guile_TEST_OPTS = --test-timeout 120
io_TEST_OPTS = --test-timeout 120
logo_TEST_OPTS = --start-timeout 60 --test-timeout 120
mal_TEST_OPTS = --start-timeout 60 --test-timeout 120
miniMAL_TEST_OPTS = --start-timeout 60 --test-timeout 120
@ -270,6 +273,7 @@ noop =
SPACE = $(noop) $(noop)
export FACTOR_ROOTS := .
opt_HARD = $(if $(strip $(HARD)),$(if $(filter t true T True TRUE 1 y yes Yes YES,$(HARD)),--hard,),)
opt_DEFERRABLE = $(if $(strip $(DEFERRABLE)),$(if $(filter t true T True TRUE 1 y yes Yes YES,$(DEFERRABLE)),--deferrable,--no-deferrable),--no-deferrable)
opt_OPTIONAL = $(if $(strip $(OPTIONAL)),$(if $(filter t true T True TRUE 1 y yes Yes YES,$(OPTIONAL)),--optional,--no-optional),--no-optional)
@ -328,7 +332,7 @@ get_run_prefix = $(strip $(foreach mode,$(call actual_impl,$(1))_MODE, \
# Takes impl and step
# Returns the runtest command prefix (with runtest options) for testing the given step
get_runtest_cmd = $(call get_run_prefix,$(1),$(2),$(if $(filter cs fsharp mal tcl vb,$(1)),RAW=1,)) \
../runtest.py $(opt_DEFERRABLE) $(opt_OPTIONAL) $(call $(1)_TEST_OPTS) $(TEST_OPTS)
../runtest.py $(opt_HARD) $(opt_DEFERRABLE) $(opt_OPTIONAL) $(call $(1)_TEST_OPTS) $(TEST_OPTS)
# Takes impl and step
# Returns the runtest command prefix (with runtest options) for testing the given step

5
ada.2/core.adb
View File

@ -156,8 +156,9 @@ package body Core is
function Keyword (Args : in Types.T_Array) return Types.T is
begin
Err.Check (Args'Length = 1 and then Args (Args'First).Kind = Kind_String,
"expected a string");
Err.Check (Args'Length = 1
and then Args (Args'First).Kind in Types.Kind_Key,
"expected a keyword or a string");
return (Kind_Keyword, Args (Args'First).Str);
end Keyword;

7
ada.2/step8_macros.adb
View File

@ -401,12 +401,7 @@ procedure Step8_Macros is
& " (list 'if (first xs)"
& " (if (> (count xs) 1) (nth xs 1)"
& " (throw ""odd number of forms to cond""))"
& " (cons 'cond (rest (rest xs)))))))"
& "(defmacro! or (fn* (& xs)"
& " (if (empty? xs) nil"
& " (if (= 1 (count xs)) (first xs)"
& " `(let* (or_FIXME ~(first xs))"
& " (if or_FIXME or_FIXME (or ~@(rest xs))))))))";
& " (cons 'cond (rest (rest xs)))))))";
Repl : constant Envs.Ptr := Envs.New_Env;
function Eval_Builtin (Args : in Types.T_Array) return Types.T is
begin

7
ada.2/step9_try.adb
View File

@ -431,12 +431,7 @@ procedure Step9_Try is
& " (list 'if (first xs)"
& " (if (> (count xs) 1) (nth xs 1)"
& " (throw ""odd number of forms to cond""))"
& " (cons 'cond (rest (rest xs)))))))"
& "(defmacro! or (fn* (& xs)"
& " (if (empty? xs) nil"
& " (if (= 1 (count xs)) (first xs)"
& " `(let* (or_FIXME ~(first xs))"
& " (if or_FIXME or_FIXME (or ~@(rest xs))))))))";
& " (cons 'cond (rest (rest xs)))))))";
Repl : constant Envs.Ptr := Envs.New_Env;
function Eval_Builtin (Args : in Types.T_Array) return Types.T is
begin

9
ada.2/stepa_mal.adb
View File

@ -438,15 +438,6 @@ procedure StepA_Mal is
& " (if (> (count xs) 1) (nth xs 1)"
& " (throw ""odd number of forms to cond""))"
& " (cons 'cond (rest (rest xs)))))))"
& "(def! inc (fn* [x] (+ x 1)))"
& "(def! gensym (let* [counter (atom 0)]"
& " (fn* [] (symbol (str ""G__"" (swap! counter inc))))))"
& "(defmacro! or (fn* (& xs)"
& " (if (empty? xs) nil"
& " (if (= 1 (count xs)) (first xs)"
& " (let* (condvar (gensym))"
& " `(let* (~condvar ~(first xs))"
& " (if ~condvar ~condvar (or ~@(rest xs)))))))))"
& "(def! *host-language* ""ada.2"")";
Repl : constant Envs.Ptr := Envs.New_Env;
function Eval_Builtin (Args : in Types.T_Array) return Types.T is

1
ada/step8_macros.adb
View File

@ -527,7 +527,6 @@ begin
RE ("(def! not (fn* (a) (if a false true)))");
RE ("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) "")"")))))");
RE ("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw ""odd number of forms to cond"")) (cons 'cond (rest (rest xs)))))))");
RE ("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))");
-- Command line processing.

1
ada/step9_try.adb
View File

@ -580,7 +580,6 @@ begin
RE ("(def! not (fn* (a) (if a false true)))");
RE ("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) "")"")))))");
RE ("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw ""odd number of forms to cond"")) (cons 'cond (rest (rest xs)))))))");
RE ("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))");
-- Command line processing.

3
ada/stepa_mal.adb
View File

@ -580,9 +580,6 @@ begin
RE ("(def! not (fn* (a) (if a false true)))");
RE ("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) "")"")))))");
RE ("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw ""odd number of forms to cond"")) (cons 'cond (rest (rest xs)))))))");
RE ("(def! inc (fn* [x] (+ x 1)))");
RE ("(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str ""G__"" (swap! counter inc))))))");
RE ("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))");
-- Command line processing.

1
awk/step8_macros.awk
View File

@ -507,7 +507,6 @@ function main(str, ret, i, idx)
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))))))))")
idx = types_allocate()
env_set(repl_env, "'*ARGV*", "(" idx)

1
awk/step9_try.awk
View File

@ -569,7 +569,6 @@ function main(str, ret, i, idx)
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))))))))")
idx = types_allocate()
env_set(repl_env, "'*ARGV*", "(" idx)

3
awk/stepA_mal.awk
View File

@ -572,9 +572,6 @@ function main(str, ret, i, idx)
rep("(def! not (fn* (a) (if a false true)))")
rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))")
rep("(def! inc (fn* [x] (+ x 1)))")
rep("(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))")
rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))")
idx = types_allocate()
env_set(repl_env, "'*ARGV*", "(" idx)

1
bash/step8_macros.sh
View File

@ -250,7 +250,6 @@ ENV_SET "${REPL_ENV}" "${r}" "${argv}";
REP "(def! not (fn* (a) (if a false true)))"
REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"
REP "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"
REP "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) \`(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"
# load/run file from command line (then exit)
if [[ "${1}" ]]; then

1
bash/step9_try.sh
View File

@ -263,7 +263,6 @@ ENV_SET "${REPL_ENV}" "${r}" "${argv}";
REP "(def! not (fn* (a) (if a false true)))"
REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"
REP "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"
REP "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) \`(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"
# load/run file from command line (then exit)
if [[ "${1}" ]]; then

3
bash/stepA_mal.sh
View File

@ -272,9 +272,6 @@ REP "(def! *host-language* \"bash\")"
REP "(def! not (fn* (a) (if a false true)))"
REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"
REP "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"
REP "(def! inc (fn* [x] (+ x 1)))"
REP "(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))"
REP "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) \`(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))"
# load/run file from command line (then exit)
if [[ "${1}" ]]; then

4
basic/step8_macros.in.bas
View File

@ -537,10 +537,6 @@ MAIN:
A$=A$+" forms to cond"+CHR$(34)+")) (cons 'cond (rest (rest xs)))))))"
GOSUB RE:AY=R:GOSUB RELEASE
A$="(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs)"
A$=A$+" `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"
GOSUB RE:AY=R:GOSUB RELEASE
REM load the args file
A$="(def! -*ARGS*- (load-file "+CHR$(34)+".args.mal"+CHR$(34)+"))"
GOSUB RE:AY=R:GOSUB RELEASE

4
basic/step9_try.in.bas
View File

@ -570,10 +570,6 @@ MAIN:
A$=A$+" forms to cond"+CHR$(34)+")) (cons 'cond (rest (rest xs)))))))"
GOSUB RE:AY=R:GOSUB RELEASE
A$="(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs)"
A$=A$+" `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"
GOSUB RE:AY=R:GOSUB RELEASE
REM load the args file
A$="(def! -*ARGS*- (load-file "+CHR$(34)+".args.mal"+CHR$(34)+"))"
GOSUB RE:AY=R:GOSUB RELEASE

12
basic/stepA_mal.in.bas
View File

@ -569,18 +569,6 @@ MAIN:
A$=A$+" forms to cond"+CHR$(34)+")) (cons 'cond (rest (rest xs)))))))"
GOSUB RE:AY=R:GOSUB RELEASE
A$="(def! inc (fn* [x] (+ x 1)))"
GOSUB RE:AY=R:GOSUB RELEASE
A$="(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str "+CHR$(34)
A$=A$+"G__"+CHR$(34)+" (swap! counter inc))))))"
GOSUB RE:AY=R:GOSUB RELEASE
A$="(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs)"
A$=A$+" (let* (c (gensym)) `(let* (~c ~(first xs))"
A$=A$+" (if ~c ~c (or ~@(rest xs)))))))))"
GOSUB RE:AY=R:GOSUB RELEASE
REM load the args file
A$="(def! -*ARGS*- (load-file "+CHR$(34)+".args.mal"+CHR$(34)+"))"
GOSUB RE:AY=R:GOSUB RELEASE

1
bbc-basic/step8_macros.bbc
View File

@ -22,7 +22,6 @@ RESTORE +0
DATA (def! not (fn* (a) (if a false true)))
DATA (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))
DATA (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)))))))
DATA (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))))))))
DATA ""
REPEAT
READ form$

1
bbc-basic/step9_try.bbc
View File

@ -22,7 +22,6 @@ RESTORE +0
DATA (def! not (fn* (a) (if a false true)))
DATA (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))
DATA (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)))))))
DATA (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))))))))
DATA ""
REPEAT
READ form$

3
bbc-basic/stepA_mal.bbc
View File

@ -22,9 +22,6 @@ RESTORE +0
DATA (def! not (fn* (a) (if a false true)))
DATA (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))
DATA (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)))))))
DATA (def! inc (fn* [x] (+ x 1)))
DATA (def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str "G__" (swap! counter inc))))))
DATA (defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))
DATA (def! *host-language* "BBC BASIC V")
DATA ""
REPEAT

1
c/step8_macros.c
View File

@ -291,7 +291,6 @@ void init_repl_env(int argc, char *argv[]) {
RE(repl_env, "",
"(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
RE(repl_env, "", "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))");
RE(repl_env, "", "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))");
}
int main(int argc, char *argv[])

1
c/step9_try.c
View File

@ -316,7 +316,6 @@ void init_repl_env(int argc, char *argv[]) {
RE(repl_env, "",
"(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
RE(repl_env, "", "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))");
RE(repl_env, "", "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))");
}
int main(int argc, char *argv[])

3
c/stepA_mal.c
View File

@ -322,9 +322,6 @@ void init_repl_env(int argc, char *argv[]) {
RE(repl_env, "",
"(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
RE(repl_env, "", "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))");
RE(repl_env, "", "(def! inc (fn* [x] (+ x 1)))");
RE(repl_env, "", "(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))");
RE(repl_env, "", "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))");
}
int main(int argc, char *argv[])

2
chuck/step8_macros.ck
View File

@ -435,9 +435,7 @@ fun string rep(string input)
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))))))))");
fun void main()
{

2
chuck/step9_try.ck
View File

@ -452,9 +452,7 @@ fun string rep(string input)
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))))))))");
fun void main()
{

5
chuck/stepA_mal.ck
View File

@ -454,13 +454,8 @@ fun string rep(string input)
rep("(def! not (fn* (a) (if a false true)))");
rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))");
rep("(def! inc (fn* [x] (+ x 1)))");
rep("(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))");
rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))");
fun void main()
{
int done;

1
clojure/src/mal/step8_macros.cljc
View File

@ -153,7 +153,6 @@
(rep "(def! not (fn* [a] (if a false true)))")
(rep "(def! load-file (fn* [f] (eval (read-string (str \"(do \" (slurp f) \")\")))))")
(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))")
(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))")
;; repl loop
(defn repl-loop []

1
clojure/src/mal/step9_try.cljc
View File

@ -170,7 +170,6 @@
(rep "(def! not (fn* [a] (if a false true)))")
(rep "(def! load-file (fn* [f] (eval (read-string (str \"(do \" (slurp f) \")\")))))")
(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))")
(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))")
;; repl loop
(defn repl-loop []

3
clojure/src/mal/stepA_mal.cljc
View File

@ -180,9 +180,6 @@
(rep "(def! not (fn* [a] (if a false true)))")
(rep "(def! load-file (fn* [f] (eval (read-string (str \"(do \" (slurp f) \")\")))))")
(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))")
(rep "(def! inc (fn* [x] (+ x 1)))")
(rep "(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))")
(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))")
;; repl loop
(defn repl-loop []

1
coffee/step8_macros.coffee
View File

@ -107,7 +107,6 @@ repl_env.set types._symbol('*ARGV*'), []
rep("(def! not (fn* (a) (if a false true)))");
rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))")
rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))")
if process? && process.argv.length > 2
repl_env.set types._symbol('*ARGV*'), process.argv[3..]

1
coffee/step9_try.coffee
View File

@ -116,7 +116,6 @@ repl_env.set types._symbol('*ARGV*'), []
rep("(def! not (fn* (a) (if a false true)))");
rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))")
rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))")
if process? && process.argv.length > 2
repl_env.set types._symbol('*ARGV*'), process.argv[3..]

3
coffee/stepA_mal.coffee
View File

@ -123,9 +123,6 @@ rep("(def! *host-language* \"CoffeeScript\")")
rep("(def! not (fn* (a) (if a false true)))");
rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))")
rep("(def! inc (fn* [x] (+ x 1)))");
rep("(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))");
rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))")
if process? && process.argv.length > 2
repl_env.set types._symbol('*ARGV*'), process.argv[3..]

1
common-lisp/src/step8_macros.lisp
View File

@ -228,7 +228,6 @@
(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))))))))")
(defvar *use-readline-p* nil)

1
common-lisp/src/step9_try.lisp
View File

@ -251,7 +251,6 @@
(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))))))))")
(defvar *use-readline-p* nil)

3
common-lisp/src/stepA_mal.lisp
View File

@ -259,9 +259,6 @@
(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))")
(rep "(def! *host-language* \"common-lisp\")")
(rep "(def! inc (fn* [x] (+ x 1)))")
(rep "(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))")
(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))")
(defvar *use-readline-p* nil)

1
cpp/step8_macros.cpp
View File

@ -280,7 +280,6 @@ static malValuePtr macroExpand(malValuePtr obj, malEnvPtr env)
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)))))))",
"(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))))))))",
"(def! not (fn* (cond) (if cond false true)))",
"(def! load-file (fn* (filename) \
(eval (read-string (str \"(do \" (slurp filename) \")\")))))",

1
cpp/step9_try.cpp
View File

@ -329,7 +329,6 @@ static malValuePtr macroExpand(malValuePtr obj, malEnvPtr env)
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)))))))",
"(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))))))))",
"(def! not (fn* (cond) (if cond false true)))",
"(def! load-file (fn* (filename) \
(eval (read-string (str \"(do \" (slurp filename) \")\")))))",

3
cpp/stepA_mal.cpp
View File

@ -330,12 +330,9 @@ static malValuePtr macroExpand(malValuePtr obj, malEnvPtr env)
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)))))))",
"(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))",
"(def! not (fn* (cond) (if cond false true)))",
"(def! load-file (fn* (filename) \
(eval (read-string (str \"(do \" (slurp filename) \")\")))))",
"(def! inc (fn* [x] (+ x 1)))",
"(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))",
"(def! *host-language* \"C++\")",
};

1
crystal/step8_macros.cr
View File

@ -231,7 +231,6 @@ REPL_ENV.set("eval", Mal::Type.new ->(args : Array(Mal::Type)) { Mal.eval(args[0
Mal.rep "(def! not (fn* (a) (if a false true)))"
Mal.rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"
Mal.rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"
Mal.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))))))))"
argv = Mal::List.new
REPL_ENV.set("*ARGV*", Mal::Type.new argv)

1
crystal/step9_try.cr
View File

@ -248,7 +248,6 @@ REPL_ENV.set("eval", Mal::Type.new ->(args : Array(Mal::Type)) { Mal.eval(args[0
Mal.rep "(def! not (fn* (a) (if a false true)))"
Mal.rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"
Mal.rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"
Mal.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))))))))"
argv = Mal::List.new
REPL_ENV.set("*ARGV*", Mal::Type.new argv)

3
crystal/stepA_mal.cr
View File

@ -254,9 +254,6 @@ REPL_ENV.set("eval", Mal::Type.new ->(args : Array(Mal::Type)) { Mal.eval(args[0
Mal.rep "(def! not (fn* (a) (if a false true)))"
Mal.rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"
Mal.rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"
Mal.rep "(def! inc (fn* [x] (+ x 1)))"
Mal.rep "(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))"
Mal.rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))"
Mal.rep("(def! *host-language* \"crystal\")")
argv = Mal::List.new

1
cs/step8_macros.cs
View File

@ -227,7 +227,6 @@ namespace Mal {
RE("(def! not (fn* (a) (if a false true)))");
RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))");
RE("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))");
if (args.Length > fileIdx) {
RE("(load-file \"" + args[fileIdx] + "\")");

1
cs/step9_try.cs
View File

@ -248,7 +248,6 @@ namespace Mal {
RE("(def! not (fn* (a) (if a false true)))");
RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))");
RE("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))");
if (args.Length > fileIdx) {
RE("(load-file \"" + args[fileIdx] + "\")");

3
cs/stepA_mal.cs
View File

@ -249,9 +249,6 @@ namespace Mal {
RE("(def! not (fn* (a) (if a false true)))");
RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))");
RE("(def! inc (fn* [x] (+ x 1)))");
RE("(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))");
RE("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))");
if (args.Length > fileIdx) {
RE("(load-file \"" + args[fileIdx] + "\")");

1
d/step8_macros.d
View File

@ -263,7 +263,6 @@ void main(string[] args)
re("(def! not (fn* (a) (if a false true)))", repl_env);
re("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))", repl_env);
re("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env);
re("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))", repl_env);
if (args.length > 1)
{

1
d/step9_try.d
View File

@ -292,7 +292,6 @@ void main(string[] args)
re("(def! not (fn* (a) (if a false true)))", repl_env);
re("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))", repl_env);
re("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env);
re("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))", repl_env);
if (args.length > 1)
{

3
d/stepA_mal.d
View File

@ -294,9 +294,6 @@ void main(string[] args)
re("(def! not (fn* (a) (if a false true)))", repl_env);
re("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))", repl_env);
re("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env);
re("(def! inc (fn* [x] (+ x 1)))", repl_env);
re("(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))", repl_env);
re("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))", repl_env);
if (args.length > 1)
{

6
dart/step8_macros.dart
View File

@ -27,12 +27,6 @@ void setupEnv(List<String> argv) {
" (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))))))))");
}
/// Returns `true` if [ast] is a macro call.

9
dart/step9_try.dart
View File

@ -27,12 +27,6 @@ void setupEnv(List<String> argv) {
" (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))))))))");
}
/// Returns `true` if [ast] is a macro call.
@ -194,8 +188,7 @@ MalType EVAL(MalType ast, Env env) {
ast = quasiquote(args.first);
continue;
} else if (symbol.value == 'macroexpand') {
ast = macroexpand(args.first, env);
continue;
return macroexpand(args.first, env);
} else if (symbol.value == 'try*') {
var body = args.first;
if (args.length < 2) {

17
dart/stepA_mal.dart
View File

@ -29,20 +29,6 @@ void setupEnv(List<String> argv) {
" (nth xs 1) "
" (throw \"odd number of forms to cond\")) "
" (cons 'cond (rest (rest xs)))))))");
rep("(def! inc (fn* [x] (+ x 1)))");
rep("(def! gensym"
" (let* [counter (atom 0)]"
" (fn* []"
" (symbol (str \"G__\" (swap! counter inc))))))");
rep("(defmacro! or "
" (fn* (& xs) "
" (if (empty? xs) "
" nil "
" (if (= 1 (count xs)) "
" (first xs) "
" (let* (condvar (gensym)) "
" `(let* (~condvar ~(first xs)) "
" (if ~condvar ~condvar (or ~@(rest xs)))))))))");
}
/// Returns `true` if [ast] is a macro call.
@ -204,8 +190,7 @@ MalType EVAL(MalType ast, Env env) {
ast = quasiquote(args.first);
continue;
} else if (symbol.value == 'macroexpand') {
ast = macroexpand(args.first, env);
continue;
return macroexpand(args.first, env);
} else if (symbol.value == 'try*') {
var body = args.first;
if (args.length < 2) {

3
docs/cheatsheet.html
View File

@ -247,9 +247,6 @@
<span class=file>step9_try.EXT</span>:
<span class=function>EVAL</span>(<span class=var>ast</span>, <span class=var>env</span>):
- set <span class=malsym>*host-language*</span> in <span class=var>repl_env</span> to host language name
- <span class=malsym>inc</span>: define (using <span class=function>rep</span>()) a function incrementing an integer
- <span class=malsym>gensym</span>: define using <span class=function>rep</span>()), return unique symbol
- <span class=malsym>or</span>: use <span class=malsym>gensym</span> to fix <span class=malsym>or</span> macro
<span class=function>main</span>(<span class=var>args</span>): <span class=function>rep</span>(<span class=string>"(println (str \"Mal [\" <span class=malsym>*host-language*</span> \"]\"))"</span>)
</code></pre>
</td>

129
docs/exercises.md Normal file
View File

@ -0,0 +1,129 @@
# Exercises to learn MAL
The process introduces LISP by describing the internals of selected
low-level constructs. As a complementary and more traditional
approach, you may want to solve the following exercises in the MAL
language itself, using any of the existing implementations.
You are encouraged to use the shortcuts defined in the step files
(`not`...) and `the `lib/` subdirectory (`reduce`...) whenever you
find that they increase the readability.
The difficulty is progressive in each section, but they focus on
related topics and it is recommended to start them in parallel.
Some solutions are given in the `examples` directory. Feel free to
submit new solutions, or new exercises.
## Replace parts of the process with native constructs
Once you have a working implementation, you may want to implement
parts of the process inside the MAL language itself. This has no other
purpose than learning the MAL language. Once it exists, a built-in
implementation will always be more efficient than a native
implementation. Also, the functions described in MAL process are
selected for educative purposes, so portability accross
implementations does not matter much.
You may easily check your answers by passing them directly to the
interpreter. They will hide the built-in functions carrying the same
names, and the usual tests will check them.
```
make REGRESS=1 TEST_OPTS='--hard --pre-eval=\(load-file\ \"../answer.mal\"\)' test^IMPL^stepA
```
- Implement `nil?`, `true?`, `false?`, `empty?` and `sequential` with
another built-in function.
- Implement `>`, `<=` and `>=` with `<`.
- Implement `hash-map`, `list`, `prn` and `swap!` as non-recursive
functions.
- Implement `count`, `nth`, `map`, `concat` and `conj` with the empty
constructor `()`, `empty?`, `cons`, `first` and `rest`.
You may use `or` to make the definition of `nth` a bit less ugly,
but avoid `cond` because its definition refers to `nth`.
Let `count` and `nth` benefit from tail call optimization.
Try to replace explicit recursions with calls to `reduce` and `foldr`.
Once you have tested your solution, you should comment at least
`nth`. Many implementations, for example `foldr` in `core.mal`,
rely on an efficient `nth` built-in function.
- Implement the `do` special as a non-recursive function. The special
form will hide your implementation, so in order to test it, you will
need to give it another name and adapt the test accordingly.
- Implement quoting with macros.
The same remark applies.
- Implement most of `let*` as a macro that uses `fn*` and recursion.
The same remark applies.
A macro is necessary because a function would attempt to evaluate
the first argument.
Once your answer passes most tests and you understand which part is
tricky, you should search for black magic recipes on the web. Few of
us mortals are known to have invented a full solution on their own.
- Implement `apply`.
- Implement maps using lists.
- Recall how maps must be evaluated.
- In the tests, you may want to replace `{...}` with `(hash-map ...)`.
- An easy solution relies on lists alterning keys and values, so
that the `hash-map` is only a list in reverse order so that the
last definition takes precedence during searches.
- As a more performant solution will use lists to construct trees,
and ideally keep them balanced. You will find examples in most
teaching material about functional languages.
- Recall that `dissoc` is an optional feature. One you can implement
dissoc is by assoc'ing a replacement value that is a magic delete
keyword (e.g.: `__..DELETED..__`) which allows you to shadow
values in the lower levels of the structure. The hash map
functions have to detect that and do the right thing. e.g. `(keys
...)` might have to keep track of deleted values as it is scanning
the tree and not add those keys when it finds them further down
the tree.
- Implement macros within MAL.
## More folds
- Compute the sum of a sequence of numbers.
- Compute the product of a sequence of numbers.
- Compute the logical conjunction ("and") and disjunction ("or") of a
sequence of MAL values interpreted as boolean values. For example,
`(conjunction [true 1 0 "" "a" nil true {}])`
should evaluate to `false` or `nil` because of the `nil` element.
Why are folds not the best solution here, in terms of average
performances?
- Does "-2-3-4" translate to `(reduce - 0 [2 3 4])`?
- Suggest better solutions for
`(reduce str "" xs)` and
`(reduce concat [] xs)`.
- What does `(reduce (fn* [acc _] acc) xs)` nil answer?
- The answer is `(fn* [xs] (reduce (fn* [_ x] x) nil xs))`.
What was the question?
- What is the intent of
`(reduce (fn* [acc x] (if (< acc x) x acc)) 0 xs)`?
Why is it the wrong answer?
- Though `(sum (map count xs))` or `(count (apply concat xs))` can be
considered more readable, implement the same effect with a single loop.
- Compute the maximal length in a list of lists.
- How would you name
`(fn* [& fs] (foldr (fn* [f acc] (fn* [x] (f (acc x)))) identity fs))`?

2
elisp/step8_macros.el
View File

@ -181,9 +181,7 @@
(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))))))))")
(defun readln (prompt)
;; C-d throws an error

2
elisp/step9_try.el
View File

@ -197,9 +197,7 @@
(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))))))))")
(defun readln (prompt)
;; C-d throws an error

5
elisp/stepA_mal.el
View File

@ -198,12 +198,7 @@
(rep "(def! not (fn* (a) (if a false true)))")
(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
(rep "(def! inc (fn* [x] (+ x 1)))")
(rep "(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))")
(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* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))")
(defun readln (prompt)
;; C-d throws an error

1
elixir/lib/mal/core.ex
View File

@ -203,6 +203,7 @@ defmodule Mal.Core do
defp with_meta([{type, ast, _old_meta}, meta]), do: {type, ast, meta}
defp with_meta([%Function{} = func, meta]), do: %{func | meta: meta}
defp with_meta(_), do: nil
defp deref(args) do
apply(&Mal.Atom.deref/1, args)

11
elixir/lib/mix/tasks/step8_macros.ex
View File

@ -42,17 +42,6 @@ defmodule Mix.Tasks.Step8Macros do
(cons 'cond (rest (rest xs)))))))"
""", env)
# or:
read_eval_print("""
(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))))))))
""", env)
Mal.Env.set(env, "eval", %Function{value: fn [ast] ->
eval(ast, env)
end})

11
elixir/lib/mix/tasks/step9_try.ex
View File

@ -42,17 +42,6 @@ defmodule Mix.Tasks.Step9Try do
(cons 'cond (rest (rest xs)))))))"
""", env)
# or:
read_eval_print("""
(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))))))))
""", env)
Mal.Env.set(env, "eval", %Function{value: fn [ast] ->
eval(ast, env)
end})

22
elixir/lib/mix/tasks/stepA_mal.ex
View File

@ -50,28 +50,6 @@ defmodule Mix.Tasks.StepAMal do
(cons 'cond (rest (rest xs)))))))"
""", env)
# gensym
read_eval_print("(def! inc (fn* [x] (+ x 1)))", env)
read_eval_print("""
(def! gensym
(let* [counter (atom 0)]
(fn* []
(symbol (str \"G__\" (swap! counter inc))))))
""", env)
# or:
read_eval_print("""
(defmacro! or
(fn* (& xs)
(if (empty? xs)
nil
(if (= 1 (count xs))
(first xs)
(let* (condvar (gensym))
`(let* (~condvar ~(first xs))
(if ~condvar ~condvar (or ~@(rest xs)))))))))
""", env)
Mal.Env.set(env, "eval", %Function{value: fn [ast] ->
eval(ast, env)
end})

8
elm/step8_macros.elm
View File

@ -80,14 +80,6 @@ malInit =
(nth xs 1)
(throw "odd number of forms to cond"))
(cons 'cond (rest (rest xs)))))))"""
, """(defmacro! or
(fn* (& xs)
(if (empty? xs)
nil
(if (= 1 (count xs))
(first xs)
`(let* (or_FIXME ~(first xs))
(if or_FIXME or_FIXME (or ~@(rest xs))))))))"""
]

8
elm/step9_try.elm
View File

@ -80,14 +80,6 @@ malInit =
(nth xs 1)
(throw "odd number of forms to cond"))
(cons 'cond (rest (rest xs)))))))"""
, """(defmacro! or
(fn* (& xs)
(if (empty? xs)
nil
(if (= 1 (count xs))
(first xs)
`(let* (or_FIXME ~(first xs))
(if or_FIXME or_FIXME (or ~@(rest xs))))))))"""
]

16
elm/stepA_mal.elm
View File

@ -81,22 +81,6 @@ malInit =
(nth xs 1)
(throw "odd number of forms to cond"))
(cons 'cond (rest (rest xs)))))))"""
, """(def! inc (fn* [x] (+ x 1)))"""
, """(def! gensym
(let* [counter (atom 0)]
(fn* []
(symbol (str "G__" (swap! counter inc))))))"""
, """(defmacro! or
(fn* (& xs)
(if (empty? xs)
nil
(if (= 1 (count xs))
(first xs)
(let* (condvar (gensym))
`(let* (~condvar ~(first xs))
(if ~condvar
~condvar
(or ~@(rest xs)))))))))"""
]

1
erlang/src/step8_macros.erl
View File

@ -20,7 +20,6 @@ init() ->
eval(read("(def! not (fn* (a) (if a false true)))"), Env),
eval(read("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"), Env),
eval(read("(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)))))))"), Env),
eval(read("(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))))))))"), Env),
Env.
loop(Env) ->

1
erlang/src/step9_try.erl
View File

@ -20,7 +20,6 @@ init() ->
eval(read("(def! not (fn* (a) (if a false true)))"), Env),
eval(read("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"), Env),
eval(read("(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)))))))"), Env),
eval(read("(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))))))))"), Env),
Env.
loop(Env) ->

3
erlang/src/stepA_mal.erl
View File

@ -22,9 +22,6 @@ init() ->
eval(read("(def! not (fn* (a) (if a false true)))"), Env),
eval(read("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"), Env),
eval(read("(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)))))))"), Env),
eval(read("(def! inc (fn* [x] (+ x 1)))"), Env),
eval(read("(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))"), Env),
eval(read("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (\~condvar \~(first xs)) (if \~condvar \~condvar (or \~@(rest xs)))))))))"), Env),
Env.
loop(Env) ->

1
es6/step8_macros.mjs
View File

@ -128,7 +128,6 @@ env_set(repl_env, Symbol.for('*ARGV*'), [])
REP('(def! not (fn* (a) (if a false true)))')
REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))')
REP('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list \'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons \'cond (rest (rest xs)))))))')
REP('(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))')
if (process.argv.length > 2) {
env_set(repl_env, Symbol.for('*ARGV*'), process.argv.slice(3))

1
es6/step9_try.mjs
View File

@ -139,7 +139,6 @@ env_set(repl_env, Symbol.for('*ARGV*'), [])
REP('(def! not (fn* (a) (if a false true)))')
REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))')
REP('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list \'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons \'cond (rest (rest xs)))))))')
REP('(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))')
if (process.argv.length > 2) {
env_set(repl_env, Symbol.for('*ARGV*'), process.argv.slice(3))

3
es6/stepA_mal.mjs
View File

@ -140,9 +140,6 @@ REP('(def! *host-language* "ecmascript6")')
REP('(def! not (fn* (a) (if a false true)))')
REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))')
REP('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list \'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons \'cond (rest (rest xs)))))))')
REP('(def! inc (fn* [x] (+ x 1)))')
REP('(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))')
REP('(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))')
if (process.argv.length > 2) {
env_set(repl_env, Symbol.for('*ARGV*'), process.argv.slice(3))

170
examples/exercises.mal Normal file
View File

@ -0,0 +1,170 @@
;; These are the answers to the questions in ../docs/exercise.md.
;; In order to avoid unexpected circular dependencies among solutions,
;; this files attempts to be self-contained.
(def! identity (fn* [x] x))
(def! reduce (fn* (f init xs)
(if (empty? xs) init (reduce f (f init (first xs)) (rest xs)))))
(def! foldr (fn* [f init xs]
(if (empty? xs) init (f (first xs) (foldr f init (rest xs))))))
;; Reimplementations.
(def! nil? (fn* [x] (= x nil )))
(def! true? (fn* [x] (= x true )))
(def! false? (fn* [x] (= x false)))
(def! empty? (fn* [x] (= x [] )))
(def! sequential?
(fn* [x]
(if (list? x) true (vector? x))))
(def! > (fn* [a b] (< b a) ))
(def! <= (fn* [a b] (not (< b a))))
(def! >= (fn* [a b] (not (< a b))))
(def! hash-map (fn* [& xs] (apply assoc {} xs)))
(def! list (fn* [& xs] xs))
(def! prn (fn* [& xs] (println (apply pr-str xs))))
(def! swap! (fn* [a f & xs] (reset! a (apply f (deref a) xs))))
(def! count
(fn* [xs]
(if (nil? xs)
0
(reduce (fn* [acc _] (+ 1 acc)) 0 xs))))
(def! nth
(fn* [xs index]
(if (if (<= 0 index) (not (empty? xs))) ; logical and
(if (= 0 index)
(first xs)
(nth (rest xs) (- index 1)))
(throw "nth: index out of range"))))
(def! map
(fn* [f xs]
(foldr (fn* [x acc] (cons (f x) acc)) () xs)))
(def! concat
(fn* [& xs]
(foldr (fn* [xs ys] (foldr cons ys xs)) () xs)))
(def! conj
(fn* [xs & ys]
(if (vector? xs)
(apply vector (concat xs ys))
(reduce (fn* [xs x] (cons x xs)) xs ys))))
(def! do2 (fn* [& xs] (nth xs (- (count xs) 1))))
(def! do3 (fn* [& xs] (reduce (fn* [acc x] x) nil xs)))
;; do2 will probably be more efficient when lists are implemented as
;; arrays with direct indexing, but when they are implemented as
;; linked lists, do3 may win because it only does one traversal.
(defmacro! quote (fn* [ast] (list (fn* [] ast))))
(def! _quasiquote_iter (fn* [x acc]
(if (if (list? x) (= (first x) 'splice-unquote)) ; logical and
(list 'concat (first (rest x)) acc)
(list 'cons (list 'quasiquote x) acc))))
(defmacro! quasiquote (fn* [ast]
(if (list? ast)
(if (= (first ast) 'unquote)
(first (rest ast))
(foldr _quasiquote_iter () ast))
(if (vector? ast)
;; TODO: once tests are fixed, replace 'list with 'vector.
(list 'apply 'list (foldr _quasiquote_iter () ast))
(list 'quote ast)))))
(def! _letA_keys (fn* [binds]
(if (empty? binds)
()
(cons (first binds) (_letA_keys (rest (rest binds)))))))
(def! _letA_values (fn* [binds]
(if (empty? binds)
()
(_letA_keys (rest binds)))))
(def! _letA (fn* [binds form]
(cons (list 'fn* (_letA_keys binds) form) (_letA_values binds))))
;; Fails for (let* [a 1 b (+ 1 a)] b)
(def! _letB (fn* [binds form]
(if (empty? binds)
form
(list (list 'fn* [(first binds)] (_letB (rest (rest binds)) form))
(first (rest binds))))))
;; Fails for (let* (cst (fn* (n) (if (= n 0) nil (cst (- n 1))))) (cst 1))
(def! _c_combinator (fn* [x] (x x)))
(def! _d_combinator (fn* [f] (fn* [x] (f (fn* [v] ((x x) v))))))
(def! _Y_combinator (fn* [x] (_c_combinator (_d_combinator x))))
(def! _letC
(fn* [binds form]
(if (empty? binds)
form
(list (list 'fn* [(first binds)] (_letC (rest (rest binds)) form))
(list '_Y_combinator (list 'fn* [(first binds)] (first (rest binds))))))))
;; Fails for mutual recursion.
;; See http://okmij.org/ftp/Computation/fixed-point-combinators.html
;; if you are motivated to implement solution D.
(defmacro! let* _letC)
(def! apply
;; Replace (f a b [c d]) with ('f 'a 'b 'c 'd) then evaluate the
;; resulting function call (the surrounding environment does not
;; matter when evaluating a function call).
;; Use nil as marker to detect deepest recursive call.
(let* [q (fn* [x] (list 'quote x))
iter (fn* [x acc]
(if (nil? acc) ; x is the last element (a sequence)
(map q x)
(cons (q x) acc)))]
(fn* [& xs] (eval (foldr iter nil xs)))))
;; Folds
(def! sum (fn* [xs] (reduce + 0 xs)))
(def! product (fn* [xs] (reduce * 1 xs)))
(def! conjunction
(let* [and2 (fn* [acc x] (if acc x false))]
(fn* [xs]
(reduce and2 true xs))))
(def! disjunction
(let* [or2 (fn* [acc x] (if acc true x))]
(fn* [xs]
(reduce or2 false xs))))
;; It would be faster to stop the iteration on first failure
;; (conjunction) or success (disjunction). Even better, `or` in the
;; stepA and `and` in `core.mal` stop evaluating their arguments.
;; Yes, -2-3-4 means (((0-2)-3)-4).
;; `(reduce str "" xs)` is equivalent to `apply str xs`
;; and `(reduce concat () xs)` is equivalent to `apply concat xs`.
;; The built-in iterations are probably faster.
;; `(reduce (fn* [acc _] acc) nil xs)` is equivalent to `nil`.
;; For (reduce (fn* [acc x] x) nil xs))), see do3 above.
;; `(reduce (fn* [acc x] (if (< acc x) x acc)) 0 xs)` computes the
;; maximum of a list of non-negative integers. It is hard to find an
;; initial value fitting all purposes.
(def! sum_len
(let* [add_len (fn* [acc x] (+ acc (count x)))]
(fn* [xs]
(reduce add_len 0 xs))))
(def! max_len
(let* [update_max (fn* [acc x] (let* [l (count x)] (if (< acc l) l acc)))]
(fn* [xs]
(reduce update_max 0 xs))))
(def! compose
(let* [compose2 (fn* [f acc] (fn* [x] (f (acc x))))]
(fn* [& fs]
(foldr compose2 identity fs))))
;; ((compose f1 f2) x) is equivalent to (f1 (f2 x))
;; This is the mathematical composition. For practical purposes, `->`
;; and `->>` defined in `core.mal` are more efficient and general.
;; This `nil` is intentional so that the result of doing `load-file` is
;; `nil` instead of whatever happens to be the last definiton.
;; FIXME: can be removed after merge of load-file-trailing-new-line-nil
nil

1
factor/step8_macros/step8_macros.factor
View File

@ -141,7 +141,6 @@ command-line get dup empty? [ rest ] unless "*ARGV*" pick set-at
(def! not (fn* (a) (if a false true)))
(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))
(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)))))))
(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))))))))
" string-lines harvest [ REP drop ] each
MAIN: main

1
factor/step9_try/step9_try.factor
View File

@ -153,7 +153,6 @@ command-line get dup empty? [ rest ] unless "*ARGV*" pick set-at
(def! not (fn* (a) (if a false true)))
(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))
(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)))))))
(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))))))))
" string-lines harvest [ REP drop ] each
MAIN: main

17
factor/stepA_mal/stepA_mal.factor
View File

@ -50,8 +50,12 @@ DEFER: EVAL
:: eval-try* ( params env -- maltype )
[ params first env EVAL ]
[
params second second env new-env [ env-set ] keep
params second third swap EVAL
params length 1 > [
params second second env new-env [ env-set ] keep
params second third swap EVAL
] [
throw
] if
] recover ;
: args-split ( bindlist -- bindlist restbinding/f )
@ -121,7 +125,11 @@ M: callable apply call( x -- y ) f ;
: PRINT ( maltype -- str ) pr-str ;
: REP ( str -- str )
[ READ repl-env get EVAL ] [ nip ] recover PRINT ;
[
READ repl-env get EVAL PRINT
] [
nip pr-str "Error: " swap append
] recover ;
: REPL ( -- )
"(println (str \"Mal [\" *host-language* \"]\"))" REP drop
@ -147,9 +155,6 @@ command-line get dup empty? [ rest ] unless "*ARGV*" pick set-at
(def! not (fn* (a) (if a false true)))
(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))
(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! inc (fn* [x] (+ x 1)))
(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))
(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))
" string-lines harvest [ READ repl-env get EVAL drop ] each
MAIN: main

1
fantom/src/step8_macros/fan/main.fan
View File

@ -153,7 +153,6 @@ class Main
REP("(def! not (fn* (a) (if a false true)))", repl_env)
REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))", repl_env)
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)))))))", repl_env)
REP("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))", repl_env)
if (!args.isEmpty)
{

1
fantom/src/step9_try/fan/main.fan
View File

@ -165,7 +165,6 @@ class Main
REP("(def! not (fn* (a) (if a false true)))", repl_env)
REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))", repl_env)
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)))))))", repl_env)
REP("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))", repl_env)
if (!args.isEmpty)
{

3
fantom/src/stepA_mal/fan/main.fan
View File

@ -166,9 +166,6 @@ class Main
REP("(def! not (fn* (a) (if a false true)))", repl_env)
REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))", repl_env)
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)))))))", repl_env)
REP("(def! inc (fn* [x] (+ x 1)))", repl_env)
REP("(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))", repl_env)
REP("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))", repl_env)
if (!args.isEmpty)
{

1
forth/step8_macros.fs
View File

@ -310,7 +310,6 @@ defcore swap! { argv argc -- val }
s\" (def! not (fn* (x) (if x false true)))" rep 2drop
s\" (def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" rep 2drop
s\" (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 2drop
s\" (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))))))))" rep 2drop
: repl ( -- )
begin

1
forth/step9_try.fs
View File

@ -353,7 +353,6 @@ defcore map ( argv argc -- list )
s\" (def! not (fn* (x) (if x false true)))" rep 2drop
s\" (def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" rep 2drop
s\" (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 2drop
s\" (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))))))))" rep 2drop
: repl ( -- )
begin

3
forth/stepA_mal.fs
View File

@ -361,9 +361,6 @@ s\" (def! *host-language* \"forth\")" rep 2drop
s\" (def! not (fn* (x) (if x false true)))" rep 2drop
s\" (def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" rep 2drop
s\" (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 2drop
s\" (def! inc (fn* [x] (+ x 1)))" rep 2drop
s\" (def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))" rep 2drop
s\" (defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))" rep 2drop
: repl ( -- )
s\" (println (str \"Mal [\" *host-language* \"]\"))" rep 2drop

1
fsharp/step8_macros.fs
View File

@ -186,7 +186,6 @@ module REPL
RE env """
(def! not (fn* (a) (if a false true)))
(def! load-file (fn* (f) (eval (read-string (slurp f)))))
(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_ ~(first xs)) (if or_ or_ (or ~@(rest xs))))))))
(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)))))))
""" |> Seq.iter ignore

1
fsharp/step9_try.fs
View File

@ -206,7 +206,6 @@ module REPL
RE env """
(def! not (fn* (a) (if a false true)))
(def! load-file (fn* (f) (eval (read-string (slurp f)))))
(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_ ~(first xs)) (if or_ or_ (or ~@(rest xs))))))))
(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)))))))
""" |> Seq.iter ignore

3
fsharp/stepA_mal.fs
View File

@ -218,9 +218,6 @@ module REPL
(def! not (fn* (a) (if a false true)))
(def! load-file (fn* (f) (eval (read-string (slurp f)))))
(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! inc (fn* [x] (+ x 1)))
(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str "G__" (swap! counter inc))))))
(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))
""" |> Seq.iter ignore
env

2
gnu-smalltalk/step8_macros.st
View File

@ -270,9 +270,7 @@ replEnv set: #'*ARGV*' value: (MALList new: argv).
MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv.
MAL rep: '(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))' env: replEnv.
MAL rep: '(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))' env: replEnv.
MAL 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))))))))' env: replEnv.
Smalltalk arguments notEmpty ifTrue: [
MAL rep: '(load-file "', Smalltalk arguments first, '")' env: replEnv

2
gnu-smalltalk/step9_try.st
View File

@ -291,9 +291,7 @@ replEnv set: #'*ARGV*' value: (MALList new: argv).
MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv.
MAL rep: '(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))' env: replEnv.
MAL rep: '(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))' env: replEnv.
MAL 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))))))))' env: replEnv.
Smalltalk arguments notEmpty ifTrue: [
MAL rep: '(load-file "', Smalltalk arguments first, '")' env: replEnv

4
gnu-smalltalk/stepA_mal.st
View File

@ -292,11 +292,7 @@ replEnv set: #'*host-language*' value: (MALString new: 'smalltalk').
MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv.
MAL rep: '(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))' env: replEnv.
MAL rep: '(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))' env: replEnv.
MAL rep: '(def! inc (fn* [x] (+ x 1)))' env: replEnv.
MAL rep: '(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str "G__" (swap! counter inc))))))' env: replEnv.
MAL rep: '(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))' env: replEnv.
Smalltalk arguments notEmpty ifTrue: [
MAL rep: '(load-file "', Smalltalk arguments first, '")' env: replEnv

1
go/src/step8_macros/step8_macros.go
View File

@ -311,7 +311,6 @@ func main() {
rep("(def! not (fn* (a) (if a false true)))")
rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))")
rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))")
// called with mal script to load and eval
if len(os.Args) > 1 {

1
go/src/step9_try/step9_try.go
View File

@ -339,7 +339,6 @@ func main() {
rep("(def! not (fn* (a) (if a false true)))")
rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))")
rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))")
// called with mal script to load and eval
if len(os.Args) > 1 {

3
go/src/stepA_mal/stepA_mal.go
View File

@ -340,9 +340,6 @@ func main() {
rep("(def! not (fn* (a) (if a false true)))")
rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))")
rep("(def! inc (fn* [x] (+ x 1)))")
rep("(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))")
rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))")
// called with mal script to load and eval
if len(os.Args) > 1 {

1
groovy/step8_macros.groovy
View File

@ -150,7 +150,6 @@ repl_env.set(new MalSymbol("*ARGV*"), this.args as List)
REP("(def! not (fn* (a) (if a false true)))")
REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))");
REP("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))");
if (this.args.size() > 0) {

1
groovy/step9_try.groovy
View File

@ -168,7 +168,6 @@ repl_env.set(new MalSymbol("*ARGV*"), this.args as List)
REP("(def! not (fn* (a) (if a false true)))")
REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))");
REP("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))");
if (this.args.size() > 0) {

4
groovy/stepA_mal.groovy
View File

@ -169,10 +169,6 @@ REP("(def! *host-language* \"groovy\")")
REP("(def! not (fn* (a) (if a false true)))")
REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))");
REP("(def! inc (fn* [x] (+ x 1)))");
REP("(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))");
REP("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))");
if (this.args.size() > 0) {
repl_env.set(new MalSymbol("*ARGV*"), this.args.drop(1) as List)

2
guile/core.scm
View File

@ -150,7 +150,7 @@
((callable? c)
(let ((cc (make-callable ht
(callable-unbox c)
(and (hash-table? ht) (hash-ref ht "ismacro"))
#f
(callable-closure c))))
cc))
(else

7
guile/step5_tco.scm
View File

@ -130,9 +130,4 @@
(EVAL-string "(def! not (fn* (x) (if x false true)))")
;; NOTE: we have to reduce stack size to pass step5 test
((@ (system vm vm) call-with-stack-overflow-handler)
1024
(lambda () (REPL))
(lambda k (throw 'mal-error "stack overflow")))
(REPL)

1
guile/step8_macros.scm
View File

@ -163,7 +163,6 @@
(EVAL-string "(def! not (fn* (x) (if x false true)))")
(EVAL-string "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
(EVAL-string "(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)))))))")
(EVAL-string "(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))))))))")
(let ((args (cdr (command-line))))
(cond

1
guile/step9_try.scm
View File

@ -186,7 +186,6 @@
(EVAL-string "(def! not (fn* (x) (if x false true)))")
(EVAL-string "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
(EVAL-string "(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)))))))")
(EVAL-string "(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))))))))")
(let ((args (cdr (command-line))))
(cond

3
guile/stepA_mal.scm
View File

@ -183,9 +183,6 @@
(EVAL-string "(def! not (fn* (x) (if x false true)))")
(EVAL-string "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
(EVAL-string "(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)))))))")
(EVAL-string "(def! inc (fn* [x] (+ x 1)))")
(EVAL-string "(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))")
(EVAL-string "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))")
(EVAL-string "(def! *host-language* \"guile\")")
(let ((args (cdr (command-line))))

15
guile/tests/step5_tco.mal
View File

@ -1,15 +0,0 @@
;; Test recursive non-tail call function
(def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1))))))
(sum-to 10)
;=>55
;;; no try* yet, so test completion of side-effects
(def! res1 nil)
;=>nil
;;; For implementations without their own TCO this should fail and
;;; leave res1 unchanged
(def! res1 (sum-to 10000))
res1
;=>nil

481
haskell/Core.hs
View File

@ -3,313 +3,384 @@ module Core
where
import System.IO (hFlush, stdout)
import Control.Exception (catch)
import Control.Monad.Except (throwError)
import Control.Monad.Trans (liftIO)
import qualified Data.Map as Map
import Data.Foldable (foldlM)
import Data.Time.Clock.POSIX (getPOSIXTime)
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Data.IORef (newIORef, readIORef, writeIORef)
import Readline (readline)
import Reader (read_str)
import Types
import Printer (_pr_str, _pr_list)
import Printer (_pr_list)
-- General functions
equal_Q [a, b] = return $ if a == b then MalTrue else MalFalse
equal_Q :: Fn
equal_Q [a, b] = return $ MalBoolean $ a == b
equal_Q _ = throwStr "illegal arguments to ="
run_1 :: (MalVal -> MalVal) -> [MalVal] -> IOThrows MalVal
run_1 f (x:[]) = return $ f x
run_1 _ _ = throwStr "function takes a single argument"
run_2 :: (MalVal -> MalVal -> MalVal) -> [MalVal] -> IOThrows MalVal
run_2 f (x:y:[]) = return $ f x y
run_2 _ _ = throwStr "function takes a two arguments"
-- Error/Exception functions
throw (mv:[]) = throwMalVal mv
throw :: Fn
throw [mv] = throwError mv
throw _ = throwStr "illegal arguments to throw"
-- Unary predicates
pred1 :: (MalVal -> Bool) -> Fn
pred1 hostPred [x] = return $ MalBoolean $ hostPred x
pred1 _ _ = throwStr "illegal call to unary predicate"
atom_Q :: MalVal -> Bool
atom_Q (MalAtom _ _) = True
atom_Q _ = False
false_Q :: MalVal -> Bool
false_Q (MalBoolean False) = True
false_Q _ = False
fn_Q :: MalVal -> Bool
fn_Q (MalFunction {macro=False}) = True
fn_Q _ = False
macro_Q :: MalVal -> Bool
macro_Q (MalFunction {macro=True}) = True
macro_Q _ = False
map_Q :: MalVal -> Bool
map_Q (MalHashMap _ _) = True
map_Q _ = False
keyword_Q :: MalVal -> Bool
keyword_Q (MalString (c : _)) = c == keywordMagic
keyword_Q _ = False
list_Q :: MalVal -> Bool
list_Q (MalSeq _ (Vect False) _) = True
list_Q _ = False
nil_Q :: MalVal -> Bool
nil_Q Nil = True
nil_Q _ = False
number_Q :: MalVal -> Bool
number_Q (MalNumber _) = True
number_Q _ = False
string_Q :: MalVal -> Bool
string_Q (MalString "") = True
string_Q (MalString (c : _)) = c /= keywordMagic
string_Q _ = False
symbol_Q :: MalVal -> Bool
symbol_Q (MalSymbol _) = True
symbol_Q _ = False
true_Q :: MalVal -> Bool
true_Q (MalBoolean True) = True
true_Q _ = False
vector_Q :: MalVal -> Bool
vector_Q (MalSeq _ (Vect True) _) = True
vector_Q _ = False
-- Scalar functions
symbol (MalString str:[]) = return $ MalSymbol str
symbol :: Fn
symbol [MalString s] = return $ MalSymbol s
symbol _ = throwStr "symbol called with non-string"
keyword (MalString ('\x029e':str):[]) = return $ MalString $ "\x029e" ++ str
keyword (MalString str:[]) = return $ MalString $ "\x029e" ++ str
keyword :: Fn
keyword [kw@(MalString (c : _))] | c == keywordMagic = return kw
keyword [MalString s] = return $ MalString (keywordMagic : s)
keyword _ = throwStr "keyword called with non-string"
-- String functions
pr_str args = do
return $ MalString $ _pr_list True " " args
pr_str :: Fn
pr_str args = liftIO $ MalString <$> _pr_list True " " args
str args = do
return $ MalString $ _pr_list False "" args
str :: Fn
str args = liftIO $ MalString <$> _pr_list False "" args
prn args = do
liftIO $ putStrLn $ _pr_list True " " args
liftIO $ hFlush stdout
prn :: Fn
prn args = liftIO $ do
putStrLn =<< _pr_list True " " args
hFlush stdout
return Nil
println args = do
liftIO $ putStrLn $ _pr_list False " " args
liftIO $ hFlush stdout
println :: Fn
println args = liftIO $ do
putStrLn =<< _pr_list False " " args
hFlush stdout
return Nil
slurp ([MalString path]) = do
str <- liftIO $ readFile path
return $ MalString str
slurp :: Fn
slurp [MalString path] = MalString <$> liftIO (readFile path)
slurp _ = throwStr "invalid arguments to slurp"
do_readline ([MalString prompt]) = do
str <- liftIO $ readline prompt
case str of
do_readline :: Fn
do_readline [MalString prompt] = do
maybeLine <- liftIO $ readline prompt
case maybeLine of
Nothing -> throwStr "readline failed"
Just str -> return $ MalString str
Just line -> return $ MalString line
do_readline _ = throwStr "invalid arguments to readline"
read_string :: Fn
read_string [MalString s] = read_str s
read_string _ = throwStr "invalid read-string"
-- Numeric functions
num_op op [MalNumber a, MalNumber b] = do
return $ MalNumber $ op a b
num_op :: (Int -> Int -> Int) -> Fn
num_op op [MalNumber a, MalNumber b] = return $ MalNumber $ op a b
num_op _ _ = throwStr "illegal arguments to number operation"
cmp_op op [MalNumber a, MalNumber b] = do
return $ if op a b then MalTrue else MalFalse
cmp_op :: (Int -> Int -> Bool) -> Fn
cmp_op op [MalNumber a, MalNumber b] = return $ MalBoolean $ op a b
cmp_op _ _ = throwStr "illegal arguments to comparison operation"
time_ms _ = do
t <- liftIO $ getPOSIXTime
return $ MalNumber $ round (t * 1000)
time_ms :: Fn
time_ms [] = MalNumber . round . (* 1000) <$> liftIO getPOSIXTime
time_ms _ = throwStr "invalid time-ms"
-- List functions
list args = return $ MalList args Nil
list :: Fn
list = return . toList
-- Vector functions
vector args = return $ MalVector args Nil
vector :: Fn
vector = return . MalSeq (MetaData Nil) (Vect True)
-- Hash Map functions
_pairup [x] = throwStr "Odd number of elements to _pairup"
_pairup [] = return []
_pairup (MalString x:y:xs) = do
rest <- _pairup xs
return $ (x,y):rest
hash_map :: Fn
hash_map kvs =
case keyValuePairs kvs of
Just pairs -> return $ MalHashMap (MetaData Nil) $ Map.fromList pairs
Nothing -> throwStr "invalid call to hash-map"
hash_map args = do
pairs <- _pairup args
return $ MalHashMap (Map.fromList pairs) Nil
assoc (MalHashMap hm _:kvs) = do
pairs <- _pairup kvs
return $ MalHashMap (Map.union (Map.fromList pairs) hm) Nil
assoc :: Fn
assoc (MalHashMap _ hm : kvs) =
case keyValuePairs kvs of
Just pairs -> return $ MalHashMap (MetaData Nil) $ Map.union (Map.fromList pairs) hm
Nothing -> throwStr "invalid assoc"
assoc _ = throwStr "invalid call to assoc"
dissoc (MalHashMap hm _:ks) = do
let remover = (\hm (MalString k) -> Map.delete k hm) in
return $ MalHashMap (foldl remover hm ks) Nil
remover :: Map.Map String MalVal -> MalVal -> IOThrows (Map.Map String MalVal)
remover m (MalString k) = return $ Map.delete k m
remover _ _ = throwStr "invalid dissoc"
dissoc :: Fn
dissoc (MalHashMap _ hm : ks) = MalHashMap (MetaData Nil) <$> foldlM remover hm ks
dissoc _ = throwStr "invalid call to dissoc"
get (MalHashMap hm _:MalString k:[]) = do
get :: Fn
get [MalHashMap _ hm, MalString k] =
case Map.lookup k hm of
Just mv -> return mv
Nothing -> return Nil
get (Nil:MalString k:[]) = return Nil
get [Nil, MalString _] = return Nil
get _ = throwStr "invalid call to get"
contains_Q (MalHashMap hm _:MalString k:[]) = do
if Map.member k hm then return MalTrue
else return MalFalse
contains_Q (Nil:MalString k:[]) = return MalFalse
contains_Q :: Fn
contains_Q [MalHashMap _ hm, MalString k] = return $ MalBoolean $ Map.member k hm
contains_Q [Nil, MalString _] = return $ MalBoolean False
contains_Q _ = throwStr "invalid call to contains?"
keys (MalHashMap hm _:[]) = do
return $ MalList (map MalString (Map.keys hm)) Nil
keys :: Fn
keys [MalHashMap _ hm] = return $ toList $ MalString <$> Map.keys hm
keys _ = throwStr "invalid call to keys"
vals (MalHashMap hm _:[]) = do
return $ MalList (Map.elems hm) Nil
vals :: Fn
vals [MalHashMap _ hm] = return $ toList $ Map.elems hm
vals _ = throwStr "invalid call to vals"
-- Sequence functions
_sequential_Q (MalList _ _) = MalTrue
_sequential_Q (MalVector _ _) = MalTrue
_sequential_Q _ = MalFalse
sequential_Q :: MalVal -> Bool
sequential_Q (MalSeq _ _ _) = True
sequential_Q _ = False
cons x Nil = MalList [x] Nil
cons x (MalList lst _) = MalList (x:lst) Nil
cons x (MalVector lst _) = MalList (x:lst) Nil
cons :: Fn
cons [x, Nil ] = return $ toList [x]
cons [x, MalSeq _ _ lst] = return $ toList (x : lst)
cons _ = throwStr "illegal call to cons"
concat1 a (MalList lst _) = a ++ lst
concat1 a (MalVector lst _) = a ++ lst
do_concat args = return $ MalList (foldl concat1 [] args) Nil
unwrapSeq :: MalVal -> IOThrows [MalVal]
unwrapSeq (MalSeq _ _ xs) = return xs
unwrapSeq _ = throwStr "invalid concat"
nth ((MalList lst _):(MalNumber idx):[]) = do
if idx < length lst then return $ lst !! idx
else throwStr "nth: index out of range"
nth ((MalVector lst _):(MalNumber idx):[]) = do
if idx < length lst then return $ lst !! idx
else throwStr "nth: index out of range"
do_concat :: Fn
do_concat args = toList . concat <$> mapM unwrapSeq args
nth :: Fn
nth [MalSeq _ _ lst, MalNumber idx] =
case drop idx lst of
x : _ -> return x
[] -> throwStr "nth: index out of range"
-- See https://wiki.haskell.org/Avoiding_partial_functions
nth _ = throwStr "invalid call to nth"
first Nil = Nil
first (MalList lst _) = if length lst > 0 then lst !! 0 else Nil
first (MalVector lst _) = if length lst > 0 then lst !! 0 else Nil
first :: Fn
first [Nil ] = return Nil
first [MalSeq _ _ [] ] = return Nil
first [MalSeq _ _ (x : _)] = return x
first _ = throwStr "illegal call to first"
rest Nil = MalList [] Nil
rest (MalList lst _) = MalList (drop 1 lst) Nil
rest (MalVector lst _) = MalList (drop 1 lst) Nil
rest :: Fn
rest [Nil ] = return $ toList []
rest [MalSeq _ _ [] ] = return $ toList []
rest [MalSeq _ _ (_ : xs)] = return $ toList xs
rest _ = throwStr "illegal call to rest"
empty_Q Nil = MalTrue
empty_Q (MalList [] _) = MalTrue
empty_Q (MalVector [] _) = MalTrue
empty_Q _ = MalFalse
empty_Q :: MalVal -> Bool
empty_Q Nil = True
empty_Q (MalSeq _ _ []) = True
empty_Q _ = False
count (Nil:[]) = return $ MalNumber 0
count (MalList lst _:[]) = return $ MalNumber $ length lst
count (MalVector lst _:[]) = return $ MalNumber $ length lst
count _ = throwStr $ "non-sequence passed to count"
count :: Fn
count [Nil ] = return $ MalNumber 0
count [MalSeq _ _ lst] = return $ MalNumber $ length lst
count _ = throwStr "non-sequence passed to count"
apply args = do
f <- _get_call args
lst <- _to_list (last args)
f $ (init (drop 1 args)) ++ lst
concatLast :: [MalVal] -> IOThrows [MalVal]
concatLast [MalSeq _ _ lst] = return lst
concatLast (a : as) = (a :) <$> concatLast as
concatLast _ = throwStr "last argument of apply must be a sequence"
do_map args = do
f <- _get_call args
lst <- _to_list (args !! 1)
do new_lst <- mapM (\x -> f [x]) lst
return $ MalList new_lst Nil
apply :: Fn
apply (MalFunction {fn=f} : xs) = f =<< concatLast xs
apply _ = throwStr "Illegal call to apply"
conj ((MalList lst _):args) = return $ MalList ((reverse args) ++ lst) Nil
conj ((MalVector lst _):args) = return $ MalVector (lst ++ args) Nil
conj _ = throwStr $ "illegal arguments to conj"
do_map :: Fn
do_map [MalFunction {fn=f}, MalSeq _ _ args] = toList <$> mapM (\x -> f [x]) args
do_map _ = throwStr "Illegal call to map"
do_seq (l@(MalList [] _):[]) = return $ Nil
do_seq (l@(MalList lst m):[]) = return $ l
do_seq (MalVector [] _:[]) = return $ Nil
do_seq (MalVector lst _:[]) = return $ MalList lst Nil
do_seq (MalString []:[]) = return $ Nil
do_seq (MalString s:[]) = return $ MalList [MalString [c] | c <- s] Nil
do_seq (Nil:[]) = return $ Nil
do_seq _ = throwStr $ "seq: called on non-sequence"
conj :: Fn
conj (MalSeq _ (Vect False) lst : args) = return $ toList $ reverse args ++ lst
conj (MalSeq _ (Vect True) lst : args) = return $ MalSeq (MetaData Nil) (Vect True) $ lst ++ args
conj _ = throwStr "illegal arguments to conj"
do_seq :: Fn
do_seq [Nil ] = return Nil
do_seq [MalSeq _ _ [] ] = return Nil
do_seq [MalSeq _ _ lst ] = return $ toList lst
do_seq [MalString "" ] = return Nil
do_seq [MalString s ] = return $ toList $ MalString <$> pure <$> s
do_seq _ = throwStr "seq: called on non-sequence"
-- Metadata functions
with_meta ((MalList lst _):m:[]) = return $ MalList lst m
with_meta ((MalVector lst _):m:[]) = return $ MalVector lst m
with_meta ((MalHashMap hm _):m:[]) = return $ MalHashMap hm m
with_meta ((MalAtom atm _):m:[]) = return $ MalAtom atm m
with_meta ((Func f _):m:[]) = return $ Func f m
with_meta ((MalFunc {fn=f, ast=a, env=e, params=p, macro=mc}):m:[]) = do
return $ MalFunc {fn=f, ast=a, env=e, params=p, macro=mc, meta=m}
with_meta _ = throwStr $ "invalid with-meta call"
with_meta :: Fn
with_meta [MalSeq _ v x, m] = return $ MalSeq (MetaData m) v x
with_meta [MalHashMap _ x, m] = return $ MalHashMap (MetaData m) x
with_meta [MalAtom _ x, m] = return $ MalAtom (MetaData m) x
with_meta [f@(MalFunction {}), m] = return $ f {meta=m}
with_meta _ = throwStr "invalid with-meta call"
do_meta ((MalList _ m):[]) = return m
do_meta ((MalVector _ m):[]) = return m
do_meta ((MalHashMap _ m):[]) = return m
do_meta ((MalAtom _ m):[]) = return m
do_meta ((Func _ m):[]) = return m
do_meta ((MalFunc {meta=m}):[]) = return m
do_meta _ = throwStr $ "invalid meta call"
do_meta :: Fn
do_meta [MalSeq (MetaData m) _ _ ] = return m
do_meta [MalHashMap (MetaData m) _] = return m
do_meta [MalAtom (MetaData m) _ ] = return m
do_meta [MalFunction {meta=m} ] = return m
do_meta _ = throwStr "invalid meta call"
-- Atom functions
atom (val:[]) = do
ref <- liftIO $ newIORef val
return $ MalAtom ref Nil
atom :: Fn
atom [val] = MalAtom (MetaData Nil) <$> liftIO (newIORef val)
atom _ = throwStr "invalid atom call"
deref (MalAtom ref _:[]) = do
val <- liftIO $ readIORef ref
return val
deref :: Fn
deref [MalAtom _ ref] = liftIO $ readIORef ref
deref _ = throwStr "invalid deref call"
reset_BANG (MalAtom ref _:val:[]) = do
reset_BANG :: Fn
reset_BANG [MalAtom _ ref, val] = do
liftIO $ writeIORef ref $ val
return val
reset_BANG _ = throwStr "invalid deref call"
reset_BANG _ = throwStr "invalid reset!"
swap_BANG (MalAtom ref _:args) = do
swap_BANG :: Fn
swap_BANG (MalAtom _ ref : MalFunction {fn=f} : args) = do
val <- liftIO $ readIORef ref
f <- _get_call args
new_val <- f $ [val] ++ (tail args)
_ <- liftIO $ writeIORef ref $ new_val
new_val <- f (val : args)
liftIO $ writeIORef ref new_val
return new_val
swap_BANG _ = throwStr "Illegal swap!"
ns :: [(String, Fn)]
ns = [
("=", _func equal_Q),
("throw", _func throw),
("nil?", _func $ run_1 $ _nil_Q),
("true?", _func $ run_1 $ _true_Q),
("false?", _func $ run_1 $ _false_Q),
("string?", _func $ run_1 $ _string_Q),
("symbol", _func $ symbol),
("symbol?", _func $ run_1 $ _symbol_Q),
("keyword", _func $ keyword),
("keyword?", _func $ run_1 $ _keyword_Q),
("number?", _func $ run_1 $ _number_Q),
("fn?", _func $ run_1 $ _fn_Q),
("macro?", _func $ run_1 $ _macro_Q),
("=", equal_Q),
("throw", throw),
("nil?", pred1 nil_Q),
("true?", pred1 true_Q),
("false?", pred1 false_Q),
("string?", pred1 string_Q),
("symbol", symbol),
("symbol?", pred1 symbol_Q),
("keyword", keyword),
("keyword?", pred1 keyword_Q),
("number?", pred1 number_Q),
("fn?", pred1 fn_Q),
("macro?", pred1 macro_Q),
("pr-str", _func pr_str),
("str", _func str),
("prn", _func prn),
("println", _func println),
("readline", _func do_readline),
("read-string", _func (\[(MalString s)] -> read_str s)),
("slurp", _func slurp),
("pr-str", pr_str),
("str", str),
("prn", prn),
("println", println),
("readline", do_readline),
("read-string", read_string),
("slurp", slurp),
("<", _func $ cmp_op (<)),
("<=", _func $ cmp_op (<=)),
(">", _func $ cmp_op (>)),
(">=", _func $ cmp_op (>=)),
("+", _func $ num_op (+)),
("-", _func $ num_op (-)),
("*", _func $ num_op (*)),
("/", _func $ num_op (div)),
("time-ms", _func $ time_ms),
("<", cmp_op (<)),
("<=", cmp_op (<=)),
(">", cmp_op (>)),
(">=", cmp_op (>=)),
("+", num_op (+)),
("-", num_op (-)),
("*", num_op (*)),
("/", num_op (div)),
("time-ms", time_ms),
("list", _func $ list),
("list?", _func $ run_1 _list_Q),
("vector", _func $ vector),
("vector?", _func $ run_1 _vector_Q),
("hash-map", _func $ hash_map),
("map?", _func $ run_1 _hash_map_Q),
("assoc", _func $ assoc),
("dissoc", _func $ dissoc),
("get", _func $ get),
("contains?",_func $ contains_Q),
("keys", _func $ keys),
("vals", _func $ vals),
("list", list),
("list?", pred1 list_Q),
("vector", vector),
("vector?", pred1 vector_Q),
("hash-map", hash_map),
("map?", pred1 map_Q),
("assoc", assoc),
("dissoc", dissoc),
("get", get),
("contains?", contains_Q),
("keys", keys),
("vals", vals),
("sequential?", _func $ run_1 _sequential_Q),
("cons", _func $ run_2 $ cons),
("concat", _func $ do_concat),
("nth", _func nth),
("first", _func $ run_1 $ first),
("rest", _func $ run_1 $ rest),
("empty?", _func $ run_1 $ empty_Q),
("count", _func $ count),
("apply", _func $ apply),
("map", _func $ do_map),
("sequential?", pred1 sequential_Q),
("cons", cons),
("concat", do_concat),
("nth", nth),
("first", first),
("rest", rest),
("empty?", pred1 empty_Q),
("count", count),
("apply", apply),
("map", do_map),
("conj", _func $ conj),
("seq", _func $ do_seq),
("conj", conj),
("seq", do_seq),
("with-meta", _func $ with_meta),
("meta", _func $ do_meta),
("atom", _func $ atom),
("atom?", _func $ run_1 _atom_Q),
("deref", _func $ deref),
("reset!", _func $ reset_BANG),
("swap!", _func $ swap_BANG)]
("with-meta", with_meta),
("meta", do_meta),
("atom", atom),
("atom?", pred1 atom_Q),
("deref", deref),
("reset!", reset_BANG),
("swap!", swap_BANG)]

79
haskell/Env.hs
View File

@ -1,65 +1,36 @@
module Env
( Env, env_new, null_env, env_bind, env_find, env_get, env_set )
( Env, env_new, env_bind, env_get, env_set )
where
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Control.Monad.Trans (liftIO)
import Data.List (elemIndex)
import Data.IORef (modifyIORef, newIORef, readIORef)
import qualified Data.Map as Map
import Types
import Printer
-- These Env types are defined in Types module to avoid dep cycle
--data EnvData = EnvPair (Maybe Env, (Map.Map String MalVal))
--type Env = IORef EnvData
-- The Env type si defined in Types module to avoid dep cycle.
env_new :: Maybe Env -> IO Env
env_new outer = newIORef $ EnvPair (outer, (Map.fromList []))
env_new :: Env -> IO Env
env_new outer = (: outer) <$> newIORef (Map.fromList [])
null_env = env_new Nothing
-- True means that the actual arguments match the signature.
env_bind :: Env -> [String] -> [MalVal] -> IO Bool
env_bind env (k : ks) (v : vs) | k /= "&" = do
env_set env k v
env_bind env ks vs
env_bind env ["&", k] vs = do
env_set env k $ toList vs
return True
env_bind _ [] [] = return True
env_bind _ _ _ = return False
env_bind :: Env -> [MalVal] -> [MalVal] -> IO Env
env_bind envRef binds exprs = do
case (elemIndex (MalSymbol "&") binds) of
Nothing -> do
-- bind binds to exprs
_ <- mapM (\(b,e) -> env_set envRef b e) $ zip binds exprs
return envRef
Just idx -> do
-- Varargs binding
_ <- mapM (\(b,e) -> env_set envRef b e) $
zip (take idx binds) (take idx exprs)
_ <- env_set envRef (binds !! (idx + 1))
(MalList (drop idx exprs) Nil)
return envRef
env_get :: Env -> String -> IO (Maybe MalVal)
env_get [] _ = return Nothing
env_get (ref : outer) key = do
hm <- readIORef ref
case Map.lookup key hm of
Nothing -> env_get outer key
justVal -> return justVal
env_find :: Env -> MalVal -> IO (Maybe Env)
env_find envRef sym@(MalSymbol key) = do
e <- readIORef envRef
case e of
EnvPair (o, m) -> case Map.lookup key m of
Nothing -> case o of
Nothing -> return Nothing
Just o -> env_find o sym
Just val -> return $ Just envRef
env_get :: Env -> MalVal -> IOThrows MalVal
env_get envRef sym@(MalSymbol key) = do
e1 <- liftIO $ env_find envRef sym
case e1 of
Nothing -> throwStr $ "'" ++ key ++ "' not found"
Just eRef -> do
e2 <- liftIO $ readIORef eRef
case e2 of
EnvPair (o,m) -> case Map.lookup key m of
Nothing -> throwStr $ "env_get error"
Just val -> return val
env_set :: Env -> MalVal -> MalVal -> IO MalVal
env_set envRef (MalSymbol key) val = do
e <- readIORef envRef
case e of
EnvPair (o,m) -> writeIORef envRef $ EnvPair (o, (Map.insert key val m))
return val
env_set :: Env -> String -> MalVal -> IO ()
env_set (ref : _) key val = modifyIORef ref $ Map.insert key val
env_set [] _ _ = error "assertion failed in env_set"

Some files were not shown because too many files have changed in this diff Show More