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

Pass inputs to grammer callbacks as individual parameters

Browse Source
This commit is contained in:
Nathan Braswell
2020-05-12 09:33:33 -04:00
parent 8e296d57c8
commit dac3e41101
3 changed files with 28 additions and 31 deletions
Download Patch File Download Diff File Expand all files Collapse all files

41
bf.kp
View File

@@ -1,40 +1,37 @@
; Use the power of GLL reader macros to implement
; BF support
; Add atoms as length 1 vectors with nice syntax for deref
; 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* (xs) `(get-atom ~(nth xs 1))))
(add_grammer_rule 'form ["@" 'form] (fn* (_ x) `(get-atom ~x)))
; Now begin by defining our BF syntax & semantics
; 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 (- @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))))
(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* (xs) (nth xs 0)))
(add_grammer_rule 'bfs ['bfs_atom *] (fn* (x) x))
; Add loop as an atom
(add_grammer_rule 'bfs_atom ["\\[" 'bfs "]"] (fn* (xs)
; (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 ,(nth xs 1) (f f)))))
(do ,x (f f)))))
(f f))))
; 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.
; Also add setup code
(add_grammer_rule 'form ["bf" 'optional_WS "{" 'optional_WS 'bfs 'optional_WS "}"]
(fn* (xs)
(fn* (_ _ _ _ x _ _)
`(fn* (input)
(let* (
tape (vector 0 0 0 0 0)
@@ -42,7 +39,7 @@
inptr (make-atom 0)
output (make-atom (vector))
)
(do (println "beginning bfs") ,(nth xs 4) (nth output 0))))))
(do (println "beginning bfs") ,x (nth output 0))))))
; Let's try it out! This BF program prints the input 3 times
(println (bf { ,>+++[<.>-] } [1337]))

16
k_prime.krak
View File

@@ -1301,7 +1301,7 @@ fun main(argc: int, argv: **char): int {
}
params.add(get_value(x[i]))
}
return function_call(f, vec(malVector(params)))
return function_call(f, params)
})
return MalResult::Ok(malNil())
}
@@ -1357,16 +1357,16 @@ fun main(argc: int, argv: **char): int {
}
env->set(str("eval-read-string"), make_builtin_function(str("eval-read-string"), ERS));
// reader macros
rep(grammer, env, str("(add_grammer_rule (quote atom) (vector \"'\" (quote form)) (fn* (xs) (quasiquote (quote (unquote (nth xs 1))))))")) //'
rep(grammer, env, str("(add_grammer_rule 'form (vector \"\\\\[\" 'optional_WS \"\\\\]\") (fn* (xs) '(vector)))")) //'
rep(grammer, env, str("(add_grammer_rule 'form (vector \"\\\\[\" 'optional_WS 'space_forms 'optional_WS \"\\\\]\") (fn* (xs) (quasiquote (vector (splice-unquote (nth xs 2))))))")) //'
rep(grammer, env, str("(add_grammer_rule (quote atom) (vector \"'\" (quote form)) (fn* (_ x) (quasiquote (quote (unquote x)))))")) //'
rep(grammer, env, str("(add_grammer_rule 'form (vector \"\\\\[\" 'optional_WS \"\\\\]\") (fn* (& _) '(vector)))")) //'
rep(grammer, env, str("(add_grammer_rule 'form (vector \"\\\\[\" 'optional_WS 'space_forms 'optional_WS \"\\\\]\") (fn* (_ _ x _ _) (quasiquote (vector (splice-unquote x)))))")) //'
// now we can use ' for the rest
rep(grammer, env, str("(add_grammer_rule 'atom [\"`\" 'form] (fn* (xs) (quasiquote (quasiquote (unquote (nth xs 1))))))"))
rep(grammer, env, str("(add_grammer_rule 'atom [\"~\" 'form] (fn* (xs) (vector (quote unquote) (nth xs 1))))"))
rep(grammer, env, str("(add_grammer_rule 'atom [\"`\" 'form] (fn* (_ x) (quasiquote (quasiquote (unquote x)))))"))
rep(grammer, env, str("(add_grammer_rule 'atom [\"~\" 'form] (fn* (_ x) (vector (quote unquote) x)))"))
// the standard appears to be for splice-unquote to be <symbol-for-unqoute><symbol-for-deref>, but unquote deref is a reasonable
// sequence of characters and causes ambigious parses! So I chose the other common unquote symbol to be splice-unquote
rep(grammer, env, str("(add_grammer_rule 'atom [\",\" 'form] (fn* (xs) (vector (quote splice-unquote) (nth xs 1))))"))
rep(grammer, env, str("(add_grammer_rule 'atom [\"@\" 'form] (fn* (xs) `(deref ~(nth xs 1))))")) //"
rep(grammer, env, str("(add_grammer_rule 'atom [\",\" 'form] (fn* (_ x) (vector (quote splice-unquote) x)))"))
rep(grammer, env, str("(add_grammer_rule 'atom [\"@\" 'form] (fn* (_ x) `(deref ~x)))")) //"
rep(grammer, env, str("(def! not (fn* (a) (if a false true)))"))
rep(grammer, env, str("(def! load-file (fn* (f) (eval-read-string (slurp f))))"))

2
method.kp
View File

@@ -8,7 +8,7 @@
(println "no method " method)
(apply method_fn object arguments)))))
; method call syntax
(add_grammer_rule 'form [ 'form "\\." 'atom 'optional_WS "\\(" 'optional_WS 'space_forms 'optional_WS "\\)" ] (fn* (xs) `(method-call ~(nth xs 0) '~(nth xs 2) ,(nth xs 6))))
(add_grammer_rule 'form [ 'form "\\." 'atom 'optional_WS "\\(" 'optional_WS 'space_forms 'optional_WS "\\)" ] (fn* (o _ m _ _ _ p _ _) `(method-call ~o '~m ,p)))
(def! actual_obj (with-meta [0] [
'inc (fn* (o) (set-nth! o 0 (+ (nth o 0) 1)))
'dec (fn* (o) (set-nth! o 0 (- (nth o 0) 1)))