mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-03 16:20:39 +02:00
Code Activity

repl.scm: use print-exception

Browse source 
* module/system/repl/repl.scm: Remove custom exception printers in favor
  of print-exception.
This commit is contained in:
Andy Wingo 2011-02-11 12:53:02 +01:00
parent f87db65719
commit eaba53b7c8
1 changed files with 5 additions and 53 deletions
Download patch file Download diff file Expand all files Collapse all files

58
module/system/repl/repl.scm
View file

@ -1,6 +1,6 @@
;;; Read-Eval-Print Loop ;;; Read-Eval-Print Loop
;; Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc. ;; Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc.
;; This library is free software; you can redistribute it and/or ;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public ;; modify it under the terms of the GNU Lesser General Public
@ -33,29 +33,6 @@
;;;
;;; Syntax errors
;;;
(define (display-syntax-error port who what where form subform extra)
(format port "Syntax error:~%")
(if where
(let ((file (or (assq-ref where 'filename) "unknown file"))
(line (and=> (assq-ref where 'line) 1+))
(col (assq-ref where 'column)))
(format port "~a:~a:~a: " file line col))
(format port "unknown location: "))
(if who
(format port "~a: " who))
(format port "~a" what)
(if subform
(format port " in subform ~s of ~s" subform form)
(if form
(format port " in form ~s" form)))
(newline port))
;;; ;;;
;;; Meta commands ;;; Meta commands
;;; ;;;
@ -93,17 +70,8 @@
((quit) ((quit)
(apply throw key args)) (apply throw key args))
(else (else
(pmatch (cons key args) (format (current-output-port) "While reading expression:\n")
((syntax-error ,who ,message ,where ,form ,subform . ,rest) (print-exception (current-output-port) #f key args)
(display-syntax-error (current-output-port)
who message where form subform rest))
((_ ,subr ,msg ,args . ,rest)
(format #t "Throw to key `~a' while reading expression:\n" key)
(display-error #f (current-output-port) subr msg args rest))
(else
(format #t "Throw to key `~a' with args `~s' while reading expression.\n"
key args)))
(force-output)
*unspecified*))))) *unspecified*)))))
@ -123,15 +91,7 @@
(lambda () exp) (lambda () exp)
(lambda (key . args) (lambda (key . args)
(format #t "While ~A:~%" string) (format #t "While ~A:~%" string)
(pmatch (cons key args) (print-exception (current-output-port) #f key args)
((syntax-error ,who ,message ,where ,form ,subform . ,rest)
(display-syntax-error (current-output-port)
who message where form subform rest))
((_ ,subr ,msg ,args . ,rest)
(display-error #f (current-output-port) subr msg args rest))
(else
(format #t "ERROR: Throw to key `~a' with args `~s'.\n" key args)))
(force-output)
(abort)))))) (abort))))))
(define (run-repl repl) (define (run-repl repl)
@ -158,15 +118,7 @@
(abort args) (abort args)
(begin (begin
(format #t "While executing meta-command:~%") (format #t "While executing meta-command:~%")
(pmatch args (print-exception (current-output-port) #f k args))))))
((syntax-error ,who ,message ,where ,form ,subform . ,rest)
(display-syntax-error (current-output-port)
who message where form subform rest))
((,subr ,msg ,args . ,rest)
(display-error #f (current-output-port) subr msg args rest))
(else
(format #t "ERROR: Throw to key `~a' with args `~s'.\n" k args)))
(force-output))))))
((eof-object? exp) ((eof-object? exp)
(newline) (newline)
(abort '())) (abort '()))