kraken/k_prime_stdlib/prelude.kp

(set! quote (vau _ (x) x))
(set! lambda (vau se (p b) (wrap (eval (array vau (quote _) p b) se))))
(set! current-env (vau de () de))
(set! fun (vau se (n p b) (eval (array set! n (array lambda p b)) se)))

; do_helper is basically mapping eval over statements, but the last one is in TCO position
; a bit of a hack, using cond to sequence (note the repitition of the eval in TCO position if it's last,
; otherwise the same eval in cond position, and wheather or not it returns a truthy value, it recurses in TCO position)
(fun do_helper (s i se) (cond (= i (len s)) nil
                              (= i (- (len s) 1)) (eval (idx s i) se)
                              (eval (idx s i) se) (do_helper s (+ i 1) se)
                              true                (do_helper s (+ i 1) se)))
(set! do (vau se (& s) (do_helper s 0 se)))

(fun concat_helper (a1 a2 a3 i) (cond (< i (len a1))              (do (set-idx! a3 i (idx a1 i))              (concat_helper a1 a2 a3 (+ i 1)))
                                      (< i (+ (len a1) (len a2))) (do (set-idx! a3 i (idx a2 (- i (len a1)))) (concat_helper a1 a2 a3 (+ i 1)))
                                      true a3))
(fun concat (a1 a2) (concat_helper a1 a2 (array-with-len (+ (len a1) (len a2))) 0))

(add_grammar_rule (quote form) (quote ( "'" optional_WS form )) (vau de (_ _ f) (array quote (eval f de))))
(add_grammar_rule 'form '( "\\[" optional_WS space_forms optional_WS "\\]" ) (vau de (_ _ fs _ _) (concat (array array) (eval fs de))))

(fun vapply (f p ede) (eval (concat [f]          p) ede))
(fun lapply (f p)     (eval (concat [(unwrap f)] p) (current-env)))

(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 (vapply let1 [(idx vs 0) (idx vs 1) [let (slice vs 2 -1) b]] de))))

(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 map (f l)
    (let (helper (lambda (f l n i recurse)
                                    (if (= i (len l))
                                        n
                                        (do (set-idx! n i (f (idx l i)))
                                            (recurse f l n (+ i 1) recurse)))))
         (helper f l (array-with-len (len l)) 0 helper)))
(fun flat_map (f l)
    (let (helper (lambda (f l n i recurse)
                                    (if (= i (len l))
                                        n
                                        (recurse f l (concat n (f (idx l i))) (+ i 1) recurse))))
         (helper f l (array) 0 helper)))
(fun map_with_idx (f l)
    (let (helper (lambda (f l n i recurse)
                                    (if (= i (len l))
                                        n
                                        (do (set-idx! n i (f i (idx l i)))
                                            (recurse f l n (+ i 1) recurse)))))
         (helper f l (array-with-len (len l)) 0 helper)))

(fun print_through (x) (do (println x) x))
(fun is_pair? (x) (and (array? 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) (vapply quasiquote [(slice x 1 -1)] de))
                                  true
                                        (concat [(vapply quasiquote [(idx x 0)] de)] (vapply 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]))

(set! Y (lambda (f)
    ((lambda (x) (x x))
     (lambda (x) (f (lambda (& y) (lapply (x x) y)))))))

(set! vY (lambda (f)
    ((lambda (x) (x x))
     (lambda (x) (f (vau de (& y) (vapply (x x) y de)))))))

(set! rep (Y (lambda (recurse) (wrap (vau de ()
    (do (println (eval (read-string (get_line "> ")) de)) (recurse)))))))