Move to prelude and add enough to run bf (with modifications)
This commit is contained in:
40
bf.kp
40
bf.kp
@@ -2,30 +2,30 @@
|
|||||||
; are our base building block. In order to make the
|
; are our base building block. In order to make the
|
||||||
; following BF implementation nice, let's add atoms!
|
; following BF implementation nice, let's add atoms!
|
||||||
; They will be implmented as length 1 vectors with nice syntax for deref
|
; They will be implmented as length 1 vectors with nice syntax for deref
|
||||||
(def! make-atom (fn* (x) [x]))
|
(fun make-atom (x) [x])
|
||||||
(def! set-atom! (fn* (x y) (set-nth! x 0 y)))
|
(fun set-atom! (x y) (set-idx! x 0 y))
|
||||||
(def! get-atom (fn* (x) (nth x 0)))
|
(fun get-atom (x) (idx x 0))
|
||||||
(add_grammar_rule 'form ["@" 'form] (fn* (_ x) `(get-atom ~x)))
|
(add_grammar_rule 'form ["@" 'form] (lambda (_ x) `(get-atom ~x)))
|
||||||
|
|
||||||
; Now begin by defining our BF syntax & semantics
|
; Now begin by defining our BF syntax & semantics
|
||||||
; Define our tokens as BF atoms
|
; Define our tokens as BF atoms
|
||||||
(add_grammar_rule 'bfs_atom ["<"] (fn* (_) '(set-atom! cursor (- @cursor 1))))
|
(add_grammar_rule 'bfs_atom ["<"] (lambda (_) '(set-atom! cursor (- @cursor 1))))
|
||||||
(add_grammar_rule 'bfs_atom [">"] (fn* (_) '(set-atom! cursor (+ @cursor 1))))
|
(add_grammar_rule 'bfs_atom [">"] (lambda (_) '(set-atom! cursor (+ @cursor 1))))
|
||||||
(add_grammar_rule 'bfs_atom ["\\+"] (fn* (_) '(set-nth! tape @cursor (+ (nth tape @cursor) 1))))
|
(add_grammar_rule 'bfs_atom ["\\+"] (lambda (_) '(set-idx! tape @cursor (+ (idx tape @cursor) 1))))
|
||||||
(add_grammar_rule 'bfs_atom ["-"] (fn* (_) '(set-nth! tape @cursor (- (nth tape @cursor) 1))))
|
(add_grammar_rule 'bfs_atom ["-"] (lambda (_) '(set-idx! tape @cursor (- (idx tape @cursor) 1))))
|
||||||
(add_grammar_rule 'bfs_atom [","] (fn* (_) '(let* (value (nth input @inptr))
|
(add_grammar_rule 'bfs_atom [","] (lambda (_) '(let (value (idx input @inptr))
|
||||||
(do (set-atom! inptr (+ 1 @inptr))
|
(do (set-atom! inptr (+ 1 @inptr))
|
||||||
(set-nth! tape @cursor value)))))
|
(set-idx! tape @cursor value)))))
|
||||||
(add_grammar_rule 'bfs_atom ["."] (fn* (_) '(set-atom! output (cons (nth tape @cursor) @output))))
|
(add_grammar_rule 'bfs_atom ["."] (lambda (_) '(set-atom! output (concat [(idx tape @cursor)] @output))))
|
||||||
|
|
||||||
; Define strings of BF atoms
|
; Define strings of BF atoms
|
||||||
(add_grammar_rule 'bfs ['bfs_atom *] (fn* (x) x))
|
(add_grammar_rule 'bfs ['bfs_atom *] (lambda (x) x))
|
||||||
|
|
||||||
; Add loop as an atom
|
; Add loop as an atom
|
||||||
; (note that closure cannot yet close over itself by value, so we pass it in)
|
; (note that closure cannot yet close over itself by value, so we pass it in)
|
||||||
(add_grammar_rule 'bfs_atom ["\\[" 'bfs "]"] (fn* (_ x _)
|
(add_grammar_rule 'bfs_atom ["\\[" 'bfs "]"] (lambda (_ x _)
|
||||||
`(let* (f (fn* (f)
|
`(let (f (lambda (f)
|
||||||
(if (= 0 (nth tape @cursor))
|
(if (= 0 (idx tape @cursor))
|
||||||
nil
|
nil
|
||||||
(do ,x (f f)))))
|
(do ,x (f f)))))
|
||||||
(f f))))
|
(f f))))
|
||||||
@@ -33,17 +33,17 @@
|
|||||||
; For now, stick BFS rule inside an unambigious BFS block
|
; For now, stick BFS rule inside an unambigious BFS block
|
||||||
; Also add setup code
|
; Also add setup code
|
||||||
(add_grammar_rule 'form ["bf" 'optional_WS "{" 'optional_WS 'bfs 'optional_WS "}"]
|
(add_grammar_rule 'form ["bf" 'optional_WS "{" 'optional_WS 'bfs 'optional_WS "}"]
|
||||||
(fn* (_ _ _ _ x _ _)
|
(lambda (_ _ _ _ x _ _)
|
||||||
`(fn* (input)
|
`(lambda (input)
|
||||||
(let* (
|
(let (
|
||||||
tape (vector 0 0 0 0 0)
|
tape (vector 0 0 0 0 0)
|
||||||
cursor (make-atom 0)
|
cursor (make-atom 0)
|
||||||
inptr (make-atom 0)
|
inptr (make-atom 0)
|
||||||
output (make-atom (vector))
|
output (make-atom (vector))
|
||||||
)
|
)
|
||||||
(do (println "beginning bfs") ,x (nth output 0))))))
|
(do (println "beginning bfs") ,x (idx output 0))))))
|
||||||
|
|
||||||
; Let's try it out! This BF program prints the input 3 times
|
; Let's try it out! This BF program prints the input 3 times
|
||||||
(println (bf { ,>+++[<.>-] } [1337]))
|
(println (bf { ,>+++[<.>-] } [1337]))
|
||||||
; we can also have it compile into our main program
|
; we can also have it compile into our main program
|
||||||
(def! main (fn* () (do (println "BF: " (bf { ,>+++[<.>-] } [1337])) 0)))
|
(fun main () (do (println "BF: " (bf { ,>+++[<.>-] } [1337])) 0))
|
||||||
|
|||||||
12
k_prime.krak
12
k_prime.krak
@@ -1416,18 +1416,8 @@ fun main(argc: int, argv: **char): int {
|
|||||||
}));
|
}));
|
||||||
|
|
||||||
// more self-implementation fun
|
// more self-implementation fun
|
||||||
println(rep(grammar, env, str("(set! current-env (vau de () de))")))
|
|
||||||
println(rep(grammar, env, str("(set! quote (vau _ (x) x))")))
|
|
||||||
println(rep(grammar, env, str("(add_grammar_rule (quote form) (quote ( \"'\" optional_WS form )) (vau de (_ _ f) (vector quote (eval f de))))"))) // '
|
|
||||||
println(rep(grammar, env, str("(add_grammar_rule 'form '( \"\\\\[\" optional_WS space_forms optional_WS \"\\\\]\" ) (vau de (_ _ fs _ _) (concat (vector vector) (eval fs de))))"))) // '
|
|
||||||
println(rep(grammar, env, str("(set! apply (vau de (f p ede) (eval (concat [(eval f de)] (eval p de)) (eval ede de))))")))
|
|
||||||
println(rep(grammar, env, str("(set! let1 (vau de (s v b) (eval [[vau '_ [s] b] (eval v de)] de)))")))
|
|
||||||
println(rep(grammar, env, str("(set! let (vau de (vs b) (cond (= (len vs) 0) (eval b de) true (apply let1 [(idx vs 0) (idx vs 1) [let (slice vs 2 -1) b]] de))))")))
|
|
||||||
|
|
||||||
println(rep(grammar, env, str("(set! lambda (vau se (p b) (let1 f (eval [vau '_ p b] se) (vau de (& op) (apply f (map (vau dde (ip) (eval (eval ip dde) de)) op) se)))))")))
|
|
||||||
|
|
||||||
println(rep(grammar, env, str("(set! fun (vau se (n p b) (eval [set! n [lambda p b]] se)))")))
|
|
||||||
println(rep(grammar, env, str("(set! load-file (vau de (f) (eval-read-string (slurp (eval f de)) de)))")))
|
println(rep(grammar, env, str("(set! load-file (vau de (f) (eval-read-string (slurp (eval f de)) de)))")))
|
||||||
|
println(rep(grammar, env, str("(load-file \"prelude.kp\")")))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
38
prelude.kp
Normal file
38
prelude.kp
Normal file
@@ -0,0 +1,38 @@
|
|||||||
|
|
||||||
|
(set! current-env (vau de () de))
|
||||||
|
(set! quote (vau _ (x) x))
|
||||||
|
|
||||||
|
(add_grammar_rule (quote form) (quote ( "'" optional_WS form )) (vau de (_ _ f) (vector quote (eval f de))))
|
||||||
|
(add_grammar_rule 'form '( "\\[" optional_WS space_forms optional_WS "\\]" ) (vau de (_ _ fs _ _) (concat (vector vector) (eval fs de))))
|
||||||
|
|
||||||
|
(set! apply (vau de (f p ede) (eval (concat [(eval f de)] (eval p de)) (eval ede de))))
|
||||||
|
(set! let1 (vau de (s v b) (eval [[vau '_ [s] b] (eval v de)] de)))
|
||||||
|
(set! let (vau de (vs b) (cond (= (len vs) 0) (eval b de) true (apply let1 [(idx vs 0) (idx vs 1) [let (slice vs 2 -1) b]] de))))
|
||||||
|
(set! lambda (vau se (p b) (let1 f (eval [vau '_ p b] se) (vau de (& op) (apply f (map (vau dde (ip) (eval (eval ip dde) de)) op) se)))))
|
||||||
|
(set! fun (vau se (n p b) (eval [set! n [lambda p b]] se)))
|
||||||
|
(set! if (vau de (con than & else) (cond
|
||||||
|
(eval con de) (eval than de)
|
||||||
|
(> (len else) 0) (eval (idx else 0) de)
|
||||||
|
true nil)))
|
||||||
|
(fun do (& params) (cond
|
||||||
|
(= 0 (len params)) nil
|
||||||
|
true (idx params (- (len params) 1))))
|
||||||
|
|
||||||
|
(fun print_through (x) (let (_ (println x)) x))
|
||||||
|
(fun is_pair? (x) (and (vector? x) (> (len x) 0)))
|
||||||
|
|
||||||
|
(set! quasiquote (vau de (x)
|
||||||
|
(cond (is_pair? x)
|
||||||
|
(cond (and (symbol? (idx x 0)) (= (get-text (idx x 0)) "unquote"))
|
||||||
|
(eval (idx x 1) de)
|
||||||
|
true
|
||||||
|
(cond (and (is_pair? (idx x 0)) (symbol? (idx (idx x 0) 0)) (= (get-text (idx (idx x 0) 0)) "splice-unquote"))
|
||||||
|
(concat (eval (idx (idx x 0) 1) de) (apply quasiquote [(slice x 1 -1)] de))
|
||||||
|
true
|
||||||
|
(concat [(apply quasiquote [(idx x 0)] de)] (apply quasiquote [(slice x 1 -1)] de))))
|
||||||
|
true x)))
|
||||||
|
|
||||||
|
(add_grammar_rule 'form '("`" optional_WS form) (lambda (_ _ f) ['quasiquote f]))
|
||||||
|
(add_grammar_rule 'form '("~" optional_WS form) (lambda (_ _ f) ['unquote f]))
|
||||||
|
(add_grammar_rule 'form '("," optional_WS form) (lambda (_ _ f) ['splice-unquote f]))
|
||||||
|
|
||||||
19
quasi.kp
19
quasi.kp
@@ -1,19 +0,0 @@
|
|||||||
(fun print_through (x) (let (_ (println x)) x))
|
|
||||||
|
|
||||||
(fun is_pair? (x) (and (vector? x) (> (len x) 0)))
|
|
||||||
|
|
||||||
(set! quasiquote (vau de (x)
|
|
||||||
(cond (is_pair? x)
|
|
||||||
(cond (and (symbol? (idx x 0)) (= (get-text (idx x 0)) "unquote"))
|
|
||||||
(eval (idx x 1) de)
|
|
||||||
true
|
|
||||||
(cond (and (is_pair? (idx x 0)) (symbol? (idx (idx x 0) 0)) (= (get-text (idx (idx x 0) 0)) "splice-unquote"))
|
|
||||||
(concat (eval (idx (idx x 0) 1) de) (apply quasiquote [(slice x 1 -1)] de))
|
|
||||||
true
|
|
||||||
(concat [(apply quasiquote [(idx x 0)] de)] (apply quasiquote [(slice x 1 -1)] de))))
|
|
||||||
true x)))
|
|
||||||
|
|
||||||
(add_grammar_rule 'form '("`" optional_WS form) (lambda (_ _ f) ['quasiquote f]))
|
|
||||||
(add_grammar_rule 'form '("~" optional_WS form) (lambda (_ _ f) ['unquote f]))
|
|
||||||
(add_grammar_rule 'form '("," optional_WS form) (lambda (_ _ f) ['splice-unquote f]))
|
|
||||||
|
|
||||||
Reference in New Issue
Block a user