From: Stephen Adams Date: Tue, 23 Jul 1996 16:13:42 +0000 (+0000) Subject: Changed FORM->SOURCE-IRRITANT to give a more useful output when source X-Git-Tag: 20090517-FFI~5444 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=842585a6e6bf3c84730014bff9a09e8e6f11f22f;p=mit-scheme.git Changed FORM->SOURCE-IRRITANT to give a more useful output when source is not available. --- diff --git a/v8/src/compiler/midend/midend.scm b/v8/src/compiler/midend/midend.scm index 31c5b786f..5fd0a828e 100644 --- a/v8/src/compiler/midend/midend.scm +++ b/v8/src/compiler/midend/midend.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: midend.scm,v 1.22 1996/03/09 18:29:04 adams Exp $ +$Id: midend.scm,v 1.23 1996/07/23 16:13:42 adams Exp $ Copyright (c) 1994 Massachusetts Institute of Technology @@ -478,19 +478,23 @@ Example: (let ((text (with-output-to-string (lambda () (pp scode))))) (let ((fragments (string-split text #\newline))) (define (prefix s) (if (string-null? s) s (string-append "\n; " s))) - (error-irritant/noise - (apply string-append (map prefix fragments))))))) + (apply string-append (map prefix fragments)))))) + (define (wrap e) (error-irritant/noise e)) (define (get-source dbg-object) (cond ((new-dbg-expression? dbg-object) - (format-scode (new-dbg-expression/source-code dbg-object))) + (wrap (format-scode (new-dbg-expression/source-code dbg-object)))) ((new-dbg-procedure? dbg-object) - (format-scode (new-dbg-procedure/source-code dbg-object))) + (wrap (format-scode (new-dbg-procedure/source-code dbg-object)))) ((new-dbg-continuation/inner dbg-object) => get-source) ((new-dbg-continuation/outer dbg-object) => get-source) (else (unhelpful)))) - (define (unhelpful) #F) #|(error-irritant/noise "")|# + (define (unhelpful) + (wrap + (string-append + (format-scode (string->symbol "")) + (format-scode (kmp/->ppp form))))) (cond ((code-rewrite/original-form form) => get-source) ((code-rewrite/original-form/previous form) => get-source) (else (unhelpful))))