(module char-set-literals

(read-char-set-literal)

(import (chicken base)
        (chicken read-syntax)
        (chicken syntax)
        (scheme)
        (srfi 14))

(define (char-range->list lower upper)
  (char-set->list (ucs-range->char-set (char->integer lower)
                                       (add1 (char->integer upper)))))

(define (incomplete-error buffer)
  (syntax-error "Incomplete char-set literal"
                (string-append "#[" (list->string (reverse buffer)))))

(define (read-char-set-literal #!optional (port (current-input-port)))
  (let loop ((buffer '()))
    (let ((char (read-char port)))
      (case char
        ((#!eof) (incomplete-error buffer))
        ((#\]) (list '##core#quote (list->char-set buffer)))
        ((#\-) (loop (if (null? buffer)
                         (cons char buffer)
                         (case (peek-char port)
                           ((#\]) (cons char buffer))
                           (else (append (char-range->list (car buffer)
                                                           (read-char port))
                                         buffer))))))
        ((#\\) (let ((escaped-char (read-char)))
                 (case escaped-char
                   ((#!eof) (incomplete-error buffer))
                   ((#\\ #\- #\]) (loop (cons escaped-char buffer)))
                   (else (syntax-error "Invalid char-set literal escape sequence"
                                       (string #\\ escaped-char))))))
        (else (loop (cons char buffer)))))))

(set-sharp-read-syntax! #\[ read-char-set-literal)

)