You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
66 lines
2.5 KiB
Racket
66 lines
2.5 KiB
Racket
#lang racket/base
|
|
(require racket/promise)
|
|
|
|
(provide (all-defined-out))
|
|
|
|
;; mapped-chars : (listof (list nat nat bool))
|
|
(define mapped-chars (make-known-char-range-list))
|
|
|
|
;; get-chars-for-x : (nat -> bool) (listof (list nat nat bool)) -> (listof (cons nat nat))
|
|
(define (get-chars-for char-x? mapped-chars)
|
|
(cond
|
|
[(null? mapped-chars) '()]
|
|
[else
|
|
(define range (car mapped-chars))
|
|
(define low (car range))
|
|
(define high (cadr range))
|
|
(define x (char-x? low))
|
|
(cond
|
|
[(caddr range)
|
|
(if x
|
|
(cons (cons low high) (get-chars-for char-x? (cdr mapped-chars)))
|
|
(get-chars-for char-x? (cdr mapped-chars)))]
|
|
[else
|
|
(let loop ([range-start low]
|
|
[i (car range)]
|
|
[parity x])
|
|
(cond
|
|
[(> i high)
|
|
(if parity
|
|
(cons (cons range-start high) (get-chars-for char-x? (cdr mapped-chars)))
|
|
(get-chars-for char-x? (cdr mapped-chars)))]
|
|
[(eq? parity (char-x? i))
|
|
(loop range-start (add1 i) parity)]
|
|
[parity (cons (cons range-start (sub1 i)) (loop i (add1 i) #f))]
|
|
[else (loop i (add1 i) #t)]))])]))
|
|
|
|
(define (compute-ranges x?)
|
|
(delay (get-chars-for (λ (x) (x? (integer->char x))) mapped-chars)))
|
|
|
|
(define alphabetic-ranges (compute-ranges char-alphabetic?)) ;; 325
|
|
(define lower-case-ranges (compute-ranges char-lower-case?)) ;; 405
|
|
(define upper-case-ranges (compute-ranges char-upper-case?)) ;; 380
|
|
(define title-case-ranges (compute-ranges char-title-case?)) ;; 10
|
|
(define numeric-ranges (compute-ranges char-numeric?)) ;; 47
|
|
(define symbolic-ranges (compute-ranges char-symbolic?)) ;; 153
|
|
(define punctuation-ranges (compute-ranges char-punctuation?)) ;; 86
|
|
(define graphic-ranges (compute-ranges char-graphic?)) ;; 401
|
|
(define whitespace-ranges (compute-ranges char-whitespace?)) ;; 10
|
|
(define blank-ranges (compute-ranges char-blank?)) ;; 9
|
|
#;(define hexadecimal-ranges (compute-ranges char-hexadecimal?))
|
|
(define iso-control-ranges (compute-ranges char-iso-control?)) ;; 2
|
|
|
|
|
|
|
|
(module+ test
|
|
(require rackunit)
|
|
(check-equal? (get-chars-for odd? '()) '())
|
|
(check-equal? (get-chars-for odd? '((1 4 #f) (8 13 #f)))
|
|
'((1 . 1) (3 . 3) (9 . 9) (11 . 11) (13 . 13)))
|
|
(check-equal? (get-chars-for (λ (x)
|
|
(odd? (quotient x 10)))
|
|
'((1 5 #t) (17 19 #t) (21 51 #f)))
|
|
'((17 . 19) (30 . 39) (50 . 51))))
|
|
|
|
|