#lang racket/base (require racket/promise yaragg-parser-tools/private-lex/util) (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) null] [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))))