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)))))