gistfile1.clj

(ns clorth.core
  (:require clojure.pprint))

(defn defword*
  ([dict word code] (defword* dict word code false))
  ([dict word code immediate]
     (assoc dict word {:name word, :code code, :immediate immediate})))

(defmacro defword [dict name vars & code]
  `(defword* ~dict (keyword '~name)
     (fn [{:keys ~vars :as world#}]
       (assoc world# :s (do ~@code)))))

(defn init-dict []
  (-> {}
      (defword dup [s] (conj s (peek s)))
      (defword dup? [s] (if-not (= (peek s) 0) (conj s (peek s)) s))
      (defword drop [s] (pop s))
      (defword swap [s]
        (let [a (peek s), b (peek (pop s))]
          (-> s pop pop (conj a) (conj b))))
      (defword rot [s]
        (let [a (peek s), b (peek (pop s)), c (peek (pop (pop s)))]
          (-> s pop pop pop (conj b) (conj a) (conj c))))
      (defword plus [s]
        (let [a (peek s), b (peek (pop s))]
          (-> s pop pop (conj (+ a b)))))
      (defword mult [s]
        (let [a (peek s), b (peek (pop s))]
          (-> s pop pop (conj (* a b)))))
      (defword sub [s]
        (let [a (peek s), b (peek (pop s))]
          (-> s pop pop (conj (- b a)))))
      (defword div [s]
        (let [a (peek s), b (peek (pop s))]
          (-> s pop pop (conj (/ b a)))))
      (defword dot [s] (print (peek s)) (pop s))
      (defword cr [s] (println) s)
      (defword dot-s [s] (clojure.pprint/pprint s) s)
      (defword dot-d [s d] (clojure.pprint/pprint d) s)))