print-exception added by megane on Wed Nov 7 14:36:41 2018

(defn print-exception
  [exn &optional (while : string) (no-cc? : boolean)]
  (unless no-cc?
    (and-let* ([cc* (and (or (get-condition-property exn 'exn 'cc #f)
                             (get-condition-property exn 'exn 'call-chain #f)))])
      (##sys#really-print-call-chain
       (current-output-port) cc*
       "############################## Call chain: ##############################\n")))
  (printf "\n#################### Exception ~a~a: ####################\n~a~a:\n~a\n"
          (map car (condition->list exn))
          (if while (str " while " while) "")
          (? (and-let* ([loc (get-condition-property exn 'exn 'location #f)])
               (format "In `~a':\n" loc))
             "")
          (get-condition-property exn 'exn 'message "<no message>")
          (let ([args (get-condition-property exn 'exn 'arguments)])
            (if (null? args) "" (format "~a\n" args)))))