Forth in Clojure, so far

forth.clj

(ns forth.core
  "Forth in Clojure"
  (:require [clojure.test :refer [deftest is are]]))

(defn npop
  "Returns a list without the first n items by applying pop repeatedly."
  [n coll]
  ((apply comp (repeat n pop)) coll))

(defn ffn
  "Returns a fn which takes n items from the input stack, applies them to f,
  and pushes o items (from the result of f) back onto the stack."
  [n o f]
  #(apply conj (npop n %) (take o (apply f (take n %)))))

(defn fapply
  "For an int or fn f, applies it to the stack s."
  [s f]
  (if (integer? f) (conj s f) (f s)))

(defn feval
  "For a list of ints or fns fs, applies them to the stack s."
  [s & fs]
  (reduce fapply s fs))

(defn f
  "Returns a fn which applies the int i to the input stack."
  [i]
  #(fapply % i))

;; Forth Words

(def f+ (ffn 2 1 (comp list +))) ; ( n1 n2 -- sum )
(def f- (ffn 2 1 (comp list -))) ; ( n1 n2 -- difference )
(def f* (ffn 2 1 (comp list *))) ; ( n1 n2 -- product )
(def fdiv (ffn 2 1 #(list (int (/ %2 %1))))) ; ( n1 n2 -- quotient )
(def fdup (ffn 1 2 #(repeat 2 %))) ; ( n -- n n )
(def fsquare (comp f* fdup)) ; ( n -- square )
(def fp (ffn 1 0 print)) ; ( n -- )
(def fswap (ffn 2 2 list)) ; ( n1 n2 -- n2 n1 )
(def fdrop (ffn 1 0 identity)) ; ( n -- )
(def fover (ffn 2 3 #(list %2 %1 %2))) ; ( n1 n2 -- n1 n2 n1 )
(def femit (ffn 1 0 (comp print char))) ; ( n -- )
(def fcr (comp femit (f 10))) ; ( -- )

(deftest arithmetic
  (are [x y] (= x (first y))
    (+ 7 8) (feval '() 8 7 f+)
    (- 8 7) (feval '() 7 8 f-)
    (* 5 6) (feval '() 5 6 f*)
    (/ 6 3) (feval '() 6 3 fdiv)
    0 (feval '() 3 6 fdiv)
    (* 5 5) (feval '() 5 fsquare)))

(deftest stack-operations
  (is (= '(1 2 3) (feval '() 3 1 2 fswap)))
  (is (= '(2 3) (feval '() 3 2 1 fdrop)))
  (is (= '(1 2 1) (feval '() 1 2 fover))))

(def stack (atom (list)))
(defn feval! [& fs] (swap! stack #(apply feval % fs)))