Changeset 37335 in project


Ignore:
Timestamp:
03/01/19 19:10:58 (3 months ago)
Author:
kooda
Message:

utf8 egg: embed case mapping data into binaries

Location:
release/5/utf8/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/5/utf8/trunk/utf8-case-map.scm

    r36058 r37335  
    3737;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    3838
    39 (define *data-file-path*
    40   (list "./data" (chicken-home)))
    41 
    42 (define (find-data-file name)
    43   (let lp ((ls *data-file-path*))
    44     (and (pair? ls)
    45          (let ((path (string-append (car ls) "/" name)))
    46            (if (file-exists? path)
    47              path
    48              (lp (cdr ls)))))))
    49 
    5039(define char->ucs char->integer)
    5140(define ucs->char integer->char)
    52 
    53 (define read-binary-uint32-le
    54   ;; files distributed as little-endian in egg
    55   (lambda (port)
    56     (let* ((b1 (read-byte port)) (b2 (read-byte port))
    57            (b3 (read-byte port)) (b4 (read-byte port)))
    58       (if (eof-object? b4)
    59           b4
    60           (bitwise-ior
    61            b1
    62            (arithmetic-shift b2 8)
    63            (arithmetic-shift b3 16)
    64            (arithmetic-shift b4 24))))))
    65 
    66 (define read-binary-uint16-le
    67   ;; files distributed as little-endian in egg
    68   (lambda (port)
    69     (let* ((b1 (read-byte port)) (b2 (read-byte port)))
    70       (if (eof-object? b2)
    71           b2
    72           (bitwise-ior b1 (arithmetic-shift b2 8))))))
    73 
    74 ;; currently only defined for u16 and u32 vectors
    75 (define (read-block! vec port)
    76   (cond
    77     ((u16vector? vec)
    78      (let ((len (u16vector-length vec)))
    79        (do ((i 0 (+ i 1)))
    80            ((= i len))
    81          (u16vector-set! vec i (read-binary-uint16-le port)))))
    82     ((u32vector? vec)
    83      (let ((len (u32vector-length vec)))
    84        (do ((i 0 (+ i 1)))
    85            ((= i len))
    86          (u32vector-set! vec i (read-binary-uint32-le port)))))
    87     (else
    88      (error 'read-block! "unsupported type" vec))))
    8941
    9042(define (with-string-io* s thunk)
     
    10254;; simple case conversions
    10355
    104 (define *char-case-file-1* "case-map-1.dat")
    105 
    106 (define *char-case-table-1*
    107   (or (condition-case
    108           (and-let* ((file (find-data-file *char-case-file-1*))
    109                      (size (file-size file))
    110                      (vec (make-u32vector (quotient size 4))))
    111             (call-with-input-file file
    112               (cut read-block! vec <>) #:binary)
    113             vec)
    114         (var () #f))
    115       (begin
    116         (warning "couldn't load case-map-1.dat")
    117         (make-u32vector 0))))
     56(define *char-case-table-1* (include "case-map-1.dat"))
    11857
    11958(define *char-case-count-1*
     
    166105;; special casing
    167106
    168 (define *char-case-file-2* "case-map-2.dat")
    169 
    170 (define *char-case-table-2*
    171   (or (and-let* ((file (find-data-file *char-case-file-2*)))
    172         (condition-case
    173             (with-input-from-file file read)
    174           (var () #f)))
    175       (begin
    176         (warning "couldn't load case-map-2.dat")
    177         '#())))
    178 
     107(define *char-case-table-2* (include "case-map-2.dat"))
    179108(define *char-case-length-2* (vector-length *char-case-table-2*))
    180109
Note: See TracChangeset for help on using the changeset viewer.