diff --git a/lisp/euler.lisp b/lisp/euler.lisp
index 6d582b6..f4343b0 100644
--- a/lisp/euler.lisp
+++ b/lisp/euler.lisp
@@ -2,6 +2,7 @@
 (defun sum (list) (apply '+ list))
 (defun select (expr list) (remove-if-not expr list))
 (defun filter (expr list) (remove-if expr list))
+(defun empty (list) (eq list nil))
 
 (defun partial (func &rest args1)
   (lambda (&rest args2)
@@ -11,3 +12,48 @@
 (defun prime (n)
   (eq (length (member T (mapcar (lambda (a) (eq (mod n a) 0)) (range 2 (sqrt n))))) 0)
 )
+
+(defun cartesian-helper (thing list)
+  (if (empty list)
+    nil
+    (cons (list thing (first list)) (cartesian-helper thing (rest list)))
+  )
+)
+
+(defun cartesian (list-one list-two)
+  (if (empty list-one)
+    nil
+    (append (cartesian-helper (first list-one) list-two) (cartesian (rest list-one) list-two))
+  )
+)
+
+(defun number-to-digit-list (num)
+  (if (< num 10)
+    (list num)
+    (append (number-to-digit-list (floor (/ num 10))) (list (mod num 10)))
+  )
+)
+
+(defun digit-list-to-number (digit-list)
+  (if (empty digit-list)
+    0
+    (+ (* (first digit-list) (expt 10 (- (length digit-list) 1))) (digit-list-to-number (rest digit-list)))
+  )
+)
+
+(defun is-palindrome (num)
+  (let* ((digit-list (number-to-digit-list num)))
+    (equal (reverse digit-list) digit-list))
+)
+
+(defun resolve-tuple (expr tuple)
+  (funcall expr (first tuple) (second tuple))
+)
+
+(defun resolve-tuples (expr tuple-list)
+  (mapcar (partial #'resolve-tuple expr) tuple-list)
+)
+
+(defun max-of (list)
+  (reduce #'max list)
+)
diff --git a/lisp/euler004.lisp b/lisp/euler004.lisp
new file mode 100644
index 0000000..a76479c
--- /dev/null
+++ b/lisp/euler004.lisp
@@ -0,0 +1,9 @@
+(load "euler.lisp")
+
+(defun three-digit-products ()
+  (resolve-tuples (lambda (a b) (* a b)) (cartesian (range 100 999) (range 100 999)))
+)
+
+(defun solution ()
+  (max-of (select #'is-palindrome (three-digit-products)))
+)