Skip to content

Excess printing in section 2.3.* #5

Open
@mariari

Description

@mariari

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

Metadata

Metadata

Assignees

No one assigned

    Labels

    No labels
    No labels

    Type

    No type

    Projects

    No projects

    Milestone

    No milestone

    Relationships

    None yet

    Development

    No branches or pull requests

    Issue actions