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

Add vector, quote, and quasiquote syntax to new_kraken, and refactor types to use meta & new syntax

Browse Source
This commit is contained in:
Nathan Braswell
2020-10-20 22:59:21 -04:00
parent 371f39c82b
commit 85dbaae9de
2 changed files with 27 additions and 19 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
new_kraken.kp
View File

@@ -157,6 +157,13 @@
(array (quote form) (array (quote atom)) (lambda (x) x)) (array (quote form) (array (quote atom)) (lambda (x) x))
(array (quote form) (array "\\(" (quote WS) * "\\)" ) (lambda (_ _ _) (array))) (array (quote form) (array "\\(" (quote WS) * "\\)" ) (lambda (_ _ _) (array)))
(array (quote form) (array "\\(" (quote WS) * (quote form) (array (quote WS) + (quote form)) * (quote WS) * "\\)" ) (lambda (_ _ head tail _ _) (concat (array head) (map (lambda (x) (idx x 1)) tail)))) (array (quote form) (array "\\(" (quote WS) * (quote form) (array (quote WS) + (quote form)) * (quote WS) * "\\)" ) (lambda (_ _ head tail _ _) (concat (array head) (map (lambda (x) (idx x 1)) tail))))
(array (quote form) (array "\\[" (quote WS) * "\\]" ) (lambda (_ _ _) (array array)))
(array (quote form) (array "\\[" (quote WS) * (quote form) (array (quote WS) + (quote form)) * (quote WS) * "\\]" ) (lambda (_ _ head tail _ _) (concat (array array head) (map (lambda (x) (idx x 1)) tail))))
(array (quote form) (array "'" (quote WS) * (quote form)) (lambda (_ _ x) (array quote x)))
(array (quote form) (array "`" (quote WS) * (quote form)) (lambda (_ _ x) (array quasiquote x)))
(array (quote form) (array "~" (quote WS) * (quote form)) (lambda (_ _ x) (array (quote unquote) x)))
(array (quote form) (array "," (quote WS) * (quote form)) (lambda (_ _ x) (array (quote splice-unquote) x)))
(array (quote start_symbol) (array (quote WS) * (quote form) (quote WS) *) (lambda (_ f _) f)) (array (quote start_symbol) (array (quote WS) * (quote form) (quote WS) *) (lambda (_ f _) f))
(array (quote start_symbol) (array (quote WS) * "#lang" (quote WS) * (quote form) "[ -~]*") (lambda (_ _ _ gram source) (read-string source (eval (concat scope_let (array gram)) root_env) (quote start_symbol)))) (array (quote start_symbol) (array (quote WS) * "#lang" (quote WS) * (quote form) "[ -~]*") (lambda (_ _ _ gram source) (read-string source (eval (concat scope_let (array gram)) root_env) (quote start_symbol))))
) )

39
types.kp
View File

@@ -1,32 +1,33 @@
(let ( (let (
check_and_erase (lambda (x type) check_and_erase (lambda (x type)
(let (xe (x) (let (xe (x)
xi (idx xe 0) xt (meta xe))
xt (idx xe 1)) (if (= type xt) xe (println "\n\nType error, expected" type "but got" xt "\n\n")))
(if (= type xt) xi (println "\n\nType error, expected" type "but got" xt "\n\n")))
) )
add_one_impl (lambda (x) (+ x 1)) add_one_impl (lambda (x) (+ x 1))
stlc (array stlc [
(array (quote WS) (array "( | | [ 'WS [ "( | |
|(;[ -~]* |(;[ -~]*
))+") (lambda (x) nil)) ))+"] (lambda (x) nil)]
(array (quote stlc_expr) (array "-?[0-9]+") (lambda (x) (lambda () (array (read-string x) (quote int))))) [ 'stlc_expr '("-?[0-9]+") (lambda (x) (lambda () (with-meta (read-string x) 'int))) ]
(array (quote stlc_expr) (array "plus") (lambda (x) (lambda () (array + (quote (int int int)))))) [ 'stlc_expr '("plus") (lambda (x) (lambda () (with-meta + '(int int int)))) ]
(array (quote stlc_expr) (array "call" (quote WS) (quote stlc_expr) (quote WS) (quote stlc_expr) (quote WS) (quote stlc_expr)) (lambda (_ _ c _ a _ b) (lambda () (let ( [ 'stlc_expr '("call" WS stlc_expr WS stlc_expr WS stlc_expr)
ae (check_and_erase a (quote int)) (lambda (_ _ c _ a _ b) (lambda ()
be (check_and_erase b (quote int)) (let (
ce (check_and_erase c (quote (int int int))) ae (check_and_erase a 'int)
) be (check_and_erase b 'int)
(array (ce ae be) (quote int)) ce (check_and_erase c '(int int int))
)))) )
(array (quote stlc) (array (quote stlc_expr)) (lambda (x) (check_and_erase x (quote int)))) (with-meta [ce ae be] 'int)
) ))) ]
[ 'stlc '(stlc_expr) (lambda (x) (check_and_erase x 'int)) ]
]
our_expr "call 4 13 20" our_expr "call plus 13 20"
) )
(println "\n\nExpr evaluates to" (eval (read-string our_expr stlc (quote stlc))) "\n") (println "\n\nExpr evaluates to" (eval (read-string our_expr stlc 'stlc)) "\n")
) )