kanaka/mal
1
1
Fork 0
mirror of https://github.com/kanaka/mal.git synced 2024-09-11 13:55:55 +03:00
Code Issues Projects Releases Wiki Activity

All: move metadata, atoms, readline, conj to stepA.

Browse Source 
- Move some of the more optional things (conj, readline) to stepA. All
  implementations pass step9 tests now.
- Move metadata and atoms to stepA.
- Update step9 and stepA diagrams.
This commit is contained in:
Joel Martin 2015-03-14 17:14:32 -05:00
parent ce5f8bed34
commit dbac60df00
26 changed files with 317 additions and 380 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
Makefile
View File

@ -11,8 +11,8 @@ PYTHON = python
#
IMPLS = bash c clojure coffee cs forth go haskell java js lua make mal \
ocaml matlab miniMAL perl php ps python r racket ruby rust \
scala vb nim
ocaml matlab miniMAL nim perl php ps python r racket ruby rust \
scala vb
step0 = step0_repl
step1 = step1_read_print
@ -32,19 +32,15 @@ EXCLUDE_TESTS += test^cs^step5 # fatal stack overflow fault
EXCLUDE_TESTS += test^haskell^step5 # test completes
EXCLUDE_TESTS += test^make^step5 # no TCO capability/step
EXCLUDE_TESTS += test^mal^step5 # no TCO capability/step
EXCLUDE_TESTS += test^miniMAL^step5 # strange error with runtest.py
EXCLUDE_TESTS += test^nim^step5 # test completes, even at 100,000
EXCLUDE_TESTS += test^go^step5 # test completes, even at 100,000
EXCLUDE_TESTS += test^php^step5 # test completes, even at 100,000
EXCLUDE_TESTS += test^racket^step5 # test completes
EXCLUDE_TESTS += test^ruby^step5 # test completes, even at 100,000
EXCLUDE_TESTS += test^rust^step5 # no catching stack overflows
EXCLUDE_TESTS += test^ocaml^step5 # test completes, even at 1,000,000
EXCLUDE_TESTS += test^nim^step5 # test completes, even at 100,000
# interop tests now implemented yet
EXCLUDE_TESTS += test^cs^stepA test^go^stepA test^haskell^stepA \
test^java^stepA test^mal^stepA test^mal^step0 \
test^php^stepA test^ps^stepA test^python^stepA \
test^ruby^stepA test^rust^stepA test^vb^stepA
EXCLUDE_TESTS += test^vb^step5 # completes at 10,000
EXCLUDE_PERFS = perf^mal # TODO: fix this
@ -70,6 +66,7 @@ mal_STEP_TO_PROG = mal/$($(1)).mal
ocaml_STEP_TO_PROG = ocaml/$($(1))
matlab_STEP_TO_PROG = matlab/$($(1)).m
miniMAL_STEP_TO_PROG = miniMAL/$($(1)).json
nim_STEP_TO_PROG = nim/$($(1))
perl_STEP_TO_PROG = perl/$($(1)).pl
php_STEP_TO_PROG = php/$($(1)).php
ps_STEP_TO_PROG = ps/$($(1)).ps
@ -80,7 +77,6 @@ ruby_STEP_TO_PROG = ruby/$($(1)).rb
rust_STEP_TO_PROG = rust/target/release/$($(1))
scala_STEP_TO_PROG = scala/$($(1)).scala
vb_STEP_TO_PROG = vb/$($(1)).exe
nim_STEP_TO_PROG = nim/$($(1))
# Needed some argument munging
COMMA = ,
@ -104,6 +100,7 @@ ocaml_RUNSTEP = ../$(2) $(3)
matlab_args = $(subst $(SPACE),$(COMMA),$(foreach x,$(strip $(1)),'$(x)'))
matlab_RUNSTEP = matlab -nodisplay -nosplash -nodesktop -nojvm -r "$($(1))($(call matlab_args,$(3)));quit;"
miniMAL_RUNSTEP = miniMAL ../$(2) $(3)
nim_RUNSTEP = ../$(2) $(3)
perl_RUNSTEP = perl ../$(2) --raw $(3)
php_RUNSTEP = php ../$(2) $(3)
ps_RUNSTEP = $(4)gs -q -I./ -dNODISPLAY -- ../$(2) $(3)$(4)
@ -114,7 +111,6 @@ ruby_RUNSTEP = ruby ../$(2) $(3)
rust_RUNSTEP = ../$(2) $(3)
scala_RUNSTEP = sbt 'run-main $($(1))$(if $(3), $(3),)'
vb_RUNSTEP = mono ../$(2) --raw $(3)
nim_RUNSTEP = ../$(2) $(3)
# Extra options to pass to runtest.py
cs_TEST_OPTS = --mono
@ -161,7 +157,7 @@ $(ALL_TESTS): $$(call $$(word 2,$$(subst ^, ,$$(@)))_STEP_TO_PROG,$$(word 3,$$(s
echo '----------------------------------------------'; \
echo 'Testing $@, step file: $+, test file: $(test)'; \
echo 'Running: ../runtest.py $(call $(impl)_TEST_OPTS) ../$(test) -- $(call $(impl)_RUNSTEP,$(step),$(+))'; \
../runtest.py $(call $(impl)_TEST_OPTS) ../$(test) -- $(call $(impl)_RUNSTEP,$(step),$(+)))))
../runtest.py $(call $(impl)_TEST_OPTS) ../$(test) -- $(call $(impl)_RUNSTEP,$(step),$(+));)))
test: $(ALL_TESTS)
tests: $(ALL_TESTS)

8
bash/core.sh
View File

@ -38,11 +38,15 @@ false? () { _false? "${1}" && r="${__true}" || r="${__false}"; }
# Symbol functions
symbol () { _symbol "${ANON["${1}"]}"; }
symbol? () { _symbol? "${1}" && r="${__true}" || r="${__false}"; }
# Keyword functions
keyword () { _keyword "${ANON["${1}"]}"; }
keyword? () { _keyword? "${1}" && r="${__true}" || r="${__false}"; }
@ -325,9 +329,9 @@ declare -A core_ns=(
[nil?]=nil?
[true?]=true?
[false?]=false?
[symbol]=_symbol
[symbol]=symbol
[symbol?]=symbol?
[keyword]=_keyword
[keyword]=keyword
[keyword?]=keyword?
[pr-str]=pr_str

16
bash/types.sh
View File

@ -53,7 +53,12 @@ _obj_type () {
func) r="function" ;;
strn)
local s="${ANON["${1}"]}"
[[ "${s:0:1}" = "${__keyw}" ]] && r="keyword" || r="string" ;;
if [[ "${1:0:1}" = "${__keyw}" ]] \
|| [[ "${1:0:2}" = "${__keyw}" ]]; then
r="keyword"
else
r="string"
fi ;;
_nil) r="nil" ;;
true) r="true" ;;
fals) r="false" ;;
@ -118,13 +123,18 @@ _keyword () {
local k="${1}"
__new_obj_hash_code
r="strn_${r}"
[[ "${1:1:1}" = "${__keyw}" ]] || k="${__keyw}${1}"
if [[ "${1:0:1}" = "${__keyw}" ]] \
|| [[ "${1:0:2}" = "${__keyw}" ]]; then
true
else
k="${__keyw}${1}"
fi
ANON["${r}"]="${k//\*/__STAR__}"
}
_keyword? () {
[[ ${1} =~ ^strn_ ]] || return 1
local s="${ANON["${1}"]}"
[[ "${s:0:1}" = "${__keyw}" ]]
[[ "${s:0:1}" = "${__keyw}" ]] || [[ "${s:0:2}" = "${__keyw}" ]]
}

6
c/core.c
View File

@ -49,7 +49,11 @@ MalVal *symbol_Q(MalVal *seq) {
MalVal *keyword(MalVal *args) {
assert_type(args, MAL_STRING,
"keyword called with non-string value");
return malval_new_keyword(args->val.string);
if (args->val.string[0] == '\x7f') {
return args;
} else {
return malval_new_keyword(args->val.string);
}
}
MalVal *keyword_Q(MalVal *seq) {

4
coffee/env.coffee
View File

@ -7,10 +7,10 @@ exports.Env = class Env
if @binds.length > 0
for b,i in @binds
if types._symbol_Q(b) && b.name == "&"
@data[@binds[i+1].name] = exprs[i..]
@data[@binds[i+1].name] = @exprs[i..]
break
else
@data[b.name] = exprs[i]
@data[b.name] = @exprs[i]
find: (key) ->
if not types._symbol_Q(key)
throw new Error("env.find key must be symbol")

3
coffee/types.coffee
View File

@ -71,7 +71,8 @@ E._symbol = (str) -> new Symbol str
E._symbol_Q = _symbol_Q = (o) -> o instanceof Symbol
# Keywords
E._keyword = _keyword = (str) -> "\u029e" + str
E._keyword = _keyword = (o) ->
_keyword_Q(o) && o || ("\u029e" + o)
E._keyword_Q = _keyword_Q = (o) ->
typeof o == 'string' && o[0] == "\u029e"

9
cs/core.cs
View File

@ -36,7 +36,14 @@ namespace Mal {
a => a[0] is MalSymbol ? True : False);
static MalFunc keyword = new MalFunc(
a => new MalString("\u029e" + ((MalString)a[0]).getValue()));
a => {
if (a[0] is MalString &&
((MalString)a[0]).getValue()[0] == '\u029e') {
return a[0];
} else {
return new MalString("\u029e" + ((MalString)a[0]).getValue());
}
} );
static MalFunc keyword_Q = new MalFunc(
a => {

13
docs/TODO
View File

@ -1,16 +1,15 @@
All:
- Finish guide.md
- Split metadata, atoms, readline into stepA
- test *ARGV* gets set properly
- test that *ARGV* gets set properly
- test to make sure slurp captures final newline
- runtest expect fixes:
- fix long line splitting in runtest
- Give runtest knowledge of optional and report differently
- fix long line splitting in runtest
- Give runtest knowledge of optional tests and report as non-fatal
- regular expression matching in runtest
- add re (use in rep) everywhere and use that (to avoid printing)
- per impl tests for step5_tco, or at least a better way of
enabling/disabling/tweaking per implementation
- fix stepA failures: lua matlab miniMAL perl racket
Other ideas for All:
- propagate/print errors when self-hosted
@ -34,10 +33,6 @@ Other ideas for All:
the namespace environment. Need protocols first probably.
- Fix quasiquoting of vectors
- Get self-host working at earlier step:
- Move try* to step6
- Remove macros from mal
- multi-line REPL read
- loop/recur ?
- gensym reader inside quasiquote

6
go/src/core/core.go
View File

@ -417,7 +417,11 @@ var NS = map[string]MalType{
return Symbol_Q(a[0]), nil
},
"keyword": func(a []MalType) (MalType, error) {
return NewKeyword(a[0].(string))
if Keyword_Q(a[0]) {
return a[0], nil
} else {
return NewKeyword(a[0].(string))
}
},
"keyword?": func(a []MalType) (MalType, error) {
return Keyword_Q(a[0]), nil

1
haskell/Core.hs
View File

@ -37,6 +37,7 @@ throw _ = throwStr "illegal arguments to throw"
symbol (MalString str:[]) = return $ MalSymbol str
symbol _ = throwStr "symbol called with non-string"
keyword (MalString ('\x029e':str):[]) = return $ MalString $ "\x029e" ++ str
keyword (MalString str:[]) = return $ MalString $ "\x029e" ++ str
keyword _ = throwStr "keyword called with non-string"

9
java/src/main/java/mal/core.java
View File

@ -61,8 +61,13 @@ public class core {
};
static MalFunction keyword = new MalFunction() {
public MalVal apply(MalList args) throws MalThrowable {
return new MalString(
"\u029e" + ((MalString)args.nth(0)).getValue());
if (args.nth(0) instanceof MalString &&
(((MalString)args.nth(0)).getValue().charAt(0) == '\u029e')) {
return (MalString)args.nth(0);
} else {
return new MalString(
"\u029e" + ((MalString)args.nth(0)).getValue());
}
}
};
static MalFunction keyword_Q = new MalFunction() {

8
js/types.js
View File

@ -104,7 +104,13 @@ function _symbol_Q(obj) { return obj instanceof Symbol; }
// Keywords
function _keyword(name) { return "\u029e" + name; }
function _keyword(obj) {
if (typeof obj === 'string' && obj[0] === '\u029e') {
return obj;
} else {
return "\u029e" + obj;
}
}
function _keyword_Q(obj) {
return typeof obj === 'string' && obj[0] === '\u029e';
}

2
make/core.mk
View File

@ -168,7 +168,7 @@ sapply = $(call $(word 1,$(1))_value,\
smap = $(strip\
$(foreach func,$(word 1,$(1)),\
$(foreach lst,$(word 2,$(1)),\
$(foreach type,$(word 2,$(subst _, ,$(lst))),\
$(foreach type,list,\
$(foreach new_hcode,$(call __new_obj_hash_code),\
$(foreach sz,$(words $(call __get_obj_values,$(lst))),\
$(eval $(__obj_magic)_$(type)_$(new_hcode)_value := $(strip \

3
php/core.php
View File

@ -144,7 +144,8 @@ function apply($f) {
function map($f, $seq) {
$l = new ListClass();
$l->exchangeArray(array_map($f, $seq->getArrayCopy()));
# @ to surpress warning if $f throws an exception
@$l->exchangeArray(array_map($f, $seq->getArrayCopy()));
return $l;
}

9
process/guide.md
View File

@ -1179,18 +1179,15 @@ implementation. Let us continue!
![step9_try architecture](step9_try.png)
Compare the pseudocode for step 8 and step 9 to get a basic idea of
the changes that will be made during this step. This step is currently
divided into two sections because some of the functions in the second
step will be moving to step A in the future:
the changes that will be made during this step:
```
diff -urp ../process/step8_macros.txt ../process/step9_try.txt
diff -urp ../process/step9_try.txt ../process/step9_try2.txt
```
* Copy `step8_macros.qx` to `step9_try.qx`.
* TODO/TBD.
* In step 5, if you did not add original function (`fn`) to the
* In step 5, if you did not add the original function (`fn`) to the
returned structure returned from `fn*`, the you will need to do so
now.
@ -1204,7 +1201,7 @@ diff -urp ../process/step9_try.txt ../process/step9_try2.txt
Compare the pseudocode for step 9 and step A to get a basic idea of
the changes that will be made during this step:
```
diff -urp ../process/step9_try2.txt ../process/stepA_mal.txt
diff -urp ../process/step9_try.txt ../process/stepA_mal.txt
```
* Copy `step9_try.qx` to `stepA_mal.qx`.

BIN
process/step9_try.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 83 KiB

After

Width:  |  Height:  |  Size: 80 KiB

23
process/step9_try.txt
View File

@ -74,6 +74,14 @@ class Env (outer=null,binds=[],exprs=[])
ns = {'=: equal?,
'throw: throw,
'nil?: nil?,
'true?: true?,
'false?: false?,
'symbol: symbol,
'symbol?: symbol?,
'keyword: keyword,
'keyword?: keyword?,
'pr-str: (a) -> a.map(|s| pr_str(e,true)).join(" ")),
'str: (a) -> a.map(|s| pr_str(e,false)).join("")),
'prn: (a) -> println(a.map(|s| pr_str(e,true)).join(" ")),
@ -92,11 +100,24 @@ ns = {'=: equal?,
'list: list,
'list?: list?,
'vector: vector,
'vector?: vector?,
'hash-map: hash_map,
'map?: hash_map?,
'assoc: assoc,
'dissoc: dissoc,
'get: get,
'contains?: contains?,
'keys: keys,
'vals: vals,
'sequential? sequential?,
'cons: (a) -> concat([a[0]], a[1]),
'concat: (a) -> reduce(concat, [], a),
'nth: (a) -> a[0][a[1]] OR raise "nth: index out of range",
'first: (a) -> a[0][0] OR nil,
'rest: (a) -> a[0][1..] OR list(),
'empty?: empty?,
'count: count}
'count: count,
'apply: apply,
'map: map}

133
process/step9_try2.txt
View File

@ -1,133 +0,0 @@
--- step9_try -----------------------------------
import types, reader, printer, env, core
READ(str): return reader.read_str(str)
pair?(ast): return ... // true if non-empty sequence
quasiquote(ast): return ... // quasiquote
macro?(ast, env): return ... // true if macro call
macroexpand(ast, env): return ... // recursive macro expansion
eval_ast(ast,env):
switch type(ast):
symbol: return env.get(ast)
list,vector: return ast.map((x) -> EVAL(x,env))
hash: return ast.map((k,v) -> list(k, EVAL(v,env)))
_default_: return ast
EVAL(ast,env):
while true:
if not list?(ast): return eval_ast(ast, env)
ast = macroexpand(ast, env)
if not list?(ast): return ast
switch ast[0]:
'def!: return env.set(ast[1], EVAL(ast[2], env))
'let*: env = ...; ast = ast[2] // TCO
'quote: return ast[1]
'quasiquote: ast = quasiquote(ast[1]) // TCO
'defmacro!: return ... // like def!, but set macro property
'macroexpand: return macroexpand(ast[1], env)
'try*: return ... // try/catch native and malval exceptions
'do: ast = eval_ast(ast[1..-1], env)[-1] // TCO
'if: EVAL(ast[1], env) ? ast = ast[2] : ast = ast[3] // TCO
'fn*: return new MalFunc(...)
_default_: f, args = eval_ast(ast, env)
if malfunc?(f): ast = f.fn; env = ... // TCO
else: return apply(f, args)
PRINT(exp): return printer.pr_str(exp)
repl_env = new Env()
rep(str): return PRINT(EVAL(READ(str),repl_env))
;; core.EXT: defined using Racket
core.ns.map((k,v) -> (repl_env.set(k, v)))
repl_env.set('eval, (ast) -> EVAL(ast, repl-env))
repl_env.set('*ARGV*, cmdline_args[1..])
;; core.mal: defined using the language itself
rep("(def! not (fn* (a) (if a false true)))")
rep("(def! load-file (fn* (f) ...))")
rep("(defmacro! cond (fn* (& xs) ...))")
rep("(defmacro! or (fn* (& xs) ...))")
if cmdline_args: rep("(load-file \"" + args[0] + "\")"); exit 0
main loop:
try: println(rep(readline("user> ")))
catch e: println("Error: ", e)
--- env module ----------------------------------
class Env (outer=null,binds=[],exprs=[])
data = hash_map()
foreach b, i in binds:
if binds[i] == '&: data[binds[i+1]] = exprs.drop(i); break
else: data[binds[i]] = exprs[i]
set(k,v): return data.set(k,v)
find(k): return data.has(k) ? this : (if outer ? find(outer) : null)
get(k): return data.find(k).get(k) OR raise "'" + k + "' not found"
--- core module ---------------------------------
ns = {'=: equal?,
'throw: throw,
'nil?: nil?,
'true?: true?,
'false?: false?,
'symbol: symbol,
'symbol?: symbol?,
'keyword: keyword,
'keyword?: keyword?,
'pr-str: (a) -> a.map(|s| pr_str(e,true)).join(" ")),
'str: (a) -> a.map(|s| pr_str(e,false)).join("")),
'prn: (a) -> println(a.map(|s| pr_str(e,true)).join(" ")),
'println: (a) -> println(a.map(|s| pr_str(e,false)).join(" ")),
'read-string: read_str,
'readline: readline,
'slurp read-file,
'<: lt,
'<=: lte,
'>: gt,
'>=: gte,
'+: add,
'-: sub,
'*: mult,
'/: div,
'list: list,
'list?: list?,
'vector: vector,
'vector?: vector?,
'hash-map: hash_map,
'map?: hash_map?,
'assoc: assoc,
'dissoc: dissoc,
'get: get,
'contains?: contains?,
'keys: keys,
'vals: vals,
'sequential? sequential?,
'cons: (a) -> concat([a[0]], a[1]),
'concat: (a) -> reduce(concat, [], a),
'nth: (a) -> a[0][a[1]] OR raise "nth: index out of range",
'first: (a) -> a[0][0] OR nil,
'rest: (a) -> a[0][1..] OR list(),
'empty?: empty?,
'count: count,
'apply: apply,
'map: map,
'conj: conj,
'meta: (a) -> a[0].meta,
'with-meta: (a) -> a[0].with_meta(a[1]),
'atom: (a) -> new Atom(a[0]),
'atom?: (a) -> type(a[0]) == "atom",
'deref: (a) -> a[0].val,
'reset!: (a) -> a[0].val = a[1],
'swap!: swap!}

BIN
process/stepA_mal.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 81 KiB

After

Width:  |  Height:  |  Size: 82 KiB

1
process/stepA_mal.txt
View File

@ -125,6 +125,7 @@ ns = {'=: equal?,
'count: count,
'apply: apply,
'map: map,
'conj: conj,
'meta: (a) -> a[0].meta,

2
python/mal_readline.py
View File

@ -17,7 +17,7 @@ def readline(prompt="user> "):
pyreadline.add_history(line.rstrip("\r\n"))
pass
except IOError:
print("Could not open %s" % histfile)
#print("Could not open %s" % histfile)
pass
try:

4
r/types.r
View File

@ -84,7 +84,9 @@ new.symbol <- function(name) structure(name, class="Symbol")
.symbol_q <- function(obj) "Symbol" == class(obj)
new.keyword <- function(name) concat("\u029e", name)
.keyword_q <- function(obj) {
"character" == class(obj) && "\u029e" == substr(obj,1,1)
"character" == class(obj) &&
("\u029e" == substr(obj,1,1) ||
"<U+029E>" == substring(obj,1,8))
}
# Functions

3
scala/core.scala
View File

@ -133,7 +133,8 @@ object core {
def do_map(a: List[Any]): Any = {
a match {
case f :: seq :: Nil => {
seq.asInstanceOf[MalList].map(x => types._apply(f,List(x)))
var res = seq.asInstanceOf[MalList].map(x => types._apply(f,List(x)));
_list(res.value:_*)
}
case _ => throw new Exception("invalid map call")
}

10
tests/step6_file.mal
View File

@ -4,11 +4,21 @@
(do (do 1 2))
;=>2
;;
;; Testing read-string, eval and slurp
(read-string "(1 2 (3 4) nil)")
;=>(1 2 (3 4) nil)
(read-string "(+ 2 3)")
;=>(+ 2 3)
(read-string "7 ;; comment")
;=>7
;;; Differing output, but make sure no fatal error
(read-string ";; comment")
(eval (read-string "(+ 2 3)"))
;=>5

208
tests/step9_try.mal
View File

@ -73,27 +73,6 @@
(map (fn* (x) (symbol? x)) (list 1 (symbol "two") "three"))
;=>(false true false)
;;
;; Testing read-str and eval
(read-string "(1 2 (3 4) nil)")
;=>(1 2 (3 4) nil)
(read-string "7 ;; comment")
;=>7
;;; Differing output, but make sure no fatal error
(read-string ";; comment")
(eval (read-string "(+ 4 5)"))
;=>9
;;
;; Testing readline
(readline "mal-user> ")
"hello"
;=>"\"hello\""
;;
;; ------- Optional Functionality ----------
;; ------- (Needed for self-hosting) -------
@ -116,6 +95,14 @@
(keyword? (keyword "abc"))
;=>true
(symbol "abc")
;=>abc
;;;TODO: all implementations should suppport this too
;;;(keyword :abc)
;;;;=>:abc
(keyword "abc")
;=>:abc
;; Testing sequential? function
(sequential? (list 1 2 3))
@ -259,182 +246,3 @@
;;
;; Testing metadata on functions
;;
;; Testing metadata on mal functions
(meta (fn* (a) a))
;=>nil
(meta (with-meta (fn* (a) a) {"b" 1}))
;=>{"b" 1}
(meta (with-meta (fn* (a) a) "abc"))
;=>"abc"
(def! l-wm (with-meta (fn* (a) a) {"b" 2}))
(meta l-wm)
;=>{"b" 2}
(meta (with-meta l-wm {"new_meta" 123}))
;=>{"new_meta" 123}
(meta l-wm)
;=>{"b" 2}
(def! f-wm (with-meta (fn* [a] (+ 1 a)) {"abc" 1}))
(meta f-wm)
;=>{"abc" 1}
(meta (with-meta f-wm {"new_meta" 123}))
;=>{"new_meta" 123}
(meta f-wm)
;=>{"abc" 1}
(def! f-wm2 ^{"abc" 1} (fn* [a] (+ 1 a)))
(meta f-wm2)
;=>{"abc" 1}
;;
;; Make sure closures and metadata co-exist
(def! gen-plusX (fn* (x) (with-meta (fn* (b) (+ x b)) {"meta" 1})))
(def! plus7 (gen-plusX 7))
(def! plus8 (gen-plusX 8))
(plus7 8)
;=>15
(meta plus7)
;=>{"meta" 1}
(meta plus8)
;=>{"meta" 1}
(meta (with-meta plus7 {"meta" 2}))
;=>{"meta" 2}
(meta plus8)
;=>{"meta" 1}
;;
;; Testing atoms
(def! inc3 (fn* (a) (+ 3 a)))
(def! a (atom 2))
;=>(atom 2)
;;;(type a)
;;;;=>"atom"
(deref a)
;=>2
@a
;=>2
(reset! a 3)
;=>3
@a
;=>3
(swap! a inc3)
;=>6
@a
;=>6
(swap! a (fn* (a) a))
;=>6
(swap! a (fn* (a) (* 2 a)))
;=>12
(swap! a (fn* (a b) (* a b)) 10)
;=>120
(swap! a + 3)
;=>123
;; Testing swap!/closure interaction
(def! inc-it (fn* (a) (+ 1 a)))
(def! atm (atom 7))
(def! f (fn* [] (swap! atm inc-it)))
(f)
;=>8
(f)
;=>9
;;
;; ------- Optional Functionality --------------
;; ------- (Not needed for self-hosting) -------
;;
;; Testing conj function
(conj (list) 1)
;=>(1)
(conj (list 1) 2)
;=>(2 1)
(conj (list 2 3) 4)
;=>(4 2 3)
(conj (list 2 3) 4 5 6)
;=>(6 5 4 2 3)
(conj (list 1) (list 2 3))
;=>((2 3) 1)
(conj [] 1)
;=>[1]
(conj [1] 2)
;=>[1 2]
(conj [2 3] 4)
;=>[2 3 4]
(conj [2 3] 4 5 6)
;=>[2 3 4 5 6]
(conj [1] [2 3])
;=>[1 [2 3]]
;;
;; Testing metadata on collections
(meta [1 2 3])
;=>nil
(with-meta [1 2 3] {"a" 1})
;=>[1 2 3]
(meta (with-meta [1 2 3] {"a" 1}))
;=>{"a" 1}
(meta (with-meta [1 2 3] "abc"))
;=>"abc"
(meta (with-meta (list 1 2 3) {"a" 1}))
;=>{"a" 1}
(meta (with-meta {"abc" 123} {"a" 1}))
;=>{"a" 1}
;;; Not actually supported by Clojure
;;;(meta (with-meta (atom 7) {"a" 1}))
;;;;=>{"a" 1}
(def! l-wm (with-meta [4 5 6] {"b" 2}))
;=>[4 5 6]
(meta l-wm)
;=>{"b" 2}
(meta (with-meta l-wm {"new_meta" 123}))
;=>{"new_meta" 123}
(meta l-wm)
;=>{"b" 2}
;;
;; Testing metadata on builtin functions
(meta +)
;=>nil
(def! f-wm3 ^{"def" 2} +)
(meta f-wm3)
;=>{"def" 2}
(meta +)
;=>nil

196
tests/stepA_mal.mal Normal file
View File

@ -0,0 +1,196 @@
;;;
;;; See IMPL/tests/stepA_mal.mal for implementation specific
;;; interop tests.
;;;
;;
;; Testing readline
(readline "mal-user> ")
"hello"
;=>"\"hello\""
;;
;; ------- Optional Functionality ----------
;; ------- (Needed for self-hosting) -------
;;
;; Testing metadata on functions
;;
;; Testing metadata on mal functions
(meta (fn* (a) a))
;=>nil
(meta (with-meta (fn* (a) a) {"b" 1}))
;=>{"b" 1}
(meta (with-meta (fn* (a) a) "abc"))
;=>"abc"
(def! l-wm (with-meta (fn* (a) a) {"b" 2}))
(meta l-wm)
;=>{"b" 2}
(meta (with-meta l-wm {"new_meta" 123}))
;=>{"new_meta" 123}
(meta l-wm)
;=>{"b" 2}
(def! f-wm (with-meta (fn* [a] (+ 1 a)) {"abc" 1}))
(meta f-wm)
;=>{"abc" 1}
(meta (with-meta f-wm {"new_meta" 123}))
;=>{"new_meta" 123}
(meta f-wm)
;=>{"abc" 1}
(def! f-wm2 ^{"abc" 1} (fn* [a] (+ 1 a)))
(meta f-wm2)
;=>{"abc" 1}
;;
;; Make sure closures and metadata co-exist
(def! gen-plusX (fn* (x) (with-meta (fn* (b) (+ x b)) {"meta" 1})))
(def! plus7 (gen-plusX 7))
(def! plus8 (gen-plusX 8))
(plus7 8)
;=>15
(meta plus7)
;=>{"meta" 1}
(meta plus8)
;=>{"meta" 1}
(meta (with-meta plus7 {"meta" 2}))
;=>{"meta" 2}
(meta plus8)
;=>{"meta" 1}
;;
;; Testing atoms
(def! inc3 (fn* (a) (+ 3 a)))
(def! a (atom 2))
;=>(atom 2)
;;;(type a)
;;;;=>"atom"
(deref a)
;=>2
@a
;=>2
(reset! a 3)
;=>3
@a
;=>3
(swap! a inc3)
;=>6
@a
;=>6
(swap! a (fn* (a) a))
;=>6
(swap! a (fn* (a) (* 2 a)))
;=>12
(swap! a (fn* (a b) (* a b)) 10)
;=>120
(swap! a + 3)
;=>123
;; Testing swap!/closure interaction
(def! inc-it (fn* (a) (+ 1 a)))
(def! atm (atom 7))
(def! f (fn* [] (swap! atm inc-it)))
(f)
;=>8
(f)
;=>9
;;
;; ------- Optional Functionality --------------
;; ------- (Not needed for self-hosting) -------
;;
;; Testing conj function
(conj (list) 1)
;=>(1)
(conj (list 1) 2)
;=>(2 1)
(conj (list 2 3) 4)
;=>(4 2 3)
(conj (list 2 3) 4 5 6)
;=>(6 5 4 2 3)
(conj (list 1) (list 2 3))
;=>((2 3) 1)
(conj [] 1)
;=>[1]
(conj [1] 2)
;=>[1 2]
(conj [2 3] 4)
;=>[2 3 4]
(conj [2 3] 4 5 6)
;=>[2 3 4 5 6]
(conj [1] [2 3])
;=>[1 [2 3]]
;;
;; Testing metadata on collections
(meta [1 2 3])
;=>nil
(with-meta [1 2 3] {"a" 1})
;=>[1 2 3]
(meta (with-meta [1 2 3] {"a" 1}))
;=>{"a" 1}
(meta (with-meta [1 2 3] "abc"))
;=>"abc"
(meta (with-meta (list 1 2 3) {"a" 1}))
;=>{"a" 1}
(meta (with-meta {"abc" 123} {"a" 1}))
;=>{"a" 1}
;;; Not actually supported by Clojure
;;;(meta (with-meta (atom 7) {"a" 1}))
;;;;=>{"a" 1}
(def! l-wm (with-meta [4 5 6] {"b" 2}))
;=>[4 5 6]
(meta l-wm)
;=>{"b" 2}
(meta (with-meta l-wm {"new_meta" 123}))
;=>{"new_meta" 123}
(meta l-wm)
;=>{"b" 2}
;;
;; Testing metadata on builtin functions
(meta +)
;=>nil
(def! f-wm3 ^{"def" 2} +)
(meta f-wm3)
;=>{"def" 2}
(meta +)
;=>nil