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

BF implementation as GLL macros

Browse Source
This commit is contained in:
Nathan Braswell
2020-04-10 22:46:53 -04:00
parent 256006f1c6
commit 7bc58e904e
2 changed files with 60 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

54
bf.kp Normal file
View File

@@ -0,0 +1,54 @@
; Now we have native BF support
(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 'plus)))
(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 '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 :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 [:non_empty_bfs_list] (fn* [xs] (nth xs 0)))
(add_grammer_rule :bfs_atom ["\\[" :bfs_list "]"] (fn* [xs]
`(let* (f (fn* [f]
(if (= 0 (nth (deref arr) (deref ptr)))
nil
(do ,(nth xs 1) (f f)))))
(f f))))
(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 "}"]
(fn* [xs]
`(fn* [input]
(let* (
;arr (atom [0 0 0 0 0])
arr (atom (vector 0 0 0 0 0))
output (atom [])
ptr (atom 0)
inptr (atom 0)
left (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)))))
minus (fn* [] (swap! arr (fn* [old] (with_update old (deref ptr) (- (nth (deref arr) (deref ptr)) 1)))))
in (fn* [] (let* (
h (nth input (deref inptr))
_ (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))))
)
(do ,(nth xs 1) (deref output))
)
)
)
)
(println (bf{,>+++[<.>-]} [1337]))

8
k_prime.krak
View File

@@ -540,7 +540,7 @@ fun function_call(f: MalValue, params: vec<MalValue>): MalResult {
return EVAL(call_pair.first, get_value(call_pair.second))
}
}
return MalResult::Err(MalValue::String(str("trying to apply not a function")))
return MalResult::Err(MalValue::String(str("trying to apply not a function: ") + pr_str(f ,true)))
}
adt MalResult {
@@ -899,7 +899,7 @@ fun EVAL(env: *Env, ast: MalValue): MalResult {
continue
}
}
return MalResult::Err(MalValue::String(str("trying to call not a function")))
return MalResult::Err(MalValue::String(str("trying to call not a function:") + pr_str(to_call[0], true)))
}
}
}
@@ -1005,6 +1005,9 @@ fun main(argc: int, argv: **char): int {
return MalResult::Ok(MalValue::List(vec(get_value(x[0])) + get_list(get_value(x[2]))))
})
grammer.add_to_nonterminal(form, vec(grammer.add_terminal("\\(", MalValue::Nil(), ret_nil_term),
optional_WS,
grammer.add_terminal("\\)", MalValue::Nil(), ret_nil_term)), MalValue::Nil(), fun(_: ref MalValue, x: ref vec<MalResult>): MalResult { return MalResult::Ok(MalValue::Vector(vec<MalValue>())); })
grammer.add_to_nonterminal(form, vec(grammer.add_terminal("\\(", MalValue::Nil(), ret_nil_term),
optional_WS,
space_forms,
@@ -1593,6 +1596,7 @@ fun main(argc: int, argv: **char): int {
if is_err(r.second) {
return r.second
}
/*println("here '" + pr_str(get_value(r.second), true) + "'")*/
current_ret = EVAL(env, get_value(r.second))
if is_err(current_ret) {
return current_ret