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 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) * "\\]" ) (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) * "#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 (
check_and_erase (lambda (x type)
(let (xe (x)
xi (idx xe 0)
xt (idx xe 1))
(if (= type xt) xi (println "\n\nType error, expected" type "but got" xt "\n\n")))
xt (meta xe))
(if (= type xt) xe (println "\n\nType error, expected" type "but got" xt "\n\n")))
)
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)))))
(array (quote stlc_expr) (array "plus") (lambda (x) (lambda () (array + (quote (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 (
ae (check_and_erase a (quote int))
be (check_and_erase b (quote int))
ce (check_and_erase c (quote (int int int)))
)
(array (ce ae be) (quote int))
))))
(array (quote stlc) (array (quote stlc_expr)) (lambda (x) (check_and_erase x (quote int))))
)
[ 'stlc_expr '("-?[0-9]+") (lambda (x) (lambda () (with-meta (read-string x) 'int))) ]
[ 'stlc_expr '("plus") (lambda (x) (lambda () (with-meta + '(int int int)))) ]
[ 'stlc_expr '("call" WS stlc_expr WS stlc_expr WS stlc_expr)
(lambda (_ _ c _ a _ b) (lambda ()
(let (
ae (check_and_erase a 'int)
be (check_and_erase b 'int)
ce (check_and_erase c '(int int 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")
)