miloignis/kraken
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

reformat

Browse Source
This commit is contained in:
Nathan Braswell
2020-04-10 23:08:31 -04:00
parent 721dc203be
commit 7a6a1e0d82
1 changed files with 18 additions and 22 deletions
Download Patch File Download Diff File Expand all files Collapse all files

40
bf.kp
View File

@@ -1,29 +1,33 @@
; Now we have native BF support ; Now we have native BF support
(def! with_update (fn* [arr idx val]
(if
(= idx 0)
(cons val (rest arr))
(cons (first arr) (with_update (rest arr) (- idx 1) val)))))
(add_grammer_rule :bfs_atom ["<"] (fn* [xs] (list 'left))) (add_grammer_rule :bfs_atom ["<"] (fn* [xs] (list 'left)))
(add_grammer_rule :bfs_atom [">"] (fn* [xs] (list 'right))) (add_grammer_rule :bfs_atom [">"] (fn* [xs] (list 'right)))
(add_grammer_rule :bfs_atom ["\\+"] (fn* [xs] (list 'plus))) (add_grammer_rule :bfs_atom ["\\+"] (fn* [xs] (list 'plus)))
(add_grammer_rule :bfs_atom ["-"] (fn* [xs] (list 'minus))) (add_grammer_rule :bfs_atom ["-"] (fn* [xs] (list 'minus)))
(add_grammer_rule :bfs_atom [","] (fn* [xs] (list 'in))) (add_grammer_rule :bfs_atom [","] (fn* [xs] (list 'in)))
(add_grammer_rule :bfs_atom ["."] (fn* [xs] (list 'out))) (add_grammer_rule :bfs_atom ["."] (fn* [xs] (list 'out)))
(add_grammer_rule :non_empty_bfs_list [:bfs_atom] (fn* [xs] (list (nth xs 0)))) (add_grammer_rule :non_empty_bfs_list [:bfs_atom] (fn* [xs] (list (nth xs 0))))
(add_grammer_rule :non_empty_bfs_list [:bfs_atom :optional_WS :non_empty_bfs_list] (fn* [xs] (cons (nth xs 0) (nth xs 2)))) (add_grammer_rule :non_empty_bfs_list [:bfs_atom :optional_WS :non_empty_bfs_list] (fn* [xs] (cons (nth xs 0) (nth xs 2))))
(add_grammer_rule :bfs_list [] (fn* [xs] xs)) (add_grammer_rule :bfs_list [] (fn* [xs] xs))
(add_grammer_rule :bfs_list [:non_empty_bfs_list] (fn* [xs] (nth xs 0))) (add_grammer_rule :bfs_list [:non_empty_bfs_list] (fn* [xs] (nth xs 0)))
(add_grammer_rule :bfs_atom ["\\[" :bfs_list "]"] (fn* [xs] (add_grammer_rule :bfs_atom ["\\[" :bfs_list "]"] (fn* [xs]
`(let* (f (fn* [] `(let* (f (fn* []
(if (= 0 (nth (deref arr) (deref ptr))) (if (= 0 (nth (deref arr) (deref ptr)))
nil nil
(do ,(nth xs 1) (f))))) (do ,(nth xs 1) (f)))))
(f)))) (f))))
(add_grammer_rule :bfs [:bfs_list] (fn* [xs] (nth xs 0))) (add_grammer_rule :bfs [:bfs_list] (fn* [xs] (nth xs 0)))
(def! with_update (fn* [arr idx val]
(if
(= idx 0)
(cons val (rest arr))
(cons (first arr) (with_update (rest arr) (- idx 1) val))
)
)
)
(add_grammer_rule :form ["bf{" :bfs "}"] (add_grammer_rule :form ["bf{" :bfs "}"]
(fn* [xs] (fn* [xs]
`(fn* [input] `(fn* [input]
@@ -37,18 +41,10 @@
right (fn* [] (swap! ptr (fn* [old] (+ old 1)))) right (fn* [] (swap! ptr (fn* [old] (+ old 1))))
plus (fn* [] (swap! arr (fn* [old] (with_update old (deref ptr) (+ (nth (deref arr) (deref ptr)) 1))))) plus (fn* [] (swap! arr (fn* [old] (with_update old (deref ptr) (+ (nth (deref arr) (deref ptr)) 1)))))
minus (fn* [] (swap! arr (fn* [old] (with_update old (deref ptr) (- (nth (deref arr) (deref ptr)) 1))))) minus (fn* [] (swap! arr (fn* [old] (with_update old (deref ptr) (- (nth (deref arr) (deref ptr)) 1)))))
in (fn* [] (let* ( in (fn* [] (let* ( h (nth input (deref inptr))
h (nth input (deref inptr)) _ (swap! inptr (fn* [old] (+ old 1))))
_ (swap! inptr (fn* [old] (+ old 1))) (swap! arr (fn* [old] (with_update old (deref ptr) h)))))
) out (fn* [] (swap! output (fn* [old] (cons (nth (deref arr) (deref ptr)) old)))))
(swap! arr (fn* [old] (with_update old (deref ptr) h))) (do ,(nth xs 1) (deref output))))))
)
)
out (fn* [] (swap! output (fn* [old] (cons (nth (deref arr) (deref ptr)) old))))
)
(do ,(nth xs 1) (deref output))
)
)
)
)
(println (bf{,>+++[<.>-]} [1337])) (println (bf{,>+++[<.>-]} [1337]))