stackity.stack.clj

(ns stackity.stack)

(defn compile-mode?
  [stack]
  (-> stack meta :mode (= :compile)))

(def interpret-mode? (complement compile-mode?))

(defn ->compile-mode
  [stack]
  (vary-meta stack assoc :mode :compile))

(defn ->define-mode
  [stack word]
  (vary-meta stack assoc :define {:word word :definition []}))

(defn continue-definition
  [stack word]
  (vary-meta stack update-in [:define :definition] conj word))

(defn define-word
  [stack word definition]
  (vary-meta stack assoc-in [:words word] definition))

(defn store-definition
  [stack]
  (let [{{:keys [word definition]} :define} (meta stack)]
    (if definition
      (-> stack
          (define-word word definition)
          (vary-meta dissoc :define))
      stack)))

(defn ->interpret-mode
  [stack]
  (-> stack
      (store-definition)
      (vary-meta assoc :mode :interpret)))

(defn get-definition
  [stack word]
  (if-let [definition (-> stack meta :words (get word))]
    definition
    (throw (IllegalStateException. (str "Undefined word: " word)))))

(defn push-value
  [stack value]
  (conj stack value))

(declare interpret)

(defn evaluate
  [stack definition]
  (reduce interpret stack definition))

(defn interpret
  [stack word]
  (if (interpret-mode? stack)
    (cond
     ;; in order to define a new word, switch to compile mode
     (= word 'DEF) (->compile-mode stack)
     ;; otherwise interpret the word by executing its definition
     (symbol? word) (let [definition (get-definition stack word)]
                      (cond
                       (fn? definition) (definition stack)
                       (vector? definition) (evaluate stack definition)))
     :else (push-value stack word))
    ;; else we are in compile mode
    (cond
     (-> stack meta :define empty?) (->define-mode stack word)
     (= word 'END) (-> stack ->interpret-mode)
     :else (continue-definition stack word))))

(def empty-stack (list))

(defn stack-fn
  [f]
  (fn [stack]
    (with-meta (f stack) (meta stack))))

(def base
  (-> empty-stack
      (define-word '+ (stack-fn (fn [[a b & rest]] (conj rest (+ a b)))))
      (define-word '* (stack-fn (fn [[a b & rest]] (conj rest (* a b)))))
      (define-word '- (stack-fn (fn [[a b & rest]] (conj rest (- a b)))))
      (define-word '/ (stack-fn (fn [[a b & rest]] (conj rest (/ a b)))))
      ;; duplicate the value at the top of the stack
      (define-word 'DUP (stack-fn (fn [[a & rest]] (conj rest a a))))
      ;; swap the top two values of the stack
      (define-word 'SWAP (stack-fn (fn [[a b & rest]] (conj rest a b))))
      ;; drop the top value off the stack
      (define-word 'DROP (stack-fn (fn [[a & rest]] rest)))
      ;; print the top of the stack
      (define-word 'PEEK (stack-fn (fn [stack] (println (first stack)) stack)))
      ->interpret-mode))

(defn repl
  ([init-stack]
     (loop [stack init-stack]
       (print "STACKITY" stack "> ")
       (.flush *out*)
       (let [word (read)]
         (cond
          (= word 'QUIT) (println "Bye!")
          :else (let [next-stack (try (interpret stack word)
                                      (catch Exception e
                                        (println "ERROR:" e)
                                        stack))]
                  (recur next-stack))))))
  ([]
     (repl base)))