source: project/release/5/char-set-literals/tags/0.4/char-set-literals.scm @ 36478

Last change on this file since 36478 was 36478, checked in by evhan, 21 months ago

char-set-literals: Port to CHICKEN 5 and tag 0.4

File size: 1.6 KB
Line 
1(module char-set-literals
2
3(read-char-set-literal)
4
5(import (chicken base)
6        (chicken read-syntax)
7        (chicken syntax)
8        (scheme)
9        (srfi 14))
10
11(define (char-range->list lower upper)
12  (char-set->list (ucs-range->char-set (char->integer lower)
13                                       (add1 (char->integer upper)))))
14
15(define (incomplete-error buffer)
16  (syntax-error "Incomplete char-set literal"
17                (string-append "#[" (list->string (reverse buffer)))))
18
19(define (read-char-set-literal #!optional (port (current-input-port)))
20  (let loop ((buffer '()))
21    (let ((char (read-char port)))
22      (case char
23        ((#!eof) (incomplete-error buffer))
24        ((#\]) (list '##core#quote (list->char-set buffer)))
25        ((#\-) (loop (if (null? buffer)
26                         (cons char buffer)
27                         (case (peek-char port)
28                           ((#\]) (cons char buffer))
29                           (else (append (char-range->list (car buffer)
30                                                           (read-char port))
31                                         buffer))))))
32        ((#\\) (let ((escaped-char (read-char)))
33                 (case escaped-char
34                   ((#!eof) (incomplete-error buffer))
35                   ((#\\ #\- #\]) (loop (cons escaped-char buffer)))
36                   (else (syntax-error "Invalid char-set literal escape sequence"
37                                       (string #\\ escaped-char))))))
38        (else (loop (cons char buffer)))))))
39
40(set-sharp-read-syntax! #\[ read-char-set-literal)
41
42)
Note: See TracBrowser for help on using the repository browser.