interp.clj

(ns interp.core)

(def empty-state {:ip 0, :code [], :stack '(), :labels {}})

(defn step
  [state]
  (let [instr (get (:code state) (:ip state))
        state (update-in state [:ip] inc)]
    (cond
      (nil? instr)
        state
      (fn? instr)
        (instr state))))

(defn step*
  [state]
  (take-while
    #(<= (:ip %) (count (:code %)))
    (iterate step (merge empty-state state))))

(defn stack-peek
  [state]
  (peek (:stack state)))

(defn run
  [& code]
  (let [state {:code (vec code)}
        state (last (step* state))]
    (stack-peek state)))

; dsl

(defn push
  [value]
  (fn [state]
    (update-in state [:stack] #(conj % value))))

(defn op
  [f]
  (fn [state]
    (update-in state [:stack] #(conj (drop 2 %) (apply f (reverse (take 2 %)))))))

(defn label
  [label]
  (fn [state]
    (update-in state [:labels] #(assoc % label (:ip state)))))

(defn jumpnz
  [label]
  (fn [state]
    (if (not (zero? (peek (:stack state))))
        (assoc state :ip (get (:labels state) label))
        state)))

(defn debug
  [f]
  (fn [state]
    (prn (f state))
    state))

; (use 'interp.core :reload)

; (step {:ip 0, :code [(push 1) (push 2) (op +)] :stack '()})
;=> {:ip 1, :code [1 2 #<core.op +>], :stack (1)}

; (step* {:ip 0, :code [(push 1) (push 2) (op +)] :stack '()})
;=> ({:ip 0, :code [#<core.push 1> #<core.push 2> #<core.op +>], :stack (),    :labels {}}
;    {:ip 1, :code [#<core.push 1> #<core.push 2> #<core.op +>], :stack (1),   :labels {}}
;    {:ip 2, :code [#<core.push 1> #<core.push 2> #<core.op +>], :stack (2 1), :labels {}}
;    {:ip 3, :code [#<core.push 1> #<core.push 2> #<core.op +>], :stack (3),   :labels {}})

; (map :stack (step* {:ip 0, :code [(push 1) (push 2) (op +)] :stack '()}))
;=> (()
;    (1)
;    (2 1)
;    (3))

; (run (push 1) (push 2) (op +))
;=> 3

; (run (push 3) (label :loop) (debug stack-peek) (push 1) (op -) (jumpnz :loop))
; 3
; 2
; 1
;=> 0