diff --git a/bf.kp b/bf.kp index f6bc828..f310173 100644 --- a/bf.kp +++ b/bf.kp @@ -2,30 +2,30 @@ ; 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_grammar_rule 'form ["@" 'form] (fn* (_ x) `(get-atom ~x))) +(fun make-atom (x) [x]) +(fun set-atom! (x y) (set-idx! x 0 y)) +(fun get-atom (x) (idx x 0)) +(add_grammar_rule 'form ["@" 'form] (lambda (_ x) `(get-atom ~x))) ; Now begin by defining our BF syntax & semantics ; Define our tokens as BF atoms -(add_grammar_rule 'bfs_atom ["<"] (fn* (_) '(set-atom! cursor (- @cursor 1)))) -(add_grammar_rule 'bfs_atom [">"] (fn* (_) '(set-atom! cursor (+ @cursor 1)))) -(add_grammar_rule 'bfs_atom ["\\+"] (fn* (_) '(set-nth! tape @cursor (+ (nth tape @cursor) 1)))) -(add_grammar_rule 'bfs_atom ["-"] (fn* (_) '(set-nth! tape @cursor (- (nth tape @cursor) 1)))) -(add_grammar_rule 'bfs_atom [","] (fn* (_) '(let* (value (nth input @inptr)) - (do (set-atom! inptr (+ 1 @inptr)) - (set-nth! tape @cursor value))))) -(add_grammar_rule 'bfs_atom ["."] (fn* (_) '(set-atom! output (cons (nth tape @cursor) @output)))) +(add_grammar_rule 'bfs_atom ["<"] (lambda (_) '(set-atom! cursor (- @cursor 1)))) +(add_grammar_rule 'bfs_atom [">"] (lambda (_) '(set-atom! cursor (+ @cursor 1)))) +(add_grammar_rule 'bfs_atom ["\\+"] (lambda (_) '(set-idx! tape @cursor (+ (idx tape @cursor) 1)))) +(add_grammar_rule 'bfs_atom ["-"] (lambda (_) '(set-idx! tape @cursor (- (idx tape @cursor) 1)))) +(add_grammar_rule 'bfs_atom [","] (lambda (_) '(let (value (idx input @inptr)) + (do (set-atom! inptr (+ 1 @inptr)) + (set-idx! tape @cursor value))))) +(add_grammar_rule 'bfs_atom ["."] (lambda (_) '(set-atom! output (concat [(idx tape @cursor)] @output)))) ; Define strings of BF atoms -(add_grammar_rule 'bfs ['bfs_atom *] (fn* (x) x)) +(add_grammar_rule 'bfs ['bfs_atom *] (lambda (x) x)) ; Add loop as an atom ; (note that closure cannot yet close over itself by value, so we pass it in) -(add_grammar_rule 'bfs_atom ["\\[" 'bfs "]"] (fn* (_ x _) - `(let* (f (fn* (f) - (if (= 0 (nth tape @cursor)) +(add_grammar_rule 'bfs_atom ["\\[" 'bfs "]"] (lambda (_ x _) + `(let (f (lambda (f) + (if (= 0 (idx tape @cursor)) nil (do ,x (f f))))) (f f)))) @@ -33,17 +33,17 @@ ; For now, stick BFS rule inside an unambigious BFS block ; Also add setup code (add_grammar_rule 'form ["bf" 'optional_WS "{" 'optional_WS 'bfs 'optional_WS "}"] - (fn* (_ _ _ _ x _ _) - `(fn* (input) - (let* ( + (lambda (_ _ _ _ x _ _) + `(lambda (input) + (let ( tape (vector 0 0 0 0 0) cursor (make-atom 0) inptr (make-atom 0) output (make-atom (vector)) ) - (do (println "beginning bfs") ,x (nth output 0)))))) + (do (println "beginning bfs") ,x (idx output 0)))))) ; Let's try it out! This BF program prints the input 3 times (println (bf { ,>+++[<.>-] } [1337])) ; we can also have it compile into our main program -(def! main (fn* () (do (println "BF: " (bf { ,>+++[<.>-] } [1337])) 0))) +(fun main () (do (println "BF: " (bf { ,>+++[<.>-] } [1337])) 0)) diff --git a/k_prime.krak b/k_prime.krak index 951fa33..9f531f5 100644 --- a/k_prime.krak +++ b/k_prime.krak @@ -1416,18 +1416,8 @@ fun main(argc: int, argv: **char): int { })); // more self-implementation fun - println(rep(grammar, env, str("(set! current-env (vau de () de))"))) - println(rep(grammar, env, str("(set! quote (vau _ (x) x))"))) - println(rep(grammar, env, str("(add_grammar_rule (quote form) (quote ( \"'\" optional_WS form )) (vau de (_ _ f) (vector quote (eval f de))))"))) // ' - println(rep(grammar, env, str("(add_grammar_rule 'form '( \"\\\\[\" optional_WS space_forms optional_WS \"\\\\]\" ) (vau de (_ _ fs _ _) (concat (vector vector) (eval fs de))))"))) // ' - println(rep(grammar, env, str("(set! apply (vau de (f p ede) (eval (concat [(eval f de)] (eval p de)) (eval ede de))))"))) - println(rep(grammar, env, str("(set! let1 (vau de (s v b) (eval [[vau '_ [s] b] (eval v de)] de)))"))) - println(rep(grammar, env, str("(set! let (vau de (vs b) (cond (= (len vs) 0) (eval b de) true (apply let1 [(idx vs 0) (idx vs 1) [let (slice vs 2 -1) b]] de))))"))) - - println(rep(grammar, env, str("(set! lambda (vau se (p b) (let1 f (eval [vau '_ p b] se) (vau de (& op) (apply f (map (vau dde (ip) (eval (eval ip dde) de)) op) se)))))"))) - - println(rep(grammar, env, str("(set! fun (vau se (n p b) (eval [set! n [lambda p b]] se)))"))) println(rep(grammar, env, str("(set! load-file (vau de (f) (eval-read-string (slurp (eval f de)) de)))"))) + println(rep(grammar, env, str("(load-file \"prelude.kp\")"))) diff --git a/prelude.kp b/prelude.kp new file mode 100644 index 0000000..b63f00e --- /dev/null +++ b/prelude.kp @@ -0,0 +1,38 @@ + +(set! current-env (vau de () de)) +(set! quote (vau _ (x) x)) + +(add_grammar_rule (quote form) (quote ( "'" optional_WS form )) (vau de (_ _ f) (vector quote (eval f de)))) +(add_grammar_rule 'form '( "\\[" optional_WS space_forms optional_WS "\\]" ) (vau de (_ _ fs _ _) (concat (vector vector) (eval fs de)))) + +(set! apply (vau de (f p ede) (eval (concat [(eval f de)] (eval p de)) (eval ede de)))) +(set! let1 (vau de (s v b) (eval [[vau '_ [s] b] (eval v de)] de))) +(set! let (vau de (vs b) (cond (= (len vs) 0) (eval b de) true (apply let1 [(idx vs 0) (idx vs 1) [let (slice vs 2 -1) b]] de)))) +(set! lambda (vau se (p b) (let1 f (eval [vau '_ p b] se) (vau de (& op) (apply f (map (vau dde (ip) (eval (eval ip dde) de)) op) se))))) +(set! fun (vau se (n p b) (eval [set! n [lambda p b]] se))) +(set! if (vau de (con than & else) (cond + (eval con de) (eval than de) + (> (len else) 0) (eval (idx else 0) de) + true nil))) +(fun do (& params) (cond + (= 0 (len params)) nil + true (idx params (- (len params) 1)))) + +(fun print_through (x) (let (_ (println x)) x)) +(fun is_pair? (x) (and (vector? x) (> (len x) 0))) + +(set! quasiquote (vau de (x) + (cond (is_pair? x) + (cond (and (symbol? (idx x 0)) (= (get-text (idx x 0)) "unquote")) + (eval (idx x 1) de) + true + (cond (and (is_pair? (idx x 0)) (symbol? (idx (idx x 0) 0)) (= (get-text (idx (idx x 0) 0)) "splice-unquote")) + (concat (eval (idx (idx x 0) 1) de) (apply quasiquote [(slice x 1 -1)] de)) + true + (concat [(apply quasiquote [(idx x 0)] de)] (apply quasiquote [(slice x 1 -1)] de)))) + true x))) + +(add_grammar_rule 'form '("`" optional_WS form) (lambda (_ _ f) ['quasiquote f])) +(add_grammar_rule 'form '("~" optional_WS form) (lambda (_ _ f) ['unquote f])) +(add_grammar_rule 'form '("," optional_WS form) (lambda (_ _ f) ['splice-unquote f])) + diff --git a/quasi.kp b/quasi.kp deleted file mode 100644 index 21c53fc..0000000 --- a/quasi.kp +++ /dev/null @@ -1,19 +0,0 @@ -(fun print_through (x) (let (_ (println x)) x)) - -(fun is_pair? (x) (and (vector? x) (> (len x) 0))) - -(set! quasiquote (vau de (x) - (cond (is_pair? x) - (cond (and (symbol? (idx x 0)) (= (get-text (idx x 0)) "unquote")) - (eval (idx x 1) de) - true - (cond (and (is_pair? (idx x 0)) (symbol? (idx (idx x 0) 0)) (= (get-text (idx (idx x 0) 0)) "splice-unquote")) - (concat (eval (idx (idx x 0) 1) de) (apply quasiquote [(slice x 1 -1)] de)) - true - (concat [(apply quasiquote [(idx x 0)] de)] (apply quasiquote [(slice x 1 -1)] de)))) - true x))) - -(add_grammar_rule 'form '("`" optional_WS form) (lambda (_ _ f) ['quasiquote f])) -(add_grammar_rule 'form '("~" optional_WS form) (lambda (_ _ f) ['unquote f])) -(add_grammar_rule 'form '("," optional_WS form) (lambda (_ _ f) ['splice-unquote f])) -