(in-package #:cl-forth)

(defun with-stack-args (interpreter func)
  "Pop two values from the stack and apply FUNC to them."
  (let ((b (pop-from-stack (stack-of interpreter)))
        (a (pop-from-stack (stack-of interpreter))))
    (funcall func a b)))

(defun dup (interpreter)
  "Duplicate the top number on the stack."
  (let ((top (peek-stack (stack-of interpreter))))
    (push-to-stack (stack-of interpreter) top)))

(defun swap (interpreter)
  "Swap the top two numbers on the stack."
  (let ((a (pop-from-stack (stack-of interpreter)))
        (b (pop-from-stack (stack-of interpreter))))
    (push-to-stack (stack-of interpreter) a)
    (push-to-stack (stack-of interpreter) b)))

(defun add (interpreter)
  "Add the top two numbers on the stack."
  (with-stack-args interpreter
    (lambda (a b)
      (push-to-stack (stack-of interpreter) (+ a b)))))

(defun subtract (interpreter)
  "Subtract the top two numbers on the stack."
  (with-stack-args interpreter
    (lambda (a b)
      (push-to-stack (stack-of interpreter) (- a b)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun multiply (interpreter)
  "Multiply the top two numbers on the stack."
  (with-stack-args interpreter
    (lambda (a b)
      (push-to-stack (stack-of interpreter) (* a b)))))

(defun divide (interpreter)
  "Divide the second top number by the top number on the stack."
  (with-stack-args interpreter
    (lambda (a b)
      (if (zerop a)
          (error "Division by zero")
          (push-to-stack (stack-of interpreter) (/ b a))))))

(defun my-mod (interpreter)
  "Compute the modulus of the second top number by the top number on the stack."
  (with-stack-args interpreter
    (lambda (a b)
      (if (zerop a)
          (error "Division by zero")
          (push-to-stack (stack-of interpreter) (mod b a))))))

(defun negate (interpreter)
  "Negate the top number on the stack."
  (let ((top (pop-from-stack (stack-of interpreter))))
    (push-to-stack (stack-of interpreter) (- top))))

(defun drop (interpreter)
  "Remove the top number from the stack."
  (pop-from-stack (stack-of interpreter)))

(defun over (interpreter)
  "Copy the second top number to the top of the stack."
  (let ((a (pop-from-stack (stack-of interpreter)))
        (b (peek-stack (stack-of interpreter))))
    (push-to-stack (stack-of interpreter) a)
    (push-to-stack (stack-of interpreter) b)))

(defun rot (interpreter)
  "Rotate the top three numbers on the stack."
  (let ((a (pop-from-stack (stack-of interpreter)))
        (b (pop-from-stack (stack-of interpreter)))
        (c (pop-from-stack (stack-of interpreter))))
    (push-to-stack (stack-of interpreter) b)
    (push-to-stack (stack-of interpreter) a)
    (push-to-stack (stack-of interpreter) c)))