kraken/bf.kp

; 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* (_ x) `(get-atom ~x)))

; Now begin by defining our BF syntax & semantics
; Define our tokens as BF atoms
(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* (x) x))

; Add loop as an atom
; (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 ,x (f f)))))
                       (f f))))

; For now, stick BFS rule inside an unambigious BFS block
; Also add setup code
(add_grammer_rule 'form ["bf" 'optional_WS "{" 'optional_WS 'bfs 'optional_WS "}"]
                        (fn* (_ _ _ _ x _ _)
                           `(fn* (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))))))

; 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)))