Add vector, quote, and quasiquote syntax to new_kraken, and refactor types to use meta & new syntax
This commit is contained in:
39
types.kp
39
types.kp
@@ -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")
|
||||
)
|
||||
|
||||
Reference in New Issue
Block a user