Merge pull request #256 from vvakame/impl-ts

[jackhill/mal.git] / mal / step8_macros.mal

(load-file "../mal/env.mal")
(load-file "../mal/core.mal")

;; read
(def! READ (fn* [strng]
  (read-string strng)))


;; eval
(def! is-pair (fn* [x]
  (if (sequential? x)
    (if (> (count x) 0)
      true))))

(def! QUASIQUOTE (fn* [ast]
  (cond
    (not (is-pair ast))
    (list 'quote ast)

    (= 'unquote (first ast))
    (nth ast 1)

    (if (is-pair (first ast))
      (if (= 'splice-unquote (first (first ast)))
        true))
    (list 'concat (nth (first ast) 1) (QUASIQUOTE (rest ast)))

    "else"
    (list 'cons (QUASIQUOTE (first ast)) (QUASIQUOTE (rest ast))))))

(def! is-macro-call (fn* [ast env]
  (if (list? ast)
    (let* [a0 (first ast)]
      (if (symbol? a0)
        (if (env-find env a0)
          (let* [m (meta (env-get env a0))]
            (if m
              (if (get m "ismacro")
                true)))))))))

(def! MACROEXPAND (fn* [ast env]
  (if (is-macro-call ast env)
    (let* [mac (env-get env (first ast))]
      (MACROEXPAND (apply mac (rest ast)) env))
    ast)))

(def! eval-ast (fn* [ast env] (do
  ;;(do (prn "eval-ast" ast "/" (keys env)) )
  (cond
    (symbol? ast) (env-get env ast)

    (list? ast)   (map (fn* [exp] (EVAL exp env)) ast)

    (vector? ast) (apply vector (map (fn* [exp] (EVAL exp env)) ast))

    (map? ast)    (apply hash-map
                      (apply concat
                        (map (fn* [k] [k (EVAL (get ast k) env)])
                             (keys ast))))

    "else"        ast))))

(def! LET (fn* [env args]
  (if (> (count args) 0)
    (do
      (env-set env (nth args 0) (EVAL (nth args 1) env))
      (LET env (rest (rest args)))))))

(def! EVAL (fn* [ast env] (do
  ;;(do (prn "EVAL" ast "/" (keys @env)) )
  (if (not (list? ast))
    (eval-ast ast env)

    ;; apply list
    (let* [ast (MACROEXPAND ast env)]
      (if (not (list? ast))
        (eval-ast ast env)

        (let* [a0 (first ast)]
          (cond
            (nil? a0)
            ast

            (= 'def! a0)
            (env-set env (nth ast 1) (EVAL (nth ast 2) env))

            (= 'let* a0)
            (let* [let-env (new-env env)]
              (do
                (LET let-env (nth ast 1))
                (EVAL (nth ast 2) let-env)))

            (= 'quote a0)
            (nth ast 1)

            (= 'quasiquote a0)
            (let* [a1 (nth ast 1)]
              (EVAL (QUASIQUOTE a1) env))

            (= 'defmacro! a0)
            (let* [a1 (nth ast 1)
                   a2 (nth ast 2)
                   f (EVAL a2 env)
                   m (or (meta f) {})
                   mac (with-meta f (assoc m "ismacro" true))]
              (env-set env a1 mac))

            (= 'macroexpand a0)
            (let* [a1 (nth ast 1)]
              (MACROEXPAND a1 env))

            (= 'do a0)
            (let* [el (eval-ast (rest ast) env)]
              (nth el (- (count el) 1)))

            (= 'if a0)
            (let* [cond (EVAL (nth ast 1) env)]
              (if (or (= cond nil) (= cond false))
                (if (> (count ast) 3)
                  (EVAL (nth ast 3) env)
                  nil)
                (EVAL (nth ast 2) env)))

            (= 'fn* a0)
            (fn* [& args]
              (EVAL (nth ast 2) (new-env env (nth ast 1) args)))

            "else"
            (let* [el (eval-ast ast env)
                  f (first el)
                  args (rest el)]
              (apply f args))))))))))


;; print
(def! PRINT (fn* [exp] (pr-str exp)))

;; repl
(def! repl-env (new-env))
(def! rep (fn* [strng]
  (PRINT (EVAL (READ strng) repl-env))))

;; core.mal: defined directly using mal
(map (fn* [data] (env-set repl-env (nth data 0) (nth data 1))) core_ns)
(env-set repl-env 'eval (fn* [ast] (EVAL ast repl-env)))
(env-set repl-env '*ARGV* (rest *ARGV*))

;; core.mal: defined using the new language itself 
(rep "(def! not (fn* [a] (if a false true)))")
(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))")
(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))")

;; repl loop
(def! repl-loop (fn* []
  (let* [line (readline "mal-user> ")]
    (if line
      (do
        (if (not (= "" line))
          (try*
            (println (rep line))
            (catch* exc
              (println "Uncaught exception:" exc))))
        (repl-loop))))))

(def! -main (fn* [& args] 
  (if (> (count args) 0)
    (rep (str "(load-file \"" (first args) "\")"))
    (repl-loop))))
(apply -main *ARGV*)