Apress / common-lisp-condition-system

Source Code for 'The Common Lisp Condition System' by Michal "phoe" Herda
Other
97 stars 10 forks source link

Excess printing in section 2.3.* #5

Open mariari opened 4 years ago

mariari commented 4 years ago

In this section, the book has the following code snipits

(defun perform-escape-through-front-door ()
  (format t ";; Escaping through the front door.~%")
  (setf *mark-safe-p* t))

(defun escape-through-front-door-p ()
  (format t ";; The front door is~:[ not~;~] locked.~%" *front-door-locked-p*)
  (not *front-door-locked-p*))

(defun find-choice (name)
  (loop for choice in *choices*
        when (and (funcall (choice-test-function choice))
                (eq name (choice-name choice)))
          return choice))

(defun invoke-choice (name &rest arguments)
  (let ((choice (find-choice name)))
    (apply (choice-effect-function choice) arguments)))

(defun try-to-hide-mark ()
  (if (find-choice 'escape)
      (invoke-choice 'escape)
      (format t ";; Kate cannot hide Mark!~%")))

(defun call-with-home-choices (thunk)
  (let ((*choices*
          (list (make-choice
                 :name 'escape
                 :effect-function #'perform-escape-through-front-door
                 :test-function #'escape-through-front-door-p)
                (make-choice
                 :name 'escape
                 :effect-function #'perform-escape-through-back-door
                 :test-function #'escape-through-back-door-p)
                (make-choice
                 :name 'excuse
                 :effect-function #'perform-excuse))))
    (funcall thunk)))

when we call

(call-with-home-choices
 (lambda ()
   (let ((*mark-safe-p* nil)
         (*front-door-locked-p* nil)
         (*back-door-locked-p* nil))
     (try-to-hide-mark))))

we get

;; The front door is not locked.
;; The front door is not locked.
;; Escaping through the front door.

This issue gets further compounded when we have the full try-to-hide-mark

(defun try-to-hide-mark ()
  (let ((choice (find-choice 'escape)))
    (cond (choice
           (invoke-choice choice))
          (t
           (format t ";; Kate cannot hide Mark!~%")
           (let ((excuse (find-choice 'excuse)))
             (when excuse
               (let ((excuse-text (elt *excuses* (random (length *excuses*)))))
                 (invoke-choice excuse excuse-text))))))))

CL-USER> (call-with-home-choices
 (lambda ()
   (let ((*mark-safe-p* nil)
         (*front-door-locked-p* t)
         (*back-door-locked-p* t))
     (try-to-hide-mark-old))))
;; The front door is locked.
;; The back door is locked.
;; Kate cannot hide Mark!
;; The front door is locked.
;; The back door is locked.
;; The front door is locked.
;; The back door is locked.
;; Mark makes an excuse before leaving:
;; "Kate did not divide her program into sections properly!"
T

The following is my solution


;; flip the order, where we make sure the name comes first!
(defun find-choice (name)
  (loop for choice in *choices*
        when (and (eq name (choice-name choice))
                (funcall (choice-test-function choice)))
          return choice))

;; have to let out the additional effects
(defun try-to-hide-mark ()
  (let ((choice (find-choice 'escape)))
    (cond (choice
           (invoke-choice choice))
          (t
           (format t ";; Kate cannot hide Mark!~%")
           (let ((excuse (find-choice 'excuse)))
             (when excuse
               (let ((excuse-text (elt *excuses* (random (length *excuses*)))))
                 (invoke-choice excuse excuse-text))))))))

;; we pass the name itself, not search for it
(defun invoke-choice (name &rest arguments)
  (apply (choice-effect-function name)
         arguments))

with the output as follows

(call-with-home-choices
 (lambda ()
   (let ((*mark-safe-p* nil)
         (*front-door-locked-p* t)
         (*back-door-locked-p* t))
     (try-to-hide-mark))))
;; The front door is locked.
;; The back door is locked.
;; Kate cannot hide Mark!
;; The front door is locked.
;; The back door is locked.
;; Mark makes an excuse before leaving:
;; "I was borrowing Kate's books on mainframe programming!"

T
phoe commented 4 years ago

Acknowledged - thank you for the issue and the provided fix! I'll integrate it into the code soon.