(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 "") (let ([args (get-condition-property exn 'exn 'arguments)]) (if (null? args) "" (format "~a\n" args)))))