kraken/bf.kp

; Use the power of GLL reader macros to implement
; BF support

; Define our tokens as BF atoms
; Ugly b/c using 1-length vectors as atoms
(add_grammer_rule 'bfs_atom ["<"]   (fn* (xs) '(set-nth! cursor 0 (- (nth cursor 0) 1))))
(add_grammer_rule 'bfs_atom [">"]   (fn* (xs) '(set-nth! cursor 0 (+ (nth cursor 0) 1))))
(add_grammer_rule 'bfs_atom ["\\+"] (fn* (xs) '(set-nth! tape (nth cursor 0) (+ (nth tape (nth cursor 0)) 1))))
(add_grammer_rule 'bfs_atom ["-"]   (fn* (xs) '(set-nth! tape (nth cursor 0) (- (nth tape (nth cursor 0)) 1))))
(add_grammer_rule 'bfs_atom [","]   (fn* (xs) '(let* (value (nth input (nth inptr 0))) (do (set-nth! inptr 0 (+ 1 (nth inptr 0))) (do (set-nth! tape (nth cursor 0) value))))))
(add_grammer_rule 'bfs_atom ["."]   (fn* (xs) '(set-nth! output 0 (cons (nth tape (nth cursor 0)) (nth output 0)))))

; Define strings of BF atoms
(add_grammer_rule 'bfs_list ['bfs_atom +] (fn* (xs) (nth xs 0)))

; Add loop as an atom
(add_grammer_rule 'bfs_atom ["\\[" 'bfs_list "]"] (fn* (xs)
                `(let* (f (fn* (f)
                                (if (= 0 (nth tape (nth cursor 0)))
                                    nil
                                    (do ,(nth xs 1) (f f)))))
                       (f f))))

; Top level BFS rule
(add_grammer_rule 'bfs ['bfs_list] (fn* (xs) (nth xs 0)))

; 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.
(add_grammer_rule 'form ["bf" 'optional_WS "{" 'optional_WS 'bfs 'optional_WS "}"]
                        (fn* (xs)
                           `(fn* (input)
                             (let* (
                                    tape   (vector 0 0 0 0 0)
                                    cursor (vector 0)
                                    inptr  (vector 0)
                                    output (vector (vector))
                                    )
                                (do (println "beginning bfs") ,(nth xs 4) (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)))