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

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

simplifier for regexps

File size: 3.0 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
30-- Helpers for UTF-8 sequences
31
32u8len :: Int -> Int
33u8len(cp)
34  | cp <= 0x7F   =  1
35  | cp <= 0x7FF  =  2 
36  | cp <= 0xFFFF =  3 
37  | otherwise    =  4
38
39max_of_u8len :: Int -> Int
40max_of_u8len(lgth)
41  | lgth == 1    = 0x7F
42  | lgth == 2    = 0x7FF
43  | lgth == 3    = 0xFFFF
44  | lgth == 4    = 0x10FFFF
45
46u8byte :: (Int, Int) -> Int
47u8byte(codepoint, n) =
48  let len = u8len(codepoint) 
49  in if n == 1 then if len == 1 then codepoint
50                    else if len == 2 then 0xC0 .|. (codepoint `shiftR` 6) 
51                    else if len == 3 then 0xE0 .|. (codepoint `shiftR` 12) 
52                    else 0xF0 .|. (codepoint `shiftR` 18) 
53     else 0x80 .|. (codepoint `shiftR` (6 * (len - n))) .&. 0x3F
54
55makeByteClass(byteval) = CC [CharRange(byteval, byteval)]
56makeByteRange(lo, hi) = CC [CharRange(lo, hi)]
57
58--
59-- Compile a general codepoint range to an RE over UTF-8 bytes
60
61rangeToUTF8 :: CharSetItem -> RE
62
63rangeToUTF8 (CharRange(lo, hi)) =
64   let u8len_lo = u8len(lo)
65       u8len_hi = u8len(hi) in
66   if u8len_lo < u8len_hi then let m = max_of_u8len(u8len_lo)
67                               in Alt [rangeToUTF8(CharRange(lo, m)), rangeToUTF8(CharRange(m + 1, hi))]
68   else rangeToU8_helper(lo, hi, 1, u8len_hi)
69 
70rangeToU8_helper :: (Int, Int, Int, Int) -> RE
71rangeToU8_helper(lo, hi, n, hlen) =
72   let hbyte = u8byte(hi, n)
73       lbyte = u8byte(lo, n)
74   in if n == hlen then makeByteRange(lbyte, hbyte)
75   else if hbyte == lbyte then Seq [makeByteClass(hbyte), rangeToU8_helper(lo, hi, n+1, hlen)]
76   else let suffix_mask = (1 `shiftL` ((hlen - n) * 6)) - 1 :: Int
77        in if hi .&. suffix_mask /= suffix_mask then let hi_floor = (complement suffix_mask) .&. hi
78                                                     in Alt [rangeToU8_helper(hi_floor, hi, n, hlen), 
79                                                             rangeToU8_helper(lo, hi_floor - 1, n, hlen)]
80        else if lo .&. suffix_mask /= 0 then let low_ceil = lo .|. suffix_mask
81                                             in Alt [rangeToU8_helper(low_ceil+1, hi, n, hlen), 
82                                                     rangeToU8_helper(lo, low_ceil, n, hlen)]
83        else Seq [makeByteRange(lbyte, hbyte), rangeToU8_helper(lo, hi, n+1, hlen)]
84
85
86parseToUTF8 :: String -> Maybe RE
87parseToUTF8 s = case (parseRE s) of
88                  ParseSuccess e   -> Just (toUTF8 e)
89                  _                -> Nothing
Note: See TracBrowser for help on using the repository browser.