floyd-library/code/list-error.sld

36 lines
968 B
Scheme

(define-library (list-error)
(import (scheme base))
(export make-list-error
list-error-list
list-error-tail
list-error-message
list-error?
circular-list-error?
dotted-list-error?)
(begin
(define-record-type <list-error>
(make-list-error list tail)
list-error?
(list list-error-list)
(tail list-error-tail))
(define (list-error-message err)
(let ((tail (list-error-tail obj)))
(cond ((null? tail)
"Proper list")
((pair? tail)
"Circular list")
((eq? tail (list-error-list obj))
"Not a list")
(else
"Dotted list"))))
(define (circular-list-error? obj)
(and (list-error? obj)
(pair? (list-error-tail obj))))
(define (dotted-list-error? obj)
(and (list-error? obj)
(not (null-or-pair? (list-error-tail obj)))))))