gistfile1.clj

(defrecord Closure [form env])

(defn closure?
  [x]
  (instance? Closure x))

(defn close-over
  [form env]
  (println "(close-over " form (str env ")"))
  (Closure. form env))

(def atom? (complement seq?))

(defn eval
  ([form] (eval form {}))
  ([form env]
     (println "(eval" form (str env ")"))
     (cond
       (symbol? form) (if-let [z (get env form)]
                        (recur z env)
                        form)
       (closure? form) (let [prev env
                             {:keys [form env]} form]
                         (recur (eval form (merge prev env)) prev))
       (atom? form) form
       :else (let [op (first form)
                   args (next form)]
               (case op
                 λ (let [z (gensym)]
                     (list 'λ (list z)
                           (close-over (first (nnext form))
                                       (assoc env (first (fnext form)) z))))
                 let (let [prev env
                           bindings (first args)
                           env (merge prev
                                      (zipmap (map first bindings)
                                              (map second bindings)))
                           body (second args)]
                       (recur (close-over body env) env))
                 letfn (let [prev env
                             bindings (first args)
                             env (merge prev
                                        (zipmap (map first bindings)
                                                (->> (map next bindings)
                                                     (map (partial cons 'λ)))))
                             body (second args)]
                         (recur (close-over body env) env))
                 (+ - / *) (core/apply (resolve op)
                                       (list* (map #(eval % env) args)))
                 (apply op (list* (map #(eval % env) args))))))))

(defn apply
  [f args]
  (println "(apply" f (str args ")"))
  (cond
    (atom? f) (cons f args)
    (= (first f) 'λ)
    (close-over (first (nnext f)) (zipmap (fnext f) args))
    :else (recur (eval f) args)))

(defn read1
  []
  (try
    (print "=> ")
    (flush)
    (read-string (read-line))
    (catch Throwable t
      (read1))))

(defn -main
  [& args]
  (loop [form (read1)]
    (if (= form '(exit))
      (println "Exiting...")
      (let [ret (eval form)]
        (println ret)
        (recur (read1))))))