Solves the generalized version of the "Make 10 with 4 numbers" game (use for around 4 numbers)

MakeNGameSolver.lisp

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Make N Game Solver
;; Naiive version
;; 11.24.2014
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Settings
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar *target* 10)
(defvar *numofnums* 4)
(defvar *ops* '(+ - * div))
(defvar *showallflag* nil)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Utils
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Referenced From
; http://dunsmor.com/lisp/onlisp/onlisp_9.html#SEC43
; Figure 5-2: Memoizing utility.
(defun memoizefunc (fn)
  (let ((cache (make-hash-table :test #'equal)))
    #'(lambda (&rest args)
       (multiple-value-bind
         (val win)
         (gethash args cache)
         (if win
             val
             (setf (gethash args cache)
                   (apply fn args)))))))
(defmacro memoize (func)
  `(setf (symbol-function ',func) (memoizefunc #',func)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Basic Functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun binTreeList (n)
  (if (= 0 n)
      (list :n)
      (loop for i from 0 to (- n 1) append
            (loop for j in (binTreeList i) append
                  (loop for k in (binTreeList (- (- n 1) i)) collect
                        (list :op j k))))))
(memoize binTreeList)
(defun replace-nth (n list val)
  (loop for i from 0 for j in list collect (if (= i n) val j)))
(defun replaceOneLeaf (l S)
  (if (atom l)
      (if (equal :n l) S nil)
      (let ((x))
        (loop for i from 1 to (length l) do
              (setf x (replaceOneLeaf (nth i l) S))
              (if x (return-from replaceOneLeaf (replace-nth i l x))))
        nil)))
(defun replaceOneOp (l S)
  (cond ((atom l) nil)
        ((equal :OP (nth 0 l)) (replace-nth 0 l S))
        (t (let ((x))
             (loop for i from 1 to (length l) do
                   (setf x (replaceOneOp (nth i l) S))
                   (if x (return-from replaceOneOp (replace-nth i l x))))
             nil))))
(defun seqlist (n list)
  (if (= n 0)
      (list nil)
      (loop for i in (seqlist (- n 1) list) append
            (loop for j in list collect
                  (cons j i)))))
;; Referenced from:
;; http://rosettacode.org/wiki/Permutations
(defun permute (list)
  (if list
      (mapcan
        #'(lambda (x)
           (mapcar
             #'(lambda (y) (cons x y))
             (permute (remove x list :count 1))))
        list)
      '(())))
;; For avoiding zero division errors
(defun div (num den)
  (if (= den 0)
      1E10
      (/ num den)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The core functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun printalleqs (ans nums)
  (loop for bintree in (binTreeList (1- (length nums))) sum
        (loop for oplist in (seqlist (1- (length nums)) *ops*) sum
              (loop for numlist in (remove-duplicates (permute nums) :test #'equal) sum
                    (let ((x (reduce #'replaceOneOp oplist :initial-value
                                     (reduce #'replaceOneLeaf numlist :initial-value bintree))))
                      (if (= ans (eval x))
                          (progn
                            (format t "~S~%" x)
                            1)
                          0))))))
(defun findeq (ans nums)
  (loop for bintree in (binTreeList (1- (length nums))) do
        (loop for oplist in (seqlist (1- (length nums)) *ops*) do
              (loop for numlist in (remove-duplicates (permute nums) :test #'equal) do
                    (let ((x (reduce #'replaceOneOp oplist :initial-value
                                     (reduce #'replaceOneLeaf numlist :initial-value bintree))))
                      (if (= ans (eval x))
                          (return-from findeq x)
                          nil))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The Main Loop
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun infloop (S)
  (progn
    (eval S)
    (infloop S)))
(defun readnums (n)
  (if (= n 0)
      (progn
        (format t "Accepted nums. Calculating...~%")
        nil)
      (let ((x (read)))
        (cond ((equal 'exit x) (exit))
              ((not (typep x 'integer)) (format t "Error: input was not a number~%")))
        (if (typep x 'integer)
            (cons x (readnums (1- n)))
            (readnums n)))))
(format t ";;;;;;;;;;;;;;;;;;;;;;;;~%")
(format t ";; Make N Game Solver ;;~%")
(format t ";;;;;;;;;;;;;;;;;;;;;;;;~%")
(format t "           N : ~D~%" *target*)
(format t " Num of nums : ~D~%" *numofnums*)
(format t "   Operators : ~S~%" *ops*)
(format t "Show all eqs : ~S~%~%" (if *showallflag* "Yes" "No"))
(infloop
  '(progn
    (format t "Insert each number and hit return, or type exit~%")
    (if *showallflag*
        (format t "Total of ~D equations~%~%" (printalleqs *target* (readnums *numofnums*)))
        (format t "Ans: ~S~%~%" (findeq *target* (readnums *numofnums*))))))