;; tpk.cl -- Knuth's TPK program in Common Lisp
;; tested with GNU Common Lisp Version 2.2.2

(labels
   (
      ;; define the function f(x) = sqrt(|x|) + 5*x**3
      (f (x) (+ (sqrt (abs x)) (* 5.0 (expt x 3))))

      ;; define an auxiliary print function
      (pr (f) (if (> f 400.0) (format t "~A~%" " too large") (format t "~F~%" f)))
   )
   (let
      ((A (make-array '(11))))  ;; declare array A [0..10]

      ;; read in the values of the array "A"
      (do ((i 0 (+ i 1))) ((> i 10)) (setf (aref A i) (read)))

      ;; in reverse oder, apply "f" to each element of "A" and print
      (do ((i 10 (- i 1))) ((< i 0)) (pr (f (aref A i))))
   )
)


;;  Reformulation of TPK in a "functional" way.
(defun f (x) (+ (sqrt (abs x)) (* 5.0 (expt x 3))))
(defun p (x) (< x 400.0))

(defun tpk (x) (remove-if-not #'p (map 'list #'f (reverse x))))