source: proto/RE/Haskell/ToUTF8.hs @ 3827

Last change on this file since 3827 was 3827, checked in by cameron, 5 years ago

Initial prototype conversion to UTF8

File size: 3.1 KB
Line 
1--
2-- Transformation of Regular Expressions to UTF-8 form
3-- Input: a regular-expression over Unicode codepoints
4--     (CCs are expressed as codepoints).
5-- Output: a regular-expression over UTF-8 byte sequences
6--     (CCs are only byte sequences)
7
8module ToUTF8 (toUTF8) where 
9
10import Data.Bits
11import SparseCharSet
12import CanonicalRE
13import REparse
14
15toUTF8 :: RE -> RE
16
17toUTF8 (Seq rs) = Seq (map toUTF8 rs)
18toUTF8 (Alt rs) = Alt (map toUTF8 rs)
19toUTF8 (Rep (r, ub, lb)) = Rep ((toUTF8 r), ub, lb)
20--
21-- TODO (later): we should probably expand these for
22-- Unicode line breaks.
23--
24toUTF8 Start = Start
25toUTF8 End = End
26--
27toUTF8 (CC s) = mkAlt (map rangeToUTF8 s)
28
29-- Make an Alt, but if there is only one alternative, just return that.
30mkAlt [e] = e
31mkAlt es = Alt es
32
33
34-- Helpers for UTF-8 sequences
35
36u8len :: Int -> Int
37u8len(cp)
38  | cp <= 0x7F   =  1
39  | cp <= 0x7FF  =  2 
40  | cp <= 0xFFFF =  3 
41  | otherwise    =  4
42
43max_of_u8len :: Int -> Int
44max_of_u8len(lgth)
45  | lgth == 1    = 0x7F
46  | lgth == 2    = 0x7FF
47  | lgth == 3    = 0xFFFF
48  | lgth == 4    = 0x10FFFF
49
50u8byte :: (Int, Int) -> Int
51u8byte(codepoint, n) =
52  let len = u8len(codepoint) 
53  in if n == 1 then if len == 1 then codepoint
54                    else if len == 2 then 0xC0 .|. (codepoint `shiftR` 6) 
55                    else if len == 3 then 0xE0 .|. (codepoint `shiftR` 12) 
56                    else 0xF0 .|. (codepoint `shiftR` 18) 
57     else 0x80 .|. (codepoint `shiftR` (6 * (len - n))) .&. 0x3F
58
59makeByteClass(byteval) = CC [CharRange(byteval, byteval)]
60makeByteRange(lo, hi) = CC [CharRange(lo, hi)]
61
62--
63-- Compile a general codepoint range to an RE over UTF-8 bytes
64
65rangeToUTF8 :: CharSetItem -> RE
66
67rangeToUTF8 (CharRange(lo, hi)) =
68   let u8len_lo = u8len(lo)
69       u8len_hi = u8len(hi) in
70   if u8len_lo < u8len_hi then let m = max_of_u8len(u8len_lo)
71                               in Alt [rangeToUTF8(CharRange(lo, m)), rangeToUTF8(CharRange(m + 1, hi))]
72   else rangeToU8_helper(lo, hi, 1, u8len_hi)
73 
74rangeToU8_helper :: (Int, Int, Int, Int) -> RE
75rangeToU8_helper(lo, hi, n, hlen) =
76   let hbyte = u8byte(hi, n)
77       lbyte = u8byte(lo, n)
78   in if n == hlen then makeByteRange(lbyte, hbyte)
79   else if hbyte == lbyte then Seq [makeByteClass(hbyte), rangeToU8_helper(lo, hi, n+1, hlen)]
80   else let suffix_mask = (1 `shiftL` ((hlen - n) * 6)) - 1 :: Int
81        in if hi .&. suffix_mask /= suffix_mask then let hi_floor = (complement suffix_mask) .&. hi
82                                                     in Alt [rangeToU8_helper(hi_floor, hi, n, hlen), 
83                                                             rangeToU8_helper(lo, hi_floor - 1, n, hlen)]
84        else if lo .&. suffix_mask /= 0 then let low_ceil = lo .|. suffix_mask
85                                             in Alt [rangeToU8_helper(low_ceil+1, hi, n, hlen), 
86                                                     rangeToU8_helper(lo, low_ceil, n, hlen)]
87        else Seq [makeByteRange(lbyte, hbyte), rangeToU8_helper(lo, hi, n+1, hlen)]
88
89
90parseToUTF8 :: String -> Maybe RE
91parseToUTF8 s = case (parseRE s) of
92                  ParseSuccess e   -> Just (toUTF8 e)
93                  _                -> Nothing
Note: See TracBrowser for help on using the repository browser.