mirror of
https://github.com/kanaka/mal.git
synced 2024-10-26 14:22:25 +03:00
Merge branch 'master' into bjh21-unterminated-strings
This should fix ocaml.
This commit is contained in:
commit
a94c795da6
@ -109,4 +109,5 @@ script:
|
|||||||
# Build, test, perf
|
# Build, test, perf
|
||||||
- ./.travis_test.sh build ${IMPL}
|
- ./.travis_test.sh build ${IMPL}
|
||||||
- ./.travis_test.sh test ${IMPL}
|
- ./.travis_test.sh test ${IMPL}
|
||||||
|
- STEP=stepA REGRESS=1 HARD=1 OPTIONAL=0 ./.travis_test.sh test ${IMPL}
|
||||||
- ./.travis_test.sh perf ${IMPL}
|
- ./.travis_test.sh perf ${IMPL}
|
||||||
|
@ -61,6 +61,9 @@ test|perf)
|
|||||||
if ! ${MAKE} TEST_OPTS="${TEST_OPTS}" \
|
if ! ${MAKE} TEST_OPTS="${TEST_OPTS}" \
|
||||||
${MAL_IMPL:+MAL_IMPL=${MAL_IMPL}} \
|
${MAL_IMPL:+MAL_IMPL=${MAL_IMPL}} \
|
||||||
${REGRESS:+REGRESS=${REGRESS}} \
|
${REGRESS:+REGRESS=${REGRESS}} \
|
||||||
|
${HARD:+HARD=${HARD}} \
|
||||||
|
${DEFERRABLE:+DEFERRABLE=${DEFERRABLE}} \
|
||||||
|
${OPTIONAL:+OPTIONAL=${OPTIONAL}} \
|
||||||
${ACTION}^${IMPL}${STEP:+^${STEP}}; then
|
${ACTION}^${IMPL}${STEP:+^${STEP}}; then
|
||||||
# print debug-file on error
|
# print debug-file on error
|
||||||
cat ${ACTION}.err
|
cat ${ACTION}.err
|
||||||
|
6
Makefile
6
Makefile
@ -77,6 +77,7 @@ TEST_OPTS =
|
|||||||
# later steps.
|
# later steps.
|
||||||
REGRESS =
|
REGRESS =
|
||||||
|
|
||||||
|
HARD=
|
||||||
DEFERRABLE=1
|
DEFERRABLE=1
|
||||||
OPTIONAL=1
|
OPTIONAL=1
|
||||||
|
|
||||||
@ -142,6 +143,8 @@ dist_EXCLUDES += guile io julia matlab swift
|
|||||||
|
|
||||||
# Extra options to pass to runtest.py
|
# Extra options to pass to runtest.py
|
||||||
bbc-basic_TEST_OPTS = --test-timeout 60
|
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
|
logo_TEST_OPTS = --start-timeout 60 --test-timeout 120
|
||||||
mal_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
|
miniMAL_TEST_OPTS = --start-timeout 60 --test-timeout 120
|
||||||
@ -270,6 +273,7 @@ noop =
|
|||||||
SPACE = $(noop) $(noop)
|
SPACE = $(noop) $(noop)
|
||||||
export FACTOR_ROOTS := .
|
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_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)
|
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
|
# Takes impl and step
|
||||||
# Returns the runtest command prefix (with runtest options) for testing the given 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,)) \
|
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
|
# Takes impl and step
|
||||||
# Returns the runtest command prefix (with runtest options) for testing the given step
|
# Returns the runtest command prefix (with runtest options) for testing the given step
|
||||||
|
@ -156,8 +156,9 @@ package body Core is
|
|||||||
|
|
||||||
function Keyword (Args : in Types.T_Array) return Types.T is
|
function Keyword (Args : in Types.T_Array) return Types.T is
|
||||||
begin
|
begin
|
||||||
Err.Check (Args'Length = 1 and then Args (Args'First).Kind = Kind_String,
|
Err.Check (Args'Length = 1
|
||||||
"expected a string");
|
and then Args (Args'First).Kind in Types.Kind_Key,
|
||||||
|
"expected a keyword or a string");
|
||||||
return (Kind_Keyword, Args (Args'First).Str);
|
return (Kind_Keyword, Args (Args'First).Str);
|
||||||
end Keyword;
|
end Keyword;
|
||||||
|
|
||||||
|
@ -401,12 +401,7 @@ procedure Step8_Macros is
|
|||||||
& " (list 'if (first xs)"
|
& " (list 'if (first xs)"
|
||||||
& " (if (> (count xs) 1) (nth xs 1)"
|
& " (if (> (count xs) 1) (nth xs 1)"
|
||||||
& " (throw ""odd number of forms to cond""))"
|
& " (throw ""odd number of forms to cond""))"
|
||||||
& " (cons 'cond (rest (rest xs)))))))"
|
& " (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))))))))";
|
|
||||||
Repl : constant Envs.Ptr := Envs.New_Env;
|
Repl : constant Envs.Ptr := Envs.New_Env;
|
||||||
function Eval_Builtin (Args : in Types.T_Array) return Types.T is
|
function Eval_Builtin (Args : in Types.T_Array) return Types.T is
|
||||||
begin
|
begin
|
||||||
|
@ -431,12 +431,7 @@ procedure Step9_Try is
|
|||||||
& " (list 'if (first xs)"
|
& " (list 'if (first xs)"
|
||||||
& " (if (> (count xs) 1) (nth xs 1)"
|
& " (if (> (count xs) 1) (nth xs 1)"
|
||||||
& " (throw ""odd number of forms to cond""))"
|
& " (throw ""odd number of forms to cond""))"
|
||||||
& " (cons 'cond (rest (rest xs)))))))"
|
& " (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))))))))";
|
|
||||||
Repl : constant Envs.Ptr := Envs.New_Env;
|
Repl : constant Envs.Ptr := Envs.New_Env;
|
||||||
function Eval_Builtin (Args : in Types.T_Array) return Types.T is
|
function Eval_Builtin (Args : in Types.T_Array) return Types.T is
|
||||||
begin
|
begin
|
||||||
|
@ -438,15 +438,6 @@ procedure StepA_Mal is
|
|||||||
& " (if (> (count xs) 1) (nth xs 1)"
|
& " (if (> (count xs) 1) (nth xs 1)"
|
||||||
& " (throw ""odd number of forms to cond""))"
|
& " (throw ""odd number of forms to cond""))"
|
||||||
& " (cons 'cond (rest (rest xs)))))))"
|
& " (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"")";
|
& "(def! *host-language* ""ada.2"")";
|
||||||
Repl : constant Envs.Ptr := Envs.New_Env;
|
Repl : constant Envs.Ptr := Envs.New_Env;
|
||||||
function Eval_Builtin (Args : in Types.T_Array) return Types.T is
|
function Eval_Builtin (Args : in Types.T_Array) return Types.T is
|
||||||
|
@ -527,7 +527,6 @@ begin
|
|||||||
RE ("(def! not (fn* (a) (if a false true)))");
|
RE ("(def! not (fn* (a) (if a false true)))");
|
||||||
RE ("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) "")"")))))");
|
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! 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.
|
-- Command line processing.
|
||||||
|
|
||||||
|
@ -580,7 +580,6 @@ begin
|
|||||||
RE ("(def! not (fn* (a) (if a false true)))");
|
RE ("(def! not (fn* (a) (if a false true)))");
|
||||||
RE ("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) "")"")))))");
|
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! 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.
|
-- Command line processing.
|
||||||
|
|
||||||
|
@ -580,9 +580,6 @@ begin
|
|||||||
RE ("(def! not (fn* (a) (if a false true)))");
|
RE ("(def! not (fn* (a) (if a false true)))");
|
||||||
RE ("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) "")"")))))");
|
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! 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.
|
-- Command line processing.
|
||||||
|
|
||||||
|
@ -507,7 +507,6 @@ function main(str, ret, i, idx)
|
|||||||
rep("(def! not (fn* (a) (if a false true)))")
|
rep("(def! not (fn* (a) (if a false true)))")
|
||||||
rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
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! 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()
|
idx = types_allocate()
|
||||||
env_set(repl_env, "'*ARGV*", "(" idx)
|
env_set(repl_env, "'*ARGV*", "(" idx)
|
||||||
|
@ -569,7 +569,6 @@ function main(str, ret, i, idx)
|
|||||||
rep("(def! not (fn* (a) (if a false true)))")
|
rep("(def! not (fn* (a) (if a false true)))")
|
||||||
rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
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! 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()
|
idx = types_allocate()
|
||||||
env_set(repl_env, "'*ARGV*", "(" idx)
|
env_set(repl_env, "'*ARGV*", "(" idx)
|
||||||
|
@ -572,9 +572,6 @@ function main(str, ret, i, idx)
|
|||||||
rep("(def! not (fn* (a) (if a false true)))")
|
rep("(def! not (fn* (a) (if a false true)))")
|
||||||
rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
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! 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()
|
idx = types_allocate()
|
||||||
env_set(repl_env, "'*ARGV*", "(" idx)
|
env_set(repl_env, "'*ARGV*", "(" idx)
|
||||||
|
@ -250,7 +250,6 @@ ENV_SET "${REPL_ENV}" "${r}" "${argv}";
|
|||||||
REP "(def! not (fn* (a) (if a false true)))"
|
REP "(def! not (fn* (a) (if a false true)))"
|
||||||
REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"
|
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! 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)
|
# load/run file from command line (then exit)
|
||||||
if [[ "${1}" ]]; then
|
if [[ "${1}" ]]; then
|
||||||
|
@ -263,7 +263,6 @@ ENV_SET "${REPL_ENV}" "${r}" "${argv}";
|
|||||||
REP "(def! not (fn* (a) (if a false true)))"
|
REP "(def! not (fn* (a) (if a false true)))"
|
||||||
REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"
|
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! 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)
|
# load/run file from command line (then exit)
|
||||||
if [[ "${1}" ]]; then
|
if [[ "${1}" ]]; then
|
||||||
|
@ -272,9 +272,6 @@ REP "(def! *host-language* \"bash\")"
|
|||||||
REP "(def! not (fn* (a) (if a false true)))"
|
REP "(def! not (fn* (a) (if a false true)))"
|
||||||
REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"
|
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! 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)
|
# load/run file from command line (then exit)
|
||||||
if [[ "${1}" ]]; then
|
if [[ "${1}" ]]; then
|
||||||
|
@ -537,10 +537,6 @@ MAIN:
|
|||||||
A$=A$+" forms to cond"+CHR$(34)+")) (cons 'cond (rest (rest xs)))))))"
|
A$=A$+" forms to cond"+CHR$(34)+")) (cons 'cond (rest (rest xs)))))))"
|
||||||
GOSUB RE:AY=R:GOSUB RELEASE
|
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
|
REM load the args file
|
||||||
A$="(def! -*ARGS*- (load-file "+CHR$(34)+".args.mal"+CHR$(34)+"))"
|
A$="(def! -*ARGS*- (load-file "+CHR$(34)+".args.mal"+CHR$(34)+"))"
|
||||||
GOSUB RE:AY=R:GOSUB RELEASE
|
GOSUB RE:AY=R:GOSUB RELEASE
|
||||||
|
@ -570,10 +570,6 @@ MAIN:
|
|||||||
A$=A$+" forms to cond"+CHR$(34)+")) (cons 'cond (rest (rest xs)))))))"
|
A$=A$+" forms to cond"+CHR$(34)+")) (cons 'cond (rest (rest xs)))))))"
|
||||||
GOSUB RE:AY=R:GOSUB RELEASE
|
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
|
REM load the args file
|
||||||
A$="(def! -*ARGS*- (load-file "+CHR$(34)+".args.mal"+CHR$(34)+"))"
|
A$="(def! -*ARGS*- (load-file "+CHR$(34)+".args.mal"+CHR$(34)+"))"
|
||||||
GOSUB RE:AY=R:GOSUB RELEASE
|
GOSUB RE:AY=R:GOSUB RELEASE
|
||||||
|
@ -569,18 +569,6 @@ MAIN:
|
|||||||
A$=A$+" forms to cond"+CHR$(34)+")) (cons 'cond (rest (rest xs)))))))"
|
A$=A$+" forms to cond"+CHR$(34)+")) (cons 'cond (rest (rest xs)))))))"
|
||||||
GOSUB RE:AY=R:GOSUB RELEASE
|
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
|
REM load the args file
|
||||||
A$="(def! -*ARGS*- (load-file "+CHR$(34)+".args.mal"+CHR$(34)+"))"
|
A$="(def! -*ARGS*- (load-file "+CHR$(34)+".args.mal"+CHR$(34)+"))"
|
||||||
GOSUB RE:AY=R:GOSUB RELEASE
|
GOSUB RE:AY=R:GOSUB RELEASE
|
||||||
|
@ -22,7 +22,6 @@ RESTORE +0
|
|||||||
DATA (def! not (fn* (a) (if a false true)))
|
DATA (def! not (fn* (a) (if a false true)))
|
||||||
DATA (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))
|
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! 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 ""
|
DATA ""
|
||||||
REPEAT
|
REPEAT
|
||||||
READ form$
|
READ form$
|
||||||
|
@ -22,7 +22,6 @@ RESTORE +0
|
|||||||
DATA (def! not (fn* (a) (if a false true)))
|
DATA (def! not (fn* (a) (if a false true)))
|
||||||
DATA (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))
|
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! 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 ""
|
DATA ""
|
||||||
REPEAT
|
REPEAT
|
||||||
READ form$
|
READ form$
|
||||||
|
@ -22,9 +22,6 @@ RESTORE +0
|
|||||||
DATA (def! not (fn* (a) (if a false true)))
|
DATA (def! not (fn* (a) (if a false true)))
|
||||||
DATA (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))
|
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! 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 (def! *host-language* "BBC BASIC V")
|
||||||
DATA ""
|
DATA ""
|
||||||
REPEAT
|
REPEAT
|
||||||
|
@ -291,7 +291,6 @@ void init_repl_env(int argc, char *argv[]) {
|
|||||||
RE(repl_env, "",
|
RE(repl_env, "",
|
||||||
"(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
|
"(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! 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[])
|
int main(int argc, char *argv[])
|
||||||
|
@ -316,7 +316,6 @@ void init_repl_env(int argc, char *argv[]) {
|
|||||||
RE(repl_env, "",
|
RE(repl_env, "",
|
||||||
"(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
|
"(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! 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[])
|
int main(int argc, char *argv[])
|
||||||
|
@ -322,9 +322,6 @@ void init_repl_env(int argc, char *argv[]) {
|
|||||||
RE(repl_env, "",
|
RE(repl_env, "",
|
||||||
"(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
|
"(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! 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[])
|
int main(int argc, char *argv[])
|
||||||
|
@ -435,9 +435,7 @@ fun string rep(string input)
|
|||||||
|
|
||||||
rep("(def! not (fn* (a) (if a false true)))");
|
rep("(def! not (fn* (a) (if a false true)))");
|
||||||
rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
|
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! 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()
|
fun void main()
|
||||||
{
|
{
|
||||||
|
@ -452,9 +452,7 @@ fun string rep(string input)
|
|||||||
|
|
||||||
rep("(def! not (fn* (a) (if a false true)))");
|
rep("(def! not (fn* (a) (if a false true)))");
|
||||||
rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
|
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! 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()
|
fun void main()
|
||||||
{
|
{
|
||||||
|
@ -454,13 +454,8 @@ fun string rep(string input)
|
|||||||
|
|
||||||
rep("(def! not (fn* (a) (if a false true)))");
|
rep("(def! not (fn* (a) (if a false true)))");
|
||||||
rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
|
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! 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()
|
fun void main()
|
||||||
{
|
{
|
||||||
int done;
|
int done;
|
||||||
|
@ -153,7 +153,6 @@
|
|||||||
(rep "(def! not (fn* [a] (if a false true)))")
|
(rep "(def! not (fn* [a] (if a false true)))")
|
||||||
(rep "(def! load-file (fn* [f] (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
(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! 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
|
;; repl loop
|
||||||
(defn repl-loop []
|
(defn repl-loop []
|
||||||
|
@ -170,7 +170,6 @@
|
|||||||
(rep "(def! not (fn* [a] (if a false true)))")
|
(rep "(def! not (fn* [a] (if a false true)))")
|
||||||
(rep "(def! load-file (fn* [f] (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
(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! 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
|
;; repl loop
|
||||||
(defn repl-loop []
|
(defn repl-loop []
|
||||||
|
@ -180,9 +180,6 @@
|
|||||||
(rep "(def! not (fn* [a] (if a false true)))")
|
(rep "(def! not (fn* [a] (if a false true)))")
|
||||||
(rep "(def! load-file (fn* [f] (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
(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! 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
|
;; repl loop
|
||||||
(defn repl-loop []
|
(defn repl-loop []
|
||||||
|
@ -107,7 +107,6 @@ repl_env.set types._symbol('*ARGV*'), []
|
|||||||
rep("(def! not (fn* (a) (if a false true)))");
|
rep("(def! not (fn* (a) (if a false true)))");
|
||||||
rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
|
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! 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
|
if process? && process.argv.length > 2
|
||||||
repl_env.set types._symbol('*ARGV*'), process.argv[3..]
|
repl_env.set types._symbol('*ARGV*'), process.argv[3..]
|
||||||
|
@ -116,7 +116,6 @@ repl_env.set types._symbol('*ARGV*'), []
|
|||||||
rep("(def! not (fn* (a) (if a false true)))");
|
rep("(def! not (fn* (a) (if a false true)))");
|
||||||
rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
|
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! 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
|
if process? && process.argv.length > 2
|
||||||
repl_env.set types._symbol('*ARGV*'), process.argv[3..]
|
repl_env.set types._symbol('*ARGV*'), process.argv[3..]
|
||||||
|
@ -123,9 +123,6 @@ rep("(def! *host-language* \"CoffeeScript\")")
|
|||||||
rep("(def! not (fn* (a) (if a false true)))");
|
rep("(def! not (fn* (a) (if a false true)))");
|
||||||
rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
|
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! 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
|
if process? && process.argv.length > 2
|
||||||
repl_env.set types._symbol('*ARGV*'), process.argv[3..]
|
repl_env.set types._symbol('*ARGV*'), process.argv[3..]
|
||||||
|
@ -228,7 +228,6 @@
|
|||||||
(rep "(def! not (fn* (a) (if a false true)))")
|
(rep "(def! not (fn* (a) (if a false true)))")
|
||||||
(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
(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! 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)
|
(defvar *use-readline-p* nil)
|
||||||
|
|
||||||
|
@ -251,7 +251,6 @@
|
|||||||
(rep "(def! not (fn* (a) (if a false true)))")
|
(rep "(def! not (fn* (a) (if a false true)))")
|
||||||
(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
(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! 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)
|
(defvar *use-readline-p* nil)
|
||||||
|
|
||||||
|
@ -259,9 +259,6 @@
|
|||||||
(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
(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! 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! *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)
|
(defvar *use-readline-p* nil)
|
||||||
|
|
||||||
|
@ -280,7 +280,6 @@ static malValuePtr macroExpand(malValuePtr obj, malEnvPtr env)
|
|||||||
|
|
||||||
static const char* malFunctionTable[] = {
|
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! 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! not (fn* (cond) (if cond false true)))",
|
||||||
"(def! load-file (fn* (filename) \
|
"(def! load-file (fn* (filename) \
|
||||||
(eval (read-string (str \"(do \" (slurp filename) \")\")))))",
|
(eval (read-string (str \"(do \" (slurp filename) \")\")))))",
|
||||||
|
@ -329,7 +329,6 @@ static malValuePtr macroExpand(malValuePtr obj, malEnvPtr env)
|
|||||||
|
|
||||||
static const char* malFunctionTable[] = {
|
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! 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! not (fn* (cond) (if cond false true)))",
|
||||||
"(def! load-file (fn* (filename) \
|
"(def! load-file (fn* (filename) \
|
||||||
(eval (read-string (str \"(do \" (slurp filename) \")\")))))",
|
(eval (read-string (str \"(do \" (slurp filename) \")\")))))",
|
||||||
|
@ -330,12 +330,9 @@ static malValuePtr macroExpand(malValuePtr obj, malEnvPtr env)
|
|||||||
|
|
||||||
static const char* malFunctionTable[] = {
|
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! 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! not (fn* (cond) (if cond false true)))",
|
||||||
"(def! load-file (fn* (filename) \
|
"(def! load-file (fn* (filename) \
|
||||||
(eval (read-string (str \"(do \" (slurp 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++\")",
|
"(def! *host-language* \"C++\")",
|
||||||
};
|
};
|
||||||
|
|
||||||
|
@ -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! not (fn* (a) (if a false true)))"
|
||||||
Mal.rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"
|
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! 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
|
argv = Mal::List.new
|
||||||
REPL_ENV.set("*ARGV*", Mal::Type.new argv)
|
REPL_ENV.set("*ARGV*", Mal::Type.new argv)
|
||||||
|
@ -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! not (fn* (a) (if a false true)))"
|
||||||
Mal.rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"
|
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! 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
|
argv = Mal::List.new
|
||||||
REPL_ENV.set("*ARGV*", Mal::Type.new argv)
|
REPL_ENV.set("*ARGV*", Mal::Type.new argv)
|
||||||
|
@ -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! not (fn* (a) (if a false true)))"
|
||||||
Mal.rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"
|
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! 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\")")
|
Mal.rep("(def! *host-language* \"crystal\")")
|
||||||
|
|
||||||
argv = Mal::List.new
|
argv = Mal::List.new
|
||||||
|
@ -227,7 +227,6 @@ namespace Mal {
|
|||||||
RE("(def! not (fn* (a) (if a false true)))");
|
RE("(def! not (fn* (a) (if a false true)))");
|
||||||
RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
|
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! 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) {
|
if (args.Length > fileIdx) {
|
||||||
RE("(load-file \"" + args[fileIdx] + "\")");
|
RE("(load-file \"" + args[fileIdx] + "\")");
|
||||||
|
@ -248,7 +248,6 @@ namespace Mal {
|
|||||||
RE("(def! not (fn* (a) (if a false true)))");
|
RE("(def! not (fn* (a) (if a false true)))");
|
||||||
RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
|
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! 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) {
|
if (args.Length > fileIdx) {
|
||||||
RE("(load-file \"" + args[fileIdx] + "\")");
|
RE("(load-file \"" + args[fileIdx] + "\")");
|
||||||
|
@ -249,9 +249,6 @@ namespace Mal {
|
|||||||
RE("(def! not (fn* (a) (if a false true)))");
|
RE("(def! not (fn* (a) (if a false true)))");
|
||||||
RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
|
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! 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) {
|
if (args.Length > fileIdx) {
|
||||||
RE("(load-file \"" + args[fileIdx] + "\")");
|
RE("(load-file \"" + args[fileIdx] + "\")");
|
||||||
|
@ -263,7 +263,6 @@ void main(string[] args)
|
|||||||
re("(def! not (fn* (a) (if a false true)))", repl_env);
|
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("(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! 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)
|
if (args.length > 1)
|
||||||
{
|
{
|
||||||
|
@ -292,7 +292,6 @@ void main(string[] args)
|
|||||||
re("(def! not (fn* (a) (if a false true)))", repl_env);
|
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("(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! 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)
|
if (args.length > 1)
|
||||||
{
|
{
|
||||||
|
@ -294,9 +294,6 @@ void main(string[] args)
|
|||||||
re("(def! not (fn* (a) (if a false true)))", repl_env);
|
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("(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! 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)
|
if (args.length > 1)
|
||||||
{
|
{
|
||||||
|
@ -27,12 +27,6 @@ void setupEnv(List<String> argv) {
|
|||||||
" (nth xs 1) "
|
" (nth xs 1) "
|
||||||
" (throw \"odd number of forms to cond\")) "
|
" (throw \"odd number of forms to cond\")) "
|
||||||
" (cons 'cond (rest (rest xs)))))))");
|
" (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.
|
/// Returns `true` if [ast] is a macro call.
|
||||||
|
@ -27,12 +27,6 @@ void setupEnv(List<String> argv) {
|
|||||||
" (nth xs 1) "
|
" (nth xs 1) "
|
||||||
" (throw \"odd number of forms to cond\")) "
|
" (throw \"odd number of forms to cond\")) "
|
||||||
" (cons 'cond (rest (rest xs)))))))");
|
" (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.
|
/// Returns `true` if [ast] is a macro call.
|
||||||
@ -194,8 +188,7 @@ MalType EVAL(MalType ast, Env env) {
|
|||||||
ast = quasiquote(args.first);
|
ast = quasiquote(args.first);
|
||||||
continue;
|
continue;
|
||||||
} else if (symbol.value == 'macroexpand') {
|
} else if (symbol.value == 'macroexpand') {
|
||||||
ast = macroexpand(args.first, env);
|
return macroexpand(args.first, env);
|
||||||
continue;
|
|
||||||
} else if (symbol.value == 'try*') {
|
} else if (symbol.value == 'try*') {
|
||||||
var body = args.first;
|
var body = args.first;
|
||||||
if (args.length < 2) {
|
if (args.length < 2) {
|
||||||
|
@ -29,20 +29,6 @@ void setupEnv(List<String> argv) {
|
|||||||
" (nth xs 1) "
|
" (nth xs 1) "
|
||||||
" (throw \"odd number of forms to cond\")) "
|
" (throw \"odd number of forms to cond\")) "
|
||||||
" (cons 'cond (rest (rest xs)))))))");
|
" (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.
|
/// Returns `true` if [ast] is a macro call.
|
||||||
@ -204,8 +190,7 @@ MalType EVAL(MalType ast, Env env) {
|
|||||||
ast = quasiquote(args.first);
|
ast = quasiquote(args.first);
|
||||||
continue;
|
continue;
|
||||||
} else if (symbol.value == 'macroexpand') {
|
} else if (symbol.value == 'macroexpand') {
|
||||||
ast = macroexpand(args.first, env);
|
return macroexpand(args.first, env);
|
||||||
continue;
|
|
||||||
} else if (symbol.value == 'try*') {
|
} else if (symbol.value == 'try*') {
|
||||||
var body = args.first;
|
var body = args.first;
|
||||||
if (args.length < 2) {
|
if (args.length < 2) {
|
||||||
|
@ -247,9 +247,6 @@
|
|||||||
<span class=file>step9_try.EXT</span>:
|
<span class=file>step9_try.EXT</span>:
|
||||||
<span class=function>EVAL</span>(<span class=var>ast</span>, <span class=var>env</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
|
- 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>)
|
<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>
|
</code></pre>
|
||||||
</td>
|
</td>
|
||||||
|
129
docs/exercises.md
Normal file
129
docs/exercises.md
Normal 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))`?
|
@ -181,9 +181,7 @@
|
|||||||
|
|
||||||
(rep "(def! not (fn* (a) (if a false true)))")
|
(rep "(def! not (fn* (a) (if a false true)))")
|
||||||
(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
(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! 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)
|
(defun readln (prompt)
|
||||||
;; C-d throws an error
|
;; C-d throws an error
|
||||||
|
@ -197,9 +197,7 @@
|
|||||||
|
|
||||||
(rep "(def! not (fn* (a) (if a false true)))")
|
(rep "(def! not (fn* (a) (if a false true)))")
|
||||||
(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
(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! 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)
|
(defun readln (prompt)
|
||||||
;; C-d throws an error
|
;; C-d throws an error
|
||||||
|
@ -198,12 +198,7 @@
|
|||||||
|
|
||||||
(rep "(def! not (fn* (a) (if a false true)))")
|
(rep "(def! not (fn* (a) (if a false true)))")
|
||||||
(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
(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! 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)
|
(defun readln (prompt)
|
||||||
;; C-d throws an error
|
;; C-d throws an error
|
||||||
|
@ -203,6 +203,7 @@ defmodule Mal.Core do
|
|||||||
|
|
||||||
defp with_meta([{type, ast, _old_meta}, meta]), do: {type, ast, meta}
|
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([%Function{} = func, meta]), do: %{func | meta: meta}
|
||||||
|
defp with_meta(_), do: nil
|
||||||
|
|
||||||
defp deref(args) do
|
defp deref(args) do
|
||||||
apply(&Mal.Atom.deref/1, args)
|
apply(&Mal.Atom.deref/1, args)
|
||||||
|
@ -42,17 +42,6 @@ defmodule Mix.Tasks.Step8Macros do
|
|||||||
(cons 'cond (rest (rest xs)))))))"
|
(cons 'cond (rest (rest xs)))))))"
|
||||||
""", env)
|
""", 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] ->
|
Mal.Env.set(env, "eval", %Function{value: fn [ast] ->
|
||||||
eval(ast, env)
|
eval(ast, env)
|
||||||
end})
|
end})
|
||||||
|
@ -42,17 +42,6 @@ defmodule Mix.Tasks.Step9Try do
|
|||||||
(cons 'cond (rest (rest xs)))))))"
|
(cons 'cond (rest (rest xs)))))))"
|
||||||
""", env)
|
""", 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] ->
|
Mal.Env.set(env, "eval", %Function{value: fn [ast] ->
|
||||||
eval(ast, env)
|
eval(ast, env)
|
||||||
end})
|
end})
|
||||||
|
@ -50,28 +50,6 @@ defmodule Mix.Tasks.StepAMal do
|
|||||||
(cons 'cond (rest (rest xs)))))))"
|
(cons 'cond (rest (rest xs)))))))"
|
||||||
""", env)
|
""", 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] ->
|
Mal.Env.set(env, "eval", %Function{value: fn [ast] ->
|
||||||
eval(ast, env)
|
eval(ast, env)
|
||||||
end})
|
end})
|
||||||
|
@ -80,14 +80,6 @@ malInit =
|
|||||||
(nth xs 1)
|
(nth xs 1)
|
||||||
(throw "odd number of forms to cond"))
|
(throw "odd number of forms to cond"))
|
||||||
(cons 'cond (rest (rest xs)))))))"""
|
(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))))))))"""
|
|
||||||
]
|
]
|
||||||
|
|
||||||
|
|
||||||
|
@ -80,14 +80,6 @@ malInit =
|
|||||||
(nth xs 1)
|
(nth xs 1)
|
||||||
(throw "odd number of forms to cond"))
|
(throw "odd number of forms to cond"))
|
||||||
(cons 'cond (rest (rest xs)))))))"""
|
(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))))))))"""
|
|
||||||
]
|
]
|
||||||
|
|
||||||
|
|
||||||
|
@ -81,22 +81,6 @@ malInit =
|
|||||||
(nth xs 1)
|
(nth xs 1)
|
||||||
(throw "odd number of forms to cond"))
|
(throw "odd number of forms to cond"))
|
||||||
(cons 'cond (rest (rest xs)))))))"""
|
(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)))))))))"""
|
|
||||||
]
|
]
|
||||||
|
|
||||||
|
|
||||||
|
@ -20,7 +20,6 @@ init() ->
|
|||||||
eval(read("(def! not (fn* (a) (if a false true)))"), Env),
|
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("(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! 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.
|
Env.
|
||||||
|
|
||||||
loop(Env) ->
|
loop(Env) ->
|
||||||
|
@ -20,7 +20,6 @@ init() ->
|
|||||||
eval(read("(def! not (fn* (a) (if a false true)))"), Env),
|
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("(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! 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.
|
Env.
|
||||||
|
|
||||||
loop(Env) ->
|
loop(Env) ->
|
||||||
|
@ -22,9 +22,6 @@ init() ->
|
|||||||
eval(read("(def! not (fn* (a) (if a false true)))"), Env),
|
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("(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! 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.
|
Env.
|
||||||
|
|
||||||
loop(Env) ->
|
loop(Env) ->
|
||||||
|
@ -128,7 +128,6 @@ env_set(repl_env, Symbol.for('*ARGV*'), [])
|
|||||||
REP('(def! not (fn* (a) (if a false true)))')
|
REP('(def! not (fn* (a) (if a false true)))')
|
||||||
REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))')
|
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! 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) {
|
if (process.argv.length > 2) {
|
||||||
env_set(repl_env, Symbol.for('*ARGV*'), process.argv.slice(3))
|
env_set(repl_env, Symbol.for('*ARGV*'), process.argv.slice(3))
|
||||||
|
@ -139,7 +139,6 @@ env_set(repl_env, Symbol.for('*ARGV*'), [])
|
|||||||
REP('(def! not (fn* (a) (if a false true)))')
|
REP('(def! not (fn* (a) (if a false true)))')
|
||||||
REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))')
|
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! 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) {
|
if (process.argv.length > 2) {
|
||||||
env_set(repl_env, Symbol.for('*ARGV*'), process.argv.slice(3))
|
env_set(repl_env, Symbol.for('*ARGV*'), process.argv.slice(3))
|
||||||
|
@ -140,9 +140,6 @@ REP('(def! *host-language* "ecmascript6")')
|
|||||||
REP('(def! not (fn* (a) (if a false true)))')
|
REP('(def! not (fn* (a) (if a false true)))')
|
||||||
REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))')
|
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! 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) {
|
if (process.argv.length > 2) {
|
||||||
env_set(repl_env, Symbol.for('*ARGV*'), process.argv.slice(3))
|
env_set(repl_env, Symbol.for('*ARGV*'), process.argv.slice(3))
|
||||||
|
170
examples/exercises.mal
Normal file
170
examples/exercises.mal
Normal 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
|
@ -141,7 +141,6 @@ command-line get dup empty? [ rest ] unless "*ARGV*" pick set-at
|
|||||||
(def! not (fn* (a) (if a false true)))
|
(def! not (fn* (a) (if a false true)))
|
||||||
(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))
|
(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! 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
|
" string-lines harvest [ REP drop ] each
|
||||||
|
|
||||||
MAIN: main
|
MAIN: main
|
||||||
|
@ -153,7 +153,6 @@ command-line get dup empty? [ rest ] unless "*ARGV*" pick set-at
|
|||||||
(def! not (fn* (a) (if a false true)))
|
(def! not (fn* (a) (if a false true)))
|
||||||
(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))
|
(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! 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
|
" string-lines harvest [ REP drop ] each
|
||||||
|
|
||||||
MAIN: main
|
MAIN: main
|
||||||
|
@ -50,8 +50,12 @@ DEFER: EVAL
|
|||||||
:: eval-try* ( params env -- maltype )
|
:: eval-try* ( params env -- maltype )
|
||||||
[ params first env EVAL ]
|
[ params first env EVAL ]
|
||||||
[
|
[
|
||||||
params second second env new-env [ env-set ] keep
|
params length 1 > [
|
||||||
params second third swap EVAL
|
params second second env new-env [ env-set ] keep
|
||||||
|
params second third swap EVAL
|
||||||
|
] [
|
||||||
|
throw
|
||||||
|
] if
|
||||||
] recover ;
|
] recover ;
|
||||||
|
|
||||||
: args-split ( bindlist -- bindlist restbinding/f )
|
: args-split ( bindlist -- bindlist restbinding/f )
|
||||||
@ -121,7 +125,11 @@ M: callable apply call( x -- y ) f ;
|
|||||||
: PRINT ( maltype -- str ) pr-str ;
|
: PRINT ( maltype -- str ) pr-str ;
|
||||||
|
|
||||||
: REP ( str -- 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 ( -- )
|
: REPL ( -- )
|
||||||
"(println (str \"Mal [\" *host-language* \"]\"))" REP drop
|
"(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! not (fn* (a) (if a false true)))
|
||||||
(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))
|
(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! 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
|
" string-lines harvest [ READ repl-env get EVAL drop ] each
|
||||||
|
|
||||||
MAIN: main
|
MAIN: main
|
||||||
|
@ -153,7 +153,6 @@ class Main
|
|||||||
REP("(def! not (fn* (a) (if a false true)))", repl_env)
|
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("(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! 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)
|
if (!args.isEmpty)
|
||||||
{
|
{
|
||||||
|
@ -165,7 +165,6 @@ class Main
|
|||||||
REP("(def! not (fn* (a) (if a false true)))", repl_env)
|
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("(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! 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)
|
if (!args.isEmpty)
|
||||||
{
|
{
|
||||||
|
@ -166,9 +166,6 @@ class Main
|
|||||||
REP("(def! not (fn* (a) (if a false true)))", repl_env)
|
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("(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! 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)
|
if (!args.isEmpty)
|
||||||
{
|
{
|
||||||
|
@ -310,7 +310,6 @@ defcore swap! { argv argc -- val }
|
|||||||
s\" (def! not (fn* (x) (if x false true)))" 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\" (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! 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 ( -- )
|
: repl ( -- )
|
||||||
begin
|
begin
|
||||||
|
@ -353,7 +353,6 @@ defcore map ( argv argc -- list )
|
|||||||
s\" (def! not (fn* (x) (if x false true)))" 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\" (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! 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 ( -- )
|
: repl ( -- )
|
||||||
begin
|
begin
|
||||||
|
@ -361,9 +361,6 @@ s\" (def! *host-language* \"forth\")" rep 2drop
|
|||||||
s\" (def! not (fn* (x) (if x false true)))" 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\" (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! 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 ( -- )
|
: repl ( -- )
|
||||||
s\" (println (str \"Mal [\" *host-language* \"]\"))" rep 2drop
|
s\" (println (str \"Mal [\" *host-language* \"]\"))" rep 2drop
|
||||||
|
@ -186,7 +186,6 @@ module REPL
|
|||||||
RE env """
|
RE env """
|
||||||
(def! not (fn* (a) (if a false true)))
|
(def! not (fn* (a) (if a false true)))
|
||||||
(def! load-file (fn* (f) (eval (read-string (slurp f)))))
|
(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)))))))
|
(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
|
""" |> Seq.iter ignore
|
||||||
|
|
||||||
|
@ -206,7 +206,6 @@ module REPL
|
|||||||
RE env """
|
RE env """
|
||||||
(def! not (fn* (a) (if a false true)))
|
(def! not (fn* (a) (if a false true)))
|
||||||
(def! load-file (fn* (f) (eval (read-string (slurp f)))))
|
(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)))))))
|
(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
|
""" |> Seq.iter ignore
|
||||||
|
|
||||||
|
@ -218,9 +218,6 @@ module REPL
|
|||||||
(def! not (fn* (a) (if a false true)))
|
(def! not (fn* (a) (if a false true)))
|
||||||
(def! load-file (fn* (f) (eval (read-string (slurp f)))))
|
(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)))))))
|
(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
|
""" |> Seq.iter ignore
|
||||||
|
|
||||||
env
|
env
|
||||||
|
@ -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! 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: '(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! 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: [
|
Smalltalk arguments notEmpty ifTrue: [
|
||||||
MAL rep: '(load-file "', Smalltalk arguments first, '")' env: replEnv
|
MAL rep: '(load-file "', Smalltalk arguments first, '")' env: replEnv
|
||||||
|
@ -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! 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: '(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! 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: [
|
Smalltalk arguments notEmpty ifTrue: [
|
||||||
MAL rep: '(load-file "', Smalltalk arguments first, '")' env: replEnv
|
MAL rep: '(load-file "', Smalltalk arguments first, '")' env: replEnv
|
||||||
|
@ -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! 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: '(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! 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: [
|
Smalltalk arguments notEmpty ifTrue: [
|
||||||
MAL rep: '(load-file "', Smalltalk arguments first, '")' env: replEnv
|
MAL rep: '(load-file "', Smalltalk arguments first, '")' env: replEnv
|
||||||
|
@ -311,7 +311,6 @@ func main() {
|
|||||||
rep("(def! not (fn* (a) (if a false true)))")
|
rep("(def! not (fn* (a) (if a false true)))")
|
||||||
rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
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! 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
|
// called with mal script to load and eval
|
||||||
if len(os.Args) > 1 {
|
if len(os.Args) > 1 {
|
||||||
|
@ -339,7 +339,6 @@ func main() {
|
|||||||
rep("(def! not (fn* (a) (if a false true)))")
|
rep("(def! not (fn* (a) (if a false true)))")
|
||||||
rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
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! 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
|
// called with mal script to load and eval
|
||||||
if len(os.Args) > 1 {
|
if len(os.Args) > 1 {
|
||||||
|
@ -340,9 +340,6 @@ func main() {
|
|||||||
rep("(def! not (fn* (a) (if a false true)))")
|
rep("(def! not (fn* (a) (if a false true)))")
|
||||||
rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
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! 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
|
// called with mal script to load and eval
|
||||||
if len(os.Args) > 1 {
|
if len(os.Args) > 1 {
|
||||||
|
@ -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! not (fn* (a) (if a false true)))")
|
||||||
REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
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! 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) {
|
if (this.args.size() > 0) {
|
||||||
|
@ -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! not (fn* (a) (if a false true)))")
|
||||||
REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
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! 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) {
|
if (this.args.size() > 0) {
|
||||||
|
@ -169,10 +169,6 @@ REP("(def! *host-language* \"groovy\")")
|
|||||||
REP("(def! not (fn* (a) (if a false true)))")
|
REP("(def! not (fn* (a) (if a false true)))")
|
||||||
REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
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! 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) {
|
if (this.args.size() > 0) {
|
||||||
repl_env.set(new MalSymbol("*ARGV*"), this.args.drop(1) as List)
|
repl_env.set(new MalSymbol("*ARGV*"), this.args.drop(1) as List)
|
||||||
|
@ -150,7 +150,7 @@
|
|||||||
((callable? c)
|
((callable? c)
|
||||||
(let ((cc (make-callable ht
|
(let ((cc (make-callable ht
|
||||||
(callable-unbox c)
|
(callable-unbox c)
|
||||||
(and (hash-table? ht) (hash-ref ht "ismacro"))
|
#f
|
||||||
(callable-closure c))))
|
(callable-closure c))))
|
||||||
cc))
|
cc))
|
||||||
(else
|
(else
|
||||||
|
@ -130,9 +130,4 @@
|
|||||||
|
|
||||||
(EVAL-string "(def! not (fn* (x) (if x false true)))")
|
(EVAL-string "(def! not (fn* (x) (if x false true)))")
|
||||||
|
|
||||||
;; NOTE: we have to reduce stack size to pass step5 test
|
(REPL)
|
||||||
((@ (system vm vm) call-with-stack-overflow-handler)
|
|
||||||
1024
|
|
||||||
(lambda () (REPL))
|
|
||||||
(lambda k (throw 'mal-error "stack overflow")))
|
|
||||||
|
|
||||||
|
@ -163,7 +163,6 @@
|
|||||||
(EVAL-string "(def! not (fn* (x) (if x false true)))")
|
(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 "(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! 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))))
|
(let ((args (cdr (command-line))))
|
||||||
(cond
|
(cond
|
||||||
|
@ -186,7 +186,6 @@
|
|||||||
(EVAL-string "(def! not (fn* (x) (if x false true)))")
|
(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 "(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! 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))))
|
(let ((args (cdr (command-line))))
|
||||||
(cond
|
(cond
|
||||||
|
@ -183,9 +183,6 @@
|
|||||||
(EVAL-string "(def! not (fn* (x) (if x false true)))")
|
(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 "(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! 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\")")
|
(EVAL-string "(def! *host-language* \"guile\")")
|
||||||
|
|
||||||
(let ((args (cdr (command-line))))
|
(let ((args (cdr (command-line))))
|
||||||
|
@ -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
481
haskell/Core.hs
@ -3,313 +3,384 @@ module Core
|
|||||||
where
|
where
|
||||||
|
|
||||||
import System.IO (hFlush, stdout)
|
import System.IO (hFlush, stdout)
|
||||||
import Control.Exception (catch)
|
import Control.Monad.Except (throwError)
|
||||||
import Control.Monad.Trans (liftIO)
|
import Control.Monad.Trans (liftIO)
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
|
import Data.Foldable (foldlM)
|
||||||
import Data.Time.Clock.POSIX (getPOSIXTime)
|
import Data.Time.Clock.POSIX (getPOSIXTime)
|
||||||
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
|
import Data.IORef (newIORef, readIORef, writeIORef)
|
||||||
|
|
||||||
import Readline (readline)
|
import Readline (readline)
|
||||||
import Reader (read_str)
|
import Reader (read_str)
|
||||||
import Types
|
import Types
|
||||||
import Printer (_pr_str, _pr_list)
|
import Printer (_pr_list)
|
||||||
|
|
||||||
-- General functions
|
-- 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 ="
|
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
|
-- Error/Exception functions
|
||||||
|
|
||||||
throw (mv:[]) = throwMalVal mv
|
throw :: Fn
|
||||||
|
throw [mv] = throwError mv
|
||||||
throw _ = throwStr "illegal arguments to throw"
|
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
|
-- Scalar functions
|
||||||
|
|
||||||
symbol (MalString str:[]) = return $ MalSymbol str
|
symbol :: Fn
|
||||||
|
symbol [MalString s] = return $ MalSymbol s
|
||||||
symbol _ = throwStr "symbol called with non-string"
|
symbol _ = throwStr "symbol called with non-string"
|
||||||
|
|
||||||
keyword (MalString ('\x029e':str):[]) = return $ MalString $ "\x029e" ++ str
|
keyword :: Fn
|
||||||
keyword (MalString str:[]) = return $ MalString $ "\x029e" ++ str
|
keyword [kw@(MalString (c : _))] | c == keywordMagic = return kw
|
||||||
|
keyword [MalString s] = return $ MalString (keywordMagic : s)
|
||||||
keyword _ = throwStr "keyword called with non-string"
|
keyword _ = throwStr "keyword called with non-string"
|
||||||
|
|
||||||
|
|
||||||
-- String functions
|
-- String functions
|
||||||
|
|
||||||
pr_str args = do
|
pr_str :: Fn
|
||||||
return $ MalString $ _pr_list True " " args
|
pr_str args = liftIO $ MalString <$> _pr_list True " " args
|
||||||
|
|
||||||
str args = do
|
str :: Fn
|
||||||
return $ MalString $ _pr_list False "" args
|
str args = liftIO $ MalString <$> _pr_list False "" args
|
||||||
|
|
||||||
prn args = do
|
prn :: Fn
|
||||||
liftIO $ putStrLn $ _pr_list True " " args
|
prn args = liftIO $ do
|
||||||
liftIO $ hFlush stdout
|
putStrLn =<< _pr_list True " " args
|
||||||
|
hFlush stdout
|
||||||
return Nil
|
return Nil
|
||||||
|
|
||||||
println args = do
|
println :: Fn
|
||||||
liftIO $ putStrLn $ _pr_list False " " args
|
println args = liftIO $ do
|
||||||
liftIO $ hFlush stdout
|
putStrLn =<< _pr_list False " " args
|
||||||
|
hFlush stdout
|
||||||
return Nil
|
return Nil
|
||||||
|
|
||||||
slurp ([MalString path]) = do
|
slurp :: Fn
|
||||||
str <- liftIO $ readFile path
|
slurp [MalString path] = MalString <$> liftIO (readFile path)
|
||||||
return $ MalString str
|
|
||||||
slurp _ = throwStr "invalid arguments to slurp"
|
slurp _ = throwStr "invalid arguments to slurp"
|
||||||
|
|
||||||
do_readline ([MalString prompt]) = do
|
do_readline :: Fn
|
||||||
str <- liftIO $ readline prompt
|
do_readline [MalString prompt] = do
|
||||||
case str of
|
maybeLine <- liftIO $ readline prompt
|
||||||
|
case maybeLine of
|
||||||
Nothing -> throwStr "readline failed"
|
Nothing -> throwStr "readline failed"
|
||||||
Just str -> return $ MalString str
|
Just line -> return $ MalString line
|
||||||
do_readline _ = throwStr "invalid arguments to readline"
|
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
|
-- Numeric functions
|
||||||
|
|
||||||
num_op op [MalNumber a, MalNumber b] = do
|
num_op :: (Int -> Int -> Int) -> Fn
|
||||||
return $ MalNumber $ op a b
|
num_op op [MalNumber a, MalNumber b] = return $ MalNumber $ op a b
|
||||||
num_op _ _ = throwStr "illegal arguments to number operation"
|
num_op _ _ = throwStr "illegal arguments to number operation"
|
||||||
|
|
||||||
cmp_op op [MalNumber a, MalNumber b] = do
|
cmp_op :: (Int -> Int -> Bool) -> Fn
|
||||||
return $ if op a b then MalTrue else MalFalse
|
cmp_op op [MalNumber a, MalNumber b] = return $ MalBoolean $ op a b
|
||||||
cmp_op _ _ = throwStr "illegal arguments to comparison operation"
|
cmp_op _ _ = throwStr "illegal arguments to comparison operation"
|
||||||
|
|
||||||
time_ms _ = do
|
time_ms :: Fn
|
||||||
t <- liftIO $ getPOSIXTime
|
time_ms [] = MalNumber . round . (* 1000) <$> liftIO getPOSIXTime
|
||||||
return $ MalNumber $ round (t * 1000)
|
time_ms _ = throwStr "invalid time-ms"
|
||||||
|
|
||||||
|
|
||||||
-- List functions
|
-- List functions
|
||||||
|
|
||||||
list args = return $ MalList args Nil
|
list :: Fn
|
||||||
|
list = return . toList
|
||||||
|
|
||||||
-- Vector functions
|
-- Vector functions
|
||||||
|
|
||||||
vector args = return $ MalVector args Nil
|
vector :: Fn
|
||||||
|
vector = return . MalSeq (MetaData Nil) (Vect True)
|
||||||
|
|
||||||
-- Hash Map functions
|
-- Hash Map functions
|
||||||
|
|
||||||
_pairup [x] = throwStr "Odd number of elements to _pairup"
|
hash_map :: Fn
|
||||||
_pairup [] = return []
|
hash_map kvs =
|
||||||
_pairup (MalString x:y:xs) = do
|
case keyValuePairs kvs of
|
||||||
rest <- _pairup xs
|
Just pairs -> return $ MalHashMap (MetaData Nil) $ Map.fromList pairs
|
||||||
return $ (x,y):rest
|
Nothing -> throwStr "invalid call to hash-map"
|
||||||
|
|
||||||
hash_map args = do
|
assoc :: Fn
|
||||||
pairs <- _pairup args
|
assoc (MalHashMap _ hm : kvs) =
|
||||||
return $ MalHashMap (Map.fromList pairs) Nil
|
case keyValuePairs kvs of
|
||||||
|
Just pairs -> return $ MalHashMap (MetaData Nil) $ Map.union (Map.fromList pairs) hm
|
||||||
assoc (MalHashMap hm _:kvs) = do
|
Nothing -> throwStr "invalid assoc"
|
||||||
pairs <- _pairup kvs
|
|
||||||
return $ MalHashMap (Map.union (Map.fromList pairs) hm) Nil
|
|
||||||
assoc _ = throwStr "invalid call to assoc"
|
assoc _ = throwStr "invalid call to assoc"
|
||||||
|
|
||||||
dissoc (MalHashMap hm _:ks) = do
|
remover :: Map.Map String MalVal -> MalVal -> IOThrows (Map.Map String MalVal)
|
||||||
let remover = (\hm (MalString k) -> Map.delete k hm) in
|
remover m (MalString k) = return $ Map.delete k m
|
||||||
return $ MalHashMap (foldl remover hm ks) Nil
|
remover _ _ = throwStr "invalid dissoc"
|
||||||
|
|
||||||
|
dissoc :: Fn
|
||||||
|
dissoc (MalHashMap _ hm : ks) = MalHashMap (MetaData Nil) <$> foldlM remover hm ks
|
||||||
dissoc _ = throwStr "invalid call to dissoc"
|
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
|
case Map.lookup k hm of
|
||||||
Just mv -> return mv
|
Just mv -> return mv
|
||||||
Nothing -> return Nil
|
Nothing -> return Nil
|
||||||
get (Nil:MalString k:[]) = return Nil
|
get [Nil, MalString _] = return Nil
|
||||||
get _ = throwStr "invalid call to get"
|
get _ = throwStr "invalid call to get"
|
||||||
|
|
||||||
contains_Q (MalHashMap hm _:MalString k:[]) = do
|
contains_Q :: Fn
|
||||||
if Map.member k hm then return MalTrue
|
contains_Q [MalHashMap _ hm, MalString k] = return $ MalBoolean $ Map.member k hm
|
||||||
else return MalFalse
|
contains_Q [Nil, MalString _] = return $ MalBoolean False
|
||||||
contains_Q (Nil:MalString k:[]) = return MalFalse
|
|
||||||
contains_Q _ = throwStr "invalid call to contains?"
|
contains_Q _ = throwStr "invalid call to contains?"
|
||||||
|
|
||||||
keys (MalHashMap hm _:[]) = do
|
keys :: Fn
|
||||||
return $ MalList (map MalString (Map.keys hm)) Nil
|
keys [MalHashMap _ hm] = return $ toList $ MalString <$> Map.keys hm
|
||||||
keys _ = throwStr "invalid call to keys"
|
keys _ = throwStr "invalid call to keys"
|
||||||
|
|
||||||
vals (MalHashMap hm _:[]) = do
|
vals :: Fn
|
||||||
return $ MalList (Map.elems hm) Nil
|
vals [MalHashMap _ hm] = return $ toList $ Map.elems hm
|
||||||
vals _ = throwStr "invalid call to vals"
|
vals _ = throwStr "invalid call to vals"
|
||||||
|
|
||||||
|
|
||||||
-- Sequence functions
|
-- Sequence functions
|
||||||
|
|
||||||
_sequential_Q (MalList _ _) = MalTrue
|
sequential_Q :: MalVal -> Bool
|
||||||
_sequential_Q (MalVector _ _) = MalTrue
|
sequential_Q (MalSeq _ _ _) = True
|
||||||
_sequential_Q _ = MalFalse
|
sequential_Q _ = False
|
||||||
|
|
||||||
cons x Nil = MalList [x] Nil
|
cons :: Fn
|
||||||
cons x (MalList lst _) = MalList (x:lst) Nil
|
cons [x, Nil ] = return $ toList [x]
|
||||||
cons x (MalVector lst _) = MalList (x:lst) Nil
|
cons [x, MalSeq _ _ lst] = return $ toList (x : lst)
|
||||||
|
cons _ = throwStr "illegal call to cons"
|
||||||
|
|
||||||
concat1 a (MalList lst _) = a ++ lst
|
unwrapSeq :: MalVal -> IOThrows [MalVal]
|
||||||
concat1 a (MalVector lst _) = a ++ lst
|
unwrapSeq (MalSeq _ _ xs) = return xs
|
||||||
do_concat args = return $ MalList (foldl concat1 [] args) Nil
|
unwrapSeq _ = throwStr "invalid concat"
|
||||||
|
|
||||||
nth ((MalList lst _):(MalNumber idx):[]) = do
|
do_concat :: Fn
|
||||||
if idx < length lst then return $ lst !! idx
|
do_concat args = toList . concat <$> mapM unwrapSeq args
|
||||||
else throwStr "nth: index out of range"
|
|
||||||
nth ((MalVector lst _):(MalNumber idx):[]) = do
|
nth :: Fn
|
||||||
if idx < length lst then return $ lst !! idx
|
nth [MalSeq _ _ lst, MalNumber idx] =
|
||||||
else throwStr "nth: index out of range"
|
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"
|
nth _ = throwStr "invalid call to nth"
|
||||||
|
|
||||||
first Nil = Nil
|
first :: Fn
|
||||||
first (MalList lst _) = if length lst > 0 then lst !! 0 else Nil
|
first [Nil ] = return Nil
|
||||||
first (MalVector lst _) = if length lst > 0 then lst !! 0 else Nil
|
first [MalSeq _ _ [] ] = return Nil
|
||||||
|
first [MalSeq _ _ (x : _)] = return x
|
||||||
|
first _ = throwStr "illegal call to first"
|
||||||
|
|
||||||
rest Nil = MalList [] Nil
|
rest :: Fn
|
||||||
rest (MalList lst _) = MalList (drop 1 lst) Nil
|
rest [Nil ] = return $ toList []
|
||||||
rest (MalVector lst _) = MalList (drop 1 lst) Nil
|
rest [MalSeq _ _ [] ] = return $ toList []
|
||||||
|
rest [MalSeq _ _ (_ : xs)] = return $ toList xs
|
||||||
|
rest _ = throwStr "illegal call to rest"
|
||||||
|
|
||||||
empty_Q Nil = MalTrue
|
empty_Q :: MalVal -> Bool
|
||||||
empty_Q (MalList [] _) = MalTrue
|
empty_Q Nil = True
|
||||||
empty_Q (MalVector [] _) = MalTrue
|
empty_Q (MalSeq _ _ []) = True
|
||||||
empty_Q _ = MalFalse
|
empty_Q _ = False
|
||||||
|
|
||||||
count (Nil:[]) = return $ MalNumber 0
|
count :: Fn
|
||||||
count (MalList lst _:[]) = return $ MalNumber $ length lst
|
count [Nil ] = return $ MalNumber 0
|
||||||
count (MalVector lst _:[]) = return $ MalNumber $ length lst
|
count [MalSeq _ _ lst] = return $ MalNumber $ length lst
|
||||||
count _ = throwStr $ "non-sequence passed to count"
|
count _ = throwStr "non-sequence passed to count"
|
||||||
|
|
||||||
apply args = do
|
concatLast :: [MalVal] -> IOThrows [MalVal]
|
||||||
f <- _get_call args
|
concatLast [MalSeq _ _ lst] = return lst
|
||||||
lst <- _to_list (last args)
|
concatLast (a : as) = (a :) <$> concatLast as
|
||||||
f $ (init (drop 1 args)) ++ lst
|
concatLast _ = throwStr "last argument of apply must be a sequence"
|
||||||
|
|
||||||
do_map args = do
|
apply :: Fn
|
||||||
f <- _get_call args
|
apply (MalFunction {fn=f} : xs) = f =<< concatLast xs
|
||||||
lst <- _to_list (args !! 1)
|
apply _ = throwStr "Illegal call to apply"
|
||||||
do new_lst <- mapM (\x -> f [x]) lst
|
|
||||||
return $ MalList new_lst Nil
|
|
||||||
|
|
||||||
conj ((MalList lst _):args) = return $ MalList ((reverse args) ++ lst) Nil
|
do_map :: Fn
|
||||||
conj ((MalVector lst _):args) = return $ MalVector (lst ++ args) Nil
|
do_map [MalFunction {fn=f}, MalSeq _ _ args] = toList <$> mapM (\x -> f [x]) args
|
||||||
conj _ = throwStr $ "illegal arguments to conj"
|
do_map _ = throwStr "Illegal call to map"
|
||||||
|
|
||||||
do_seq (l@(MalList [] _):[]) = return $ Nil
|
conj :: Fn
|
||||||
do_seq (l@(MalList lst m):[]) = return $ l
|
conj (MalSeq _ (Vect False) lst : args) = return $ toList $ reverse args ++ lst
|
||||||
do_seq (MalVector [] _:[]) = return $ Nil
|
conj (MalSeq _ (Vect True) lst : args) = return $ MalSeq (MetaData Nil) (Vect True) $ lst ++ args
|
||||||
do_seq (MalVector lst _:[]) = return $ MalList lst Nil
|
conj _ = throwStr "illegal arguments to conj"
|
||||||
do_seq (MalString []:[]) = return $ Nil
|
|
||||||
do_seq (MalString s:[]) = return $ MalList [MalString [c] | c <- s] Nil
|
do_seq :: Fn
|
||||||
do_seq (Nil:[]) = return $ Nil
|
do_seq [Nil ] = return Nil
|
||||||
do_seq _ = throwStr $ "seq: called on non-sequence"
|
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
|
-- Metadata functions
|
||||||
|
|
||||||
with_meta ((MalList lst _):m:[]) = return $ MalList lst m
|
with_meta :: Fn
|
||||||
with_meta ((MalVector lst _):m:[]) = return $ MalVector lst m
|
with_meta [MalSeq _ v x, m] = return $ MalSeq (MetaData m) v x
|
||||||
with_meta ((MalHashMap hm _):m:[]) = return $ MalHashMap hm m
|
with_meta [MalHashMap _ x, m] = return $ MalHashMap (MetaData m) x
|
||||||
with_meta ((MalAtom atm _):m:[]) = return $ MalAtom atm m
|
with_meta [MalAtom _ x, m] = return $ MalAtom (MetaData m) x
|
||||||
with_meta ((Func f _):m:[]) = return $ Func f m
|
with_meta [f@(MalFunction {}), m] = return $ f {meta=m}
|
||||||
with_meta ((MalFunc {fn=f, ast=a, env=e, params=p, macro=mc}):m:[]) = do
|
with_meta _ = throwStr "invalid with-meta call"
|
||||||
return $ MalFunc {fn=f, ast=a, env=e, params=p, macro=mc, meta=m}
|
|
||||||
with_meta _ = throwStr $ "invalid with-meta call"
|
|
||||||
|
|
||||||
do_meta ((MalList _ m):[]) = return m
|
do_meta :: Fn
|
||||||
do_meta ((MalVector _ m):[]) = return m
|
do_meta [MalSeq (MetaData m) _ _ ] = return m
|
||||||
do_meta ((MalHashMap _ m):[]) = return m
|
do_meta [MalHashMap (MetaData m) _] = return m
|
||||||
do_meta ((MalAtom _ m):[]) = return m
|
do_meta [MalAtom (MetaData m) _ ] = return m
|
||||||
do_meta ((Func _ m):[]) = return m
|
do_meta [MalFunction {meta=m} ] = return m
|
||||||
do_meta ((MalFunc {meta=m}):[]) = return m
|
do_meta _ = throwStr "invalid meta call"
|
||||||
do_meta _ = throwStr $ "invalid meta call"
|
|
||||||
|
|
||||||
-- Atom functions
|
-- Atom functions
|
||||||
|
|
||||||
atom (val:[]) = do
|
atom :: Fn
|
||||||
ref <- liftIO $ newIORef val
|
atom [val] = MalAtom (MetaData Nil) <$> liftIO (newIORef val)
|
||||||
return $ MalAtom ref Nil
|
|
||||||
atom _ = throwStr "invalid atom call"
|
atom _ = throwStr "invalid atom call"
|
||||||
|
|
||||||
deref (MalAtom ref _:[]) = do
|
deref :: Fn
|
||||||
val <- liftIO $ readIORef ref
|
deref [MalAtom _ ref] = liftIO $ readIORef ref
|
||||||
return val
|
|
||||||
deref _ = throwStr "invalid deref call"
|
deref _ = throwStr "invalid deref call"
|
||||||
|
|
||||||
reset_BANG (MalAtom ref _:val:[]) = do
|
reset_BANG :: Fn
|
||||||
|
reset_BANG [MalAtom _ ref, val] = do
|
||||||
liftIO $ writeIORef ref $ val
|
liftIO $ writeIORef ref $ val
|
||||||
return 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
|
val <- liftIO $ readIORef ref
|
||||||
f <- _get_call args
|
new_val <- f (val : args)
|
||||||
new_val <- f $ [val] ++ (tail args)
|
liftIO $ writeIORef ref new_val
|
||||||
_ <- liftIO $ writeIORef ref $ new_val
|
|
||||||
return new_val
|
return new_val
|
||||||
|
swap_BANG _ = throwStr "Illegal swap!"
|
||||||
|
|
||||||
|
ns :: [(String, Fn)]
|
||||||
ns = [
|
ns = [
|
||||||
("=", _func equal_Q),
|
("=", equal_Q),
|
||||||
("throw", _func throw),
|
("throw", throw),
|
||||||
("nil?", _func $ run_1 $ _nil_Q),
|
("nil?", pred1 nil_Q),
|
||||||
("true?", _func $ run_1 $ _true_Q),
|
("true?", pred1 true_Q),
|
||||||
("false?", _func $ run_1 $ _false_Q),
|
("false?", pred1 false_Q),
|
||||||
("string?", _func $ run_1 $ _string_Q),
|
("string?", pred1 string_Q),
|
||||||
("symbol", _func $ symbol),
|
("symbol", symbol),
|
||||||
("symbol?", _func $ run_1 $ _symbol_Q),
|
("symbol?", pred1 symbol_Q),
|
||||||
("keyword", _func $ keyword),
|
("keyword", keyword),
|
||||||
("keyword?", _func $ run_1 $ _keyword_Q),
|
("keyword?", pred1 keyword_Q),
|
||||||
("number?", _func $ run_1 $ _number_Q),
|
("number?", pred1 number_Q),
|
||||||
("fn?", _func $ run_1 $ _fn_Q),
|
("fn?", pred1 fn_Q),
|
||||||
("macro?", _func $ run_1 $ _macro_Q),
|
("macro?", pred1 macro_Q),
|
||||||
|
|
||||||
("pr-str", _func pr_str),
|
("pr-str", pr_str),
|
||||||
("str", _func str),
|
("str", str),
|
||||||
("prn", _func prn),
|
("prn", prn),
|
||||||
("println", _func println),
|
("println", println),
|
||||||
("readline", _func do_readline),
|
("readline", do_readline),
|
||||||
("read-string", _func (\[(MalString s)] -> read_str s)),
|
("read-string", read_string),
|
||||||
("slurp", _func slurp),
|
("slurp", slurp),
|
||||||
|
|
||||||
("<", _func $ cmp_op (<)),
|
("<", cmp_op (<)),
|
||||||
("<=", _func $ cmp_op (<=)),
|
("<=", cmp_op (<=)),
|
||||||
(">", _func $ cmp_op (>)),
|
(">", cmp_op (>)),
|
||||||
(">=", _func $ cmp_op (>=)),
|
(">=", cmp_op (>=)),
|
||||||
("+", _func $ num_op (+)),
|
("+", num_op (+)),
|
||||||
("-", _func $ num_op (-)),
|
("-", num_op (-)),
|
||||||
("*", _func $ num_op (*)),
|
("*", num_op (*)),
|
||||||
("/", _func $ num_op (div)),
|
("/", num_op (div)),
|
||||||
("time-ms", _func $ time_ms),
|
("time-ms", time_ms),
|
||||||
|
|
||||||
("list", _func $ list),
|
("list", list),
|
||||||
("list?", _func $ run_1 _list_Q),
|
("list?", pred1 list_Q),
|
||||||
("vector", _func $ vector),
|
("vector", vector),
|
||||||
("vector?", _func $ run_1 _vector_Q),
|
("vector?", pred1 vector_Q),
|
||||||
("hash-map", _func $ hash_map),
|
("hash-map", hash_map),
|
||||||
("map?", _func $ run_1 _hash_map_Q),
|
("map?", pred1 map_Q),
|
||||||
("assoc", _func $ assoc),
|
("assoc", assoc),
|
||||||
("dissoc", _func $ dissoc),
|
("dissoc", dissoc),
|
||||||
("get", _func $ get),
|
("get", get),
|
||||||
("contains?",_func $ contains_Q),
|
("contains?", contains_Q),
|
||||||
("keys", _func $ keys),
|
("keys", keys),
|
||||||
("vals", _func $ vals),
|
("vals", vals),
|
||||||
|
|
||||||
("sequential?", _func $ run_1 _sequential_Q),
|
("sequential?", pred1 sequential_Q),
|
||||||
("cons", _func $ run_2 $ cons),
|
("cons", cons),
|
||||||
("concat", _func $ do_concat),
|
("concat", do_concat),
|
||||||
("nth", _func nth),
|
("nth", nth),
|
||||||
("first", _func $ run_1 $ first),
|
("first", first),
|
||||||
("rest", _func $ run_1 $ rest),
|
("rest", rest),
|
||||||
("empty?", _func $ run_1 $ empty_Q),
|
("empty?", pred1 empty_Q),
|
||||||
("count", _func $ count),
|
("count", count),
|
||||||
("apply", _func $ apply),
|
("apply", apply),
|
||||||
("map", _func $ do_map),
|
("map", do_map),
|
||||||
|
|
||||||
("conj", _func $ conj),
|
("conj", conj),
|
||||||
("seq", _func $ do_seq),
|
("seq", do_seq),
|
||||||
|
|
||||||
("with-meta", _func $ with_meta),
|
("with-meta", with_meta),
|
||||||
("meta", _func $ do_meta),
|
("meta", do_meta),
|
||||||
("atom", _func $ atom),
|
("atom", atom),
|
||||||
("atom?", _func $ run_1 _atom_Q),
|
("atom?", pred1 atom_Q),
|
||||||
("deref", _func $ deref),
|
("deref", deref),
|
||||||
("reset!", _func $ reset_BANG),
|
("reset!", reset_BANG),
|
||||||
("swap!", _func $ swap_BANG)]
|
("swap!", swap_BANG)]
|
||||||
|
@ -1,65 +1,36 @@
|
|||||||
module Env
|
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
|
where
|
||||||
|
|
||||||
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
|
import Data.IORef (modifyIORef, newIORef, readIORef)
|
||||||
import Control.Monad.Trans (liftIO)
|
|
||||||
import Data.List (elemIndex)
|
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
|
|
||||||
import Types
|
import Types
|
||||||
import Printer
|
|
||||||
|
|
||||||
-- These Env types are defined in Types module to avoid dep cycle
|
-- The Env type si defined in Types module to avoid dep cycle.
|
||||||
--data EnvData = EnvPair (Maybe Env, (Map.Map String MalVal))
|
|
||||||
--type Env = IORef EnvData
|
|
||||||
|
|
||||||
env_new :: Maybe Env -> IO Env
|
env_new :: Env -> IO Env
|
||||||
env_new outer = newIORef $ EnvPair (outer, (Map.fromList []))
|
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_get :: Env -> String -> IO (Maybe MalVal)
|
||||||
env_bind envRef binds exprs = do
|
env_get [] _ = return Nothing
|
||||||
case (elemIndex (MalSymbol "&") binds) of
|
env_get (ref : outer) key = do
|
||||||
Nothing -> do
|
hm <- readIORef ref
|
||||||
-- bind binds to exprs
|
case Map.lookup key hm of
|
||||||
_ <- mapM (\(b,e) -> env_set envRef b e) $ zip binds exprs
|
Nothing -> env_get outer key
|
||||||
return envRef
|
justVal -> return justVal
|
||||||
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_find :: Env -> MalVal -> IO (Maybe Env)
|
env_set :: Env -> String -> MalVal -> IO ()
|
||||||
env_find envRef sym@(MalSymbol key) = do
|
env_set (ref : _) key val = modifyIORef ref $ Map.insert key val
|
||||||
e <- readIORef envRef
|
env_set [] _ _ = error "assertion failed in env_set"
|
||||||
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
|
|
||||||
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue
Block a user