/usr/share/scheme48-1.9/big/signal.scm is in scheme48 1.9-5.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 | ; Part of Scheme 48 1.9. See file COPYING for notices and license.
; Authors: Richard Kelsey, Jonathan Rees, Mike Sperber
; For backwards compatibility with old versions of Scheme 48
; only---don't use in new code.
;;;; Signalling conditions
; I don't like the term "signal," but that's the one Gnu Emacs Lisp,
; Common Lisp, and Dylan use, so it's probably best to stick with it.
(define (make-condition type stuff)
(let ((base
(case type
((error) (make-error))
((warning) (make-warning))
((note) (make-note))
((syntax-error) (make-syntax-violation #f #f))
((call-error) (make-assertion-violation))
(else (make-assertion-violation)))))
(call-with-values
(lambda ()
(cond
((null? stuff) (values #f '()))
((string? (car stuff)) (values (car stuff) (cdr stuff)))
(else (values #f stuff))))
(lambda (message irritants)
(let* ((con
(if message
(condition base
(make-message-condition message))
base))
(con
(condition con (make-irritants-condition irritants))))
con)))))
(define (signal type . stuff)
(signal-condition
(make-condition type stuff)))
; Error
(define (error message . irritants)
(apply signal 'error message irritants))
; Warn
(define (warn message . irritants)
(signal-condition (make-condition 'warning (cons message irritants))))
; Note
(define (note message . irritants)
(signal-condition (make-condition 'note (cons message irritants))))
; Syntax errors
(define (syntax-error message . rest) ; Must return a valid expression.
(signal-condition (make-condition 'syntax-error (cons message rest)))
''syntax-error)
; "Call error" - this means that the condition's "stuff" (cdr) is of
; the form (message procedure . args), and should be displayed appropriately.
; Proceeding from such an error should return the value that the call
; to the procedure on the args should have returned.
(define (call-error message proc . args)
(signal-condition (make-condition 'call-error
(cons message (cons proc args)))))
|