78 lines
4.1 KiB
Plaintext
78 lines
4.1 KiB
Plaintext
|
|
((wrap (vau root_env (quote)
|
|
((wrap (vau _ (let1)
|
|
|
|
(let1 lambda (vau se (p b) (wrap (eval (array vau (quote _) p b) se)))
|
|
|
|
(let1 do_helper (lambda (recurse s i se) (cond (= i (len s)) nil
|
|
(= i (- (len s) 1)) (eval (idx s i) se)
|
|
(eval (idx s i) se) (recurse recurse s (+ i 1) se)
|
|
true (recurse recurse s (+ i 1) se)))
|
|
(let1 do (vau se (& s) (do_helper do_helper s 0 se))
|
|
|
|
(let1 concat_helper (lambda (recurse a1 a2 a3 i) (cond (< i (len a1)) (do (set-idx! a3 i (idx a1 i)) (recurse recurse a1 a2 a3 (+ i 1)))
|
|
(< i (+ (len a1) (len a2))) (do (set-idx! a3 i (idx a2 (- i (len a1)))) (recurse recurse a1 a2 a3 (+ i 1)))
|
|
true a3))
|
|
(let1 concat (lambda (a1 a2) (concat_helper concat_helper a1 a2 (array-with-len (+ (len a1) (len a2))) 0))
|
|
|
|
(let1 current-env (vau de () de)
|
|
(let1 lapply (lambda (f p) (eval (concat (array (unwrap f)) p) (current-env)))
|
|
(let1 vapply (lambda (f p ede) (eval (concat (array f) p) ede))
|
|
(let1 Y (lambda (f)
|
|
((lambda (x) (x x))
|
|
(lambda (x) (f (lambda (& y) (lapply (x x) y))))))
|
|
(let1 vY (lambda (f)
|
|
((lambda (x) (x x))
|
|
(lambda (x) (f (vau de (& y) (vapply (x x) y de))))))
|
|
|
|
(let1 let (vY (lambda (recurse) (vau de (vs b) (cond (= (len vs) 0) (eval b de)
|
|
true (vapply let1 (array (idx vs 0) (idx vs 1) (array recurse (slice vs 2 -1) b)) de)))))
|
|
|
|
(let (
|
|
rec-lambda (vau se (p b) (eval (array Y (array lambda (quote (recurse)) (array lambda p b)))))
|
|
rep (Y (lambda (recurse) (wrap (vau de () (do (println (eval (read-string (get_line "> ")) de))
|
|
(recurse))))))
|
|
is_pair? (lambda (x) (and (array? x) (> (len x) 0)))
|
|
|
|
quasiquote (vY (lambda (recurse) (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) (vapply recurse (array (slice x 1 -1)) de))
|
|
true
|
|
(concat (array (vapply recurse (array (idx x 0)) de)) (vapply recurse (array (slice x 1 -1)) de))))
|
|
true x))))
|
|
scope_let (quasiquote ((unquote let) (
|
|
root_env (unquote root_env)
|
|
lambda (unquote lambda)
|
|
rec-lambda (unquote rec-lambda)
|
|
let (unquote let)
|
|
do (unquote do)
|
|
concat (unquote concat)
|
|
lapply (unquote lapply)
|
|
vapply (unquote vapply)
|
|
Y (unquote Y)
|
|
vY (unquote vY)
|
|
quasiquote (unquote quasiquote)
|
|
)
|
|
))
|
|
)
|
|
|
|
(do
|
|
(println "Welcome to Kraken! Parameters were" *ARGV*)
|
|
(cond (and (>= (len *ARGV*) 3) (= "-C" (idx *ARGV* 1))) (eval (concat scope_let (array (read-string (idx *ARGV* 2)))) root_env)
|
|
(> (len *ARGV*) 1) (eval (concat scope_let (array (read-string (slurp (idx *ARGV* 1))))) root_env)
|
|
true (eval (concat scope_let (array (array rep))) root_env)
|
|
)
|
|
)
|
|
)
|
|
))))))))))) ; end of all the let1's
|
|
|
|
; impl of let1
|
|
)) (vau de (s v b) (eval (array (array vau (quote _) (array s) b) (eval v de)) de)))
|
|
; impl of quote
|
|
)) (vau _ (x) x))
|
|
|