diff --git a/bf.kp b/bf.kp index ac5cf49..12bb47e 100644 --- a/bf.kp +++ b/bf.kp @@ -1,40 +1,37 @@ -; Use the power of GLL reader macros to implement -; BF support - -; Add atoms as length 1 vectors with nice syntax for deref +; We don't have atoms built in, mutable vectors +; are our base building block. In order to make the +; following BF implementation nice, let's add atoms! +; They will be implmented as length 1 vectors with nice syntax for deref (def! make-atom (fn* (x) [x])) (def! set-atom! (fn* (x y) (set-nth! x 0 y))) (def! get-atom (fn* (x) (nth x 0))) -(add_grammer_rule 'form ["@" 'form] (fn* (xs) `(get-atom ~(nth xs 1)))) +(add_grammer_rule 'form ["@" 'form] (fn* (_ x) `(get-atom ~x))) +; Now begin by defining our BF syntax & semantics ; Define our tokens as BF atoms -; Ugly b/c using 1-length vectors as atoms -(add_grammer_rule 'bfs_atom ["<"] (fn* (xs) '(set-atom! cursor (- @cursor 1)))) -(add_grammer_rule 'bfs_atom [">"] (fn* (xs) '(set-atom! cursor (+ @cursor 1)))) -(add_grammer_rule 'bfs_atom ["\\+"] (fn* (xs) '(set-nth! tape @cursor (+ (nth tape @cursor) 1)))) -(add_grammer_rule 'bfs_atom ["-"] (fn* (xs) '(set-nth! tape @cursor (- (nth tape @cursor) 1)))) -(add_grammer_rule 'bfs_atom [","] (fn* (xs) '(let* (value (nth input @inptr)) (do (set-atom! inptr (+ 1 @inptr)) (do (set-nth! tape @cursor value)))))) -(add_grammer_rule 'bfs_atom ["."] (fn* (xs) '(set-atom! output (cons (nth tape @cursor) @output)))) +(add_grammer_rule 'bfs_atom ["<"] (fn* (_) '(set-atom! cursor (- @cursor 1)))) +(add_grammer_rule 'bfs_atom [">"] (fn* (_) '(set-atom! cursor (+ @cursor 1)))) +(add_grammer_rule 'bfs_atom ["\\+"] (fn* (_) '(set-nth! tape @cursor (+ (nth tape @cursor) 1)))) +(add_grammer_rule 'bfs_atom ["-"] (fn* (_) '(set-nth! tape @cursor (- (nth tape @cursor) 1)))) +(add_grammer_rule 'bfs_atom [","] (fn* (_) '(let* (value (nth input @inptr)) (do (set-atom! inptr (+ 1 @inptr)) (do (set-nth! tape @cursor value)))))) +(add_grammer_rule 'bfs_atom ["."] (fn* (_) '(set-atom! output (cons (nth tape @cursor) @output)))) ; Define strings of BF atoms -(add_grammer_rule 'bfs ['bfs_atom *] (fn* (xs) (nth xs 0))) +(add_grammer_rule 'bfs ['bfs_atom *] (fn* (x) x)) ; Add loop as an atom -(add_grammer_rule 'bfs_atom ["\\[" 'bfs "]"] (fn* (xs) +; (note that closure cannot yet close over itself by value, so we pass it in) +(add_grammer_rule 'bfs_atom ["\\[" 'bfs "]"] (fn* (_ x _) `(let* (f (fn* (f) (if (= 0 (nth tape @cursor)) nil - (do ,(nth xs 1) (f f))))) + (do ,x (f f))))) (f f)))) ; For now, stick BFS rule inside an unambigious BFS block -; and add compilation/implementation -; Note that this compilation into the underlying Lisp -; happens at macro evaluation time. If this code were -; to be compiled to C, it would be compiled all the way -; to C code with no trace of the original BF code. +; Also add setup code (add_grammer_rule 'form ["bf" 'optional_WS "{" 'optional_WS 'bfs 'optional_WS "}"] - (fn* (xs) + (fn* (_ _ _ _ x _ _) `(fn* (input) (let* ( tape (vector 0 0 0 0 0) @@ -42,7 +39,7 @@ inptr (make-atom 0) output (make-atom (vector)) ) - (do (println "beginning bfs") ,(nth xs 4) (nth output 0)))))) + (do (println "beginning bfs") ,x (nth output 0)))))) ; Let's try it out! This BF program prints the input 3 times (println (bf { ,>+++[<.>-] } [1337])) diff --git a/k_prime.krak b/k_prime.krak index 6b8fdf8..16e9ab5 100644 --- a/k_prime.krak +++ b/k_prime.krak @@ -1301,7 +1301,7 @@ fun main(argc: int, argv: **char): int { } params.add(get_value(x[i])) } - return function_call(f, vec(malVector(params))) + return function_call(f, params) }) return MalResult::Ok(malNil()) } @@ -1357,16 +1357,16 @@ fun main(argc: int, argv: **char): int { } env->set(str("eval-read-string"), make_builtin_function(str("eval-read-string"), ERS)); // reader macros - rep(grammer, env, str("(add_grammer_rule (quote atom) (vector \"'\" (quote form)) (fn* (xs) (quasiquote (quote (unquote (nth xs 1))))))")) //' - rep(grammer, env, str("(add_grammer_rule 'form (vector \"\\\\[\" 'optional_WS \"\\\\]\") (fn* (xs) '(vector)))")) //' - rep(grammer, env, str("(add_grammer_rule 'form (vector \"\\\\[\" 'optional_WS 'space_forms 'optional_WS \"\\\\]\") (fn* (xs) (quasiquote (vector (splice-unquote (nth xs 2))))))")) //' + rep(grammer, env, str("(add_grammer_rule (quote atom) (vector \"'\" (quote form)) (fn* (_ x) (quasiquote (quote (unquote x)))))")) //' + rep(grammer, env, str("(add_grammer_rule 'form (vector \"\\\\[\" 'optional_WS \"\\\\]\") (fn* (& _) '(vector)))")) //' + rep(grammer, env, str("(add_grammer_rule 'form (vector \"\\\\[\" 'optional_WS 'space_forms 'optional_WS \"\\\\]\") (fn* (_ _ x _ _) (quasiquote (vector (splice-unquote x)))))")) //' // now we can use ' for the rest - rep(grammer, env, str("(add_grammer_rule 'atom [\"`\" 'form] (fn* (xs) (quasiquote (quasiquote (unquote (nth xs 1))))))")) - rep(grammer, env, str("(add_grammer_rule 'atom [\"~\" 'form] (fn* (xs) (vector (quote unquote) (nth xs 1))))")) + rep(grammer, env, str("(add_grammer_rule 'atom [\"`\" 'form] (fn* (_ x) (quasiquote (quasiquote (unquote x)))))")) + rep(grammer, env, str("(add_grammer_rule 'atom [\"~\" 'form] (fn* (_ x) (vector (quote unquote) x)))")) // the standard appears to be for splice-unquote to be , but unquote deref is a reasonable // sequence of characters and causes ambigious parses! So I chose the other common unquote symbol to be splice-unquote - rep(grammer, env, str("(add_grammer_rule 'atom [\",\" 'form] (fn* (xs) (vector (quote splice-unquote) (nth xs 1))))")) - rep(grammer, env, str("(add_grammer_rule 'atom [\"@\" 'form] (fn* (xs) `(deref ~(nth xs 1))))")) //" + rep(grammer, env, str("(add_grammer_rule 'atom [\",\" 'form] (fn* (_ x) (vector (quote splice-unquote) x)))")) + rep(grammer, env, str("(add_grammer_rule 'atom [\"@\" 'form] (fn* (_ x) `(deref ~x)))")) //" rep(grammer, env, str("(def! not (fn* (a) (if a false true)))")) rep(grammer, env, str("(def! load-file (fn* (f) (eval-read-string (slurp f))))")) diff --git a/method.kp b/method.kp index 2fefb70..2fd850a 100644 --- a/method.kp +++ b/method.kp @@ -8,7 +8,7 @@ (println "no method " method) (apply method_fn object arguments))))) ; method call syntax -(add_grammer_rule 'form [ 'form "\\." 'atom 'optional_WS "\\(" 'optional_WS 'space_forms 'optional_WS "\\)" ] (fn* (xs) `(method-call ~(nth xs 0) '~(nth xs 2) ,(nth xs 6)))) +(add_grammer_rule 'form [ 'form "\\." 'atom 'optional_WS "\\(" 'optional_WS 'space_forms 'optional_WS "\\)" ] (fn* (o _ m _ _ _ p _ _) `(method-call ~o '~m ,p))) (def! actual_obj (with-meta [0] [ 'inc (fn* (o) (set-nth! o 0 (+ (nth o 0) 1))) 'dec (fn* (o) (set-nth! o 0 (- (nth o 0) 1)))