From 8e296d57c8d90cfd9d0824851db4f7204110bb93 Mon Sep 17 00:00:00 2001 From: Nathan Braswell Date: Tue, 12 May 2020 09:19:01 -0400 Subject: [PATCH] Add atom syntax --- bf.kp | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/bf.kp b/bf.kp index 7539c1b..ac5cf49 100644 --- a/bf.kp +++ b/bf.kp @@ -1,19 +1,20 @@ ; Use the power of GLL reader macros to implement ; BF support -; Add atoms as length 1 vectors +; Add atoms 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)))) ; 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 (- (get-atom cursor) 1)))) -(add_grammer_rule 'bfs_atom [">"] (fn* (xs) '(set-atom! cursor (+ (get-atom cursor) 1)))) -(add_grammer_rule 'bfs_atom ["\\+"] (fn* (xs) '(set-nth! tape (get-atom cursor) (+ (nth tape (get-atom cursor)) 1)))) -(add_grammer_rule 'bfs_atom ["-"] (fn* (xs) '(set-nth! tape (get-atom cursor) (- (nth tape (get-atom cursor)) 1)))) -(add_grammer_rule 'bfs_atom [","] (fn* (xs) '(let* (value (nth input (get-atom inptr))) (do (set-atom! inptr (+ 1 (get-atom inptr))) (do (set-nth! tape (get-atom cursor) value)))))) -(add_grammer_rule 'bfs_atom ["."] (fn* (xs) '(set-atom! output (cons (nth tape (get-atom cursor)) (get-atom output))))) +(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)))) ; Define strings of BF atoms (add_grammer_rule 'bfs ['bfs_atom *] (fn* (xs) (nth xs 0))) @@ -21,7 +22,7 @@ ; Add loop as an atom (add_grammer_rule 'bfs_atom ["\\[" 'bfs "]"] (fn* (xs) `(let* (f (fn* (f) - (if (= 0 (nth tape (get-atom cursor))) + (if (= 0 (nth tape @cursor)) nil (do ,(nth xs 1) (f f))))) (f f))))