Skip to content

Instantly share code, notes, and snippets.

@jcromartie
Last active August 29, 2015 13:56
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save jcromartie/9232442 to your computer and use it in GitHub Desktop.
Save jcromartie/9232442 to your computer and use it in GitHub Desktop.
(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)))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment