diff options
-rw-r--r-- | res/builtins.lisp | 32 | ||||
-rw-r--r-- | res/reflect.lisp | 0 | ||||
-rw-r--r-- | res/stdtest.lisp | 2 | ||||
-rw-r--r-- | src/CoreBindings.kt | 49 | ||||
-rw-r--r-- | test/res/scratch.lisp | 26 | ||||
-rw-r--r-- | test/res/test.lisp | 45 |
6 files changed, 100 insertions, 54 deletions
diff --git a/res/builtins.lisp b/res/builtins.lisp index 1564e62..d1828f6 100644 --- a/res/builtins.lisp +++ b/res/builtins.lisp @@ -1,7 +1,33 @@ -(defun comment (...) ((pure nil))) +(core.defun comment (...) ((core.pure core.nil))) (comment "comment is a noop function for documentation") (export comment) +(comment "Re-exports from core") +(core.def def core.def) +(def defun core.defun) +(def if core.if) +(def nil core.nil) +(def stringify core.tostring) +(def pure core.pure) +(def lambda core.lambda) +(def seq core.seq) +(def import core.import) +(def debuglog core.debuglog) +(export def defun if nil stringify pure lambda seq import debuglog) + +(comment "Re-exports from arithmetic") +(def + core.arith.add) +(def / core.arith.div) +(def * core.arith.mul) +(def - core.arith.sub) +(def = core.arith.eq) +(def lt core.arith.less) +(export + / * - = lt) + +(comment "comparisons") +(defun gt (l r) (lt r l)) +(export gt) + (comment "if! a strict version of a regular if, meaning it evaluates both the falsy and the truthy case, instead of only one.") (defun if! (cond ifTrue ifFalse) (if cond ifTrue ifFalse)) @@ -26,7 +52,3 @@ (defun not (v) (if v false true)) (defun ^ (l r) (if l (not r) r)) (export | & not ^) - -(comment "comparisons") -(defun gt (l r) (lt r l)) -(export gt) diff --git a/res/reflect.lisp b/res/reflect.lisp new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/res/reflect.lisp diff --git a/res/stdtest.lisp b/res/stdtest.lisp index bf230b3..42f9c94 100644 --- a/res/stdtest.lisp +++ b/res/stdtest.lisp @@ -18,5 +18,5 @@ (defun test.assert-eq (actual expected) (test.assert (= actual expected) - (tostring "Expected" expected "got" actual))) + (stringify "Expected" expected "got" actual))) (export test.assert-eq) diff --git a/src/CoreBindings.kt b/src/CoreBindings.kt index 7db5175..3691744 100644 --- a/src/CoreBindings.kt +++ b/src/CoreBindings.kt @@ -206,26 +206,43 @@ object CoreBindings { return@externalRawCall LispData.LispNil } + val reflect = LispData.externalCall("reflect.type") { args, reportError -> + if (args.size != 1) { + return@externalCall reportError("reflect.type can only return the type for one argument") + } + + return@externalCall when (args[0]) { + is LispData.Atom -> LispData.Atom("atom") + is LispData.LispExecutable -> LispData.Atom("callable") + is LispData.LispList -> LispData.Atom("list") + LispData.LispNil -> LispData.Atom("nil") + is LispData.LispNode -> LispData.Atom("ast") + is LispData.LispNumber -> LispData.Atom("number") + is LispData.LispString -> LispData.Atom("string") + } + } + fun offerArithmeticTo(bindings: StackFrame) { - bindings.setValueLocal("+", add) - bindings.setValueLocal("/", div) - bindings.setValueLocal("*", mul) - bindings.setValueLocal("-", sub) - bindings.setValueLocal("lt", less) - bindings.setValueLocal("=", eq) + bindings.setValueLocal("core.arith.add", add) + bindings.setValueLocal("core.arith.div", div) + bindings.setValueLocal("core.arith.mul", mul) + bindings.setValueLocal("core.arith.sub", sub) + bindings.setValueLocal("core.arith.less", less) + bindings.setValueLocal("core.arith.eq", eq) } fun offerAllTo(bindings: StackFrame) { - bindings.setValueLocal("if", ifFun) - bindings.setValueLocal("nil", LispData.LispNil) - bindings.setValueLocal("def", def) - bindings.setValueLocal("tostring", tostring) - bindings.setValueLocal("pure", pure) - bindings.setValueLocal("lambda", lambda) - bindings.setValueLocal("defun", defun) - bindings.setValueLocal("seq", seq) - bindings.setValueLocal("import", import) - bindings.setValueLocal("debuglog", debuglog) + bindings.setValueLocal("core.if", ifFun) + bindings.setValueLocal("core.nil", LispData.LispNil) + bindings.setValueLocal("core.def", def) + bindings.setValueLocal("core.tostring", tostring) + bindings.setValueLocal("core.pure", pure) + bindings.setValueLocal("core.lambda", lambda) + bindings.setValueLocal("core.defun", defun) + bindings.setValueLocal("core.seq", seq) + bindings.setValueLocal("core.import", import) + bindings.setValueLocal("core.reflect.type", reflect) + bindings.setValueLocal("core.debuglog", debuglog) offerArithmeticTo(bindings) } }
\ No newline at end of file diff --git a/test/res/scratch.lisp b/test/res/scratch.lisp new file mode 100644 index 0000000..3a1fa66 --- /dev/null +++ b/test/res/scratch.lisp @@ -0,0 +1,26 @@ +(debuglog "Hello, World, here is an atom:" :iamanatom) +(defun myfun (var) (debuglog var)) +(myfun :myfunworks) +((lambda (a) (debuglog a)) :atom) +(defun testlog (a ...) (seq + (debuglog "a" a) + (debuglog "..." ...))) +(testlog :test :work :whatever) +(def helloworld (pure "hello world")) +(debuglog helloworld (helloworld)) +(debuglog "+" (+ 1.2 15)) +(debuglog "-" (- 1 3)) +(debuglog "*" (* 10 10)) +(debuglog "/" (/ 1 3 2)) +(debuglog "============") +(defun testsomething (c) (debuglog (if! c (seq (debuglog "left evaluated") (return "truthy value")) "falsey value"))) +(testsomething true) +(testsomething false) +(noop) +(debuglog "============") +(debuglog "This should fail" sc) +(import :secondary) +(debuglog "This should work" sc) + +(debuglog "============") +(debuglog "Running tests") diff --git a/test/res/test.lisp b/test/res/test.lisp index 9def7f3..19594b3 100644 --- a/test/res/test.lisp +++ b/test/res/test.lisp @@ -1,40 +1,21 @@ -(debuglog "Hello, World, here is an atom:" :iamanatom) -(defun myfun (var) (debuglog var)) -(myfun :myfunworks) -((lambda (a) (debuglog a)) :atom) -(defun testlog (a ...) (seq - (debuglog "a" a) - (debuglog "..." ...))) -(testlog :test :work :whatever) -(def helloworld (pure "hello world")) -(debuglog helloworld (helloworld)) -(debuglog "+" (+ 1.2 15)) -(debuglog "-" (- 1 3)) -(debuglog "*" (* 10 10)) -(debuglog "/" (/ 1 3 2)) -(debuglog "============") -(defun testsomething (c) (debuglog (if! c (seq (debuglog "left evaluated") (return "truthy value")) "falsey value"))) -(testsomething true) -(testsomething false) -(noop) -(debuglog "============") -(debuglog "This should fail" sc) -(import :secondary) -(debuglog "This should work" sc) - -(debuglog "============") -(debuglog "Running tests") (import :test) -(test.test "unfunny test" (seq - (debuglog "Funny test not running") - ((test.assert-eq "unfunny" "funny")) -)) -(test.test "Test equality" (seq +(test.test "Identity equality" (seq ((test.assert-eq false false)) + ((test.assert-eq true true)))) + +(test.test "Not behaves correctly" (seq ((test.assert-eq (not false) true)) - ((test.assert-eq (not true) false)) + ((test.assert-eq (not true) false)))) + +(test.test "And behaves correctly" (seq ((test.assert-eq (& true true) true)) ((test.assert-eq (& true false) false)) ((test.assert-eq (& false true) false)) ((test.assert-eq (& false false) false)))) + +(test.test "Or behaves correctly" (seq + ((test.assert-eq (| true true) true)) + ((test.assert-eq (| true false) true)) + ((test.assert-eq (| false true) true)) + ((test.assert-eq (| false false) false)))) |