brag/parser-tools/private-lex/unicode-chars.rkt

#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))))