* Added a warning procedure.

This commit is contained in:
Abdulaziz Ghuloum 2007-01-31 19:07:28 -05:00
parent 3c4986ff89
commit 0f5af66775
3 changed files with 11 additions and 6 deletions

Binary file not shown.

View File

@ -483,14 +483,14 @@
(formatter 'format p fmt args) (formatter 'format p fmt args)
(get-output-string p)))) (get-output-string p))))
(define print-error (define display-error
(lambda (who fmt . args) (lambda (errname who fmt args)
(unless (string? fmt) (unless (string? fmt)
(error 'print-error "~s is not a string" fmt)) (error 'print-error "~s is not a string" fmt))
(let ([p (standard-error-port)]) (let ([p (standard-error-port)])
(if who (if who
(fprintf p "Error in ~a: " who) (fprintf p "~a in ~a: " errname who)
(fprintf p "Error: ")) (fprintf p "~a: " errname))
(formatter 'print-error p fmt args) (formatter 'print-error p fmt args)
(write-char #\. p) (write-char #\. p)
(newline p)))) (newline p))))
@ -515,7 +515,12 @@
(unless (output-port? p) (unless (output-port? p)
(error 'display "~s is not an output port" p)) (error 'display "~s is not an output port" p))
(display x p)])) (display x p)]))
(primitive-set! 'print-error print-error) (primitive-set! 'print-error
(lambda (who fmt . args)
(display-error "Error" who fmt args)))
(primitive-set! 'warning
(lambda (who fmt . args)
(display-error "Warning" who fmt args)))
(primitive-set! 'error-handler (primitive-set! 'error-handler
(make-parameter (make-parameter
(lambda args (lambda args

View File

@ -54,7 +54,7 @@
gensym gensym-count gensym-prefix print-gensym gensym gensym-count gensym-prefix print-gensym
gensym->unique-string call-with-values values make-parameter gensym->unique-string call-with-values values make-parameter
dynamic-wind display write print-graph fasl-write printf fprintf format dynamic-wind display write print-graph fasl-write printf fprintf format
print-error read-token read comment-handler error exit call/cc print-error read-token read comment-handler error warning exit call/cc
error-handler eval current-eval compile compile-file error-handler eval current-eval compile compile-file
new-cafe load system expand sc-expand current-expand expand-mode new-cafe load system expand sc-expand current-expand expand-mode
environment? interaction-environment identifier? environment? interaction-environment identifier?