git.iko.soy/elk
on 2deedfb help sign in
elk/src/Parse/Primitives/Variable.hs
371 lines 10 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE BangPatterns, UnboxedTuples, OverloadedStrings #-}
3module Parse.Primitives.Variable
4 ( lower
5 , upper
6 , moduleName
7 , foreignUpper
8 , foreignAlpha
9 , chompInnerChars
10 , getInnerWidth
11 , getInnerWidthHelp
12 )
13 where
16import Control.Exception (assert)
17import Data.Bits ((.&.), (.|.), shiftL)
18import qualified Data.ByteString.Internal as B
19import qualified Data.Char as Char
20import qualified Data.Set as Set
21import Data.Text (Text)
22import qualified Data.Text.Encoding as Text
23import Foreign.ForeignPtr (ForeignPtr)
24import GHC.Word (Word8)
26import Parse.Primitives.Internals (Parser(..), State(..), expect, noError, unsafeIndex)
27import qualified Reporting.Error.Syntax as E
31-- LOCAL UPPER
34upper :: Parser Text
35upper =
36 Parser $ \(State fp offset terminal indent row col ctx) cok _ _ eerr ->
37 let (# newOffset, newCol #) = chompUpper fp offset terminal col in
38 if offset == newOffset then
39 eerr (expect row col ctx E.CapVar)
40 else
41 let !variable = Text.decodeUtf8 (B.PS fp offset (newOffset - offset)) in
42 cok variable (State fp newOffset terminal indent row newCol ctx) noError
46-- LOCAL LOWER
49lower :: Parser Text
50lower =
51 Parser $ \(State fp offset terminal indent row col ctx) cok _ _ eerr ->
52 let (# newOffset, newCol #) = chompLower fp offset terminal col in
53 if offset == newOffset then
54 eerr (expect row col ctx E.LowVar)
55 else
56 let !variable = Text.decodeUtf8 (B.PS fp offset (newOffset - offset)) in
57 if Set.member variable reservedWords then
58 eerr (expect row col ctx E.LowVar)
59 else
60 cok variable (State fp newOffset terminal indent row newCol ctx) noError
63{-# NOINLINE reservedWords #-}
64reservedWords :: Set.Set Text
65reservedWords =
66 Set.fromList
67 [ "if", "then", "else"
68 , "case", "of"
69 , "let", "in"
70 , "type"
71 , "module", "where"
72 , "import", "exposing"
73 , "as"
74 , "port"
75 ]
79-- MODULE NAME
82moduleName :: Parser Text
83moduleName =
84 Parser $ \(State fp offset terminal indent row col ctx) cok _ _ eerr ->
85 let (# newOffset, newCol #) = chompUpper fp offset terminal col in
86 case moduleNameHelp fp newOffset terminal newCol of
87 Bad badCol ->
88 eerr (expect row badCol ctx E.CapVar)
90 Good end endCol ->
91 let
92 !name = Text.decodeUtf8 (B.PS fp offset (end - offset))
93 !newState = State fp end terminal indent row endCol ctx
94 in
95 cok name newState noError
98data ModuleName = Bad Int | Good Int Int
101moduleNameHelp :: ForeignPtr Word8 -> Int -> Int -> Int -> ModuleName
102moduleNameHelp fp offset terminal col =
103 if isDot fp offset terminal then
104 let
105 !offset1 = offset + 1
106 (# newOffset, newCol #) = chompUpper fp offset1 terminal (col + 1)
107 in
108 if offset1 == newOffset then
109 Bad newCol
110 else
111 moduleNameHelp fp newOffset terminal newCol
113 else
114 Good offset col
118-- FOREIGN UPPER
121foreignUpper :: Parser (Maybe Text, Text)
122foreignUpper =
123 Parser $ \(State fp offset terminal indent row col ctx) cok _ _ eerr ->
124 let (# start, end, newCol #) = foreignUpperHelp fp offset terminal col in
125 if start == end then
126 eerr (expect row newCol ctx E.CapVar)
127 else
128 let
129 !newState = State fp end terminal indent row newCol ctx
130 !variable = Text.decodeUtf8 (B.PS fp start (end - start))
131 !foreign =
132 if start == offset then
133 (Nothing, variable)
134 else
135 let !home = Text.decodeUtf8 (B.PS fp offset ((start - 1) - offset)) in
136 (Just home, variable)
137 in
138 cok foreign newState noError
141foreignUpperHelp :: ForeignPtr Word8 -> Int -> Int -> Int -> (# Int, Int, Int #)
142foreignUpperHelp fp offset terminal col =
143 let
144 (# newOffset, newCol #) = chompUpper fp offset terminal col
145 in
146 if offset == newOffset then
147 (# offset, offset, col #)
149 else if isDot fp newOffset terminal then
150 foreignUpperHelp fp (newOffset + 1) terminal (newCol + 1)
152 else
153 (# offset, newOffset, newCol #)
157-- FOREIGN ALPHA
160foreignAlpha :: Parser (Maybe Text, Text)
161foreignAlpha =
162 Parser $ \(State fp offset terminal indent row col ctx) cok _ _ eerr ->
163 let (# start, end, newCol #) = foreignAlphaHelp fp offset terminal col in
164 if start == end then
165 eerr (E.ParseError row newCol (E.Theories ctx [E.LowVar, E.CapVar]))
166 else
167 let
168 !newState = State fp end terminal indent row newCol ctx
169 !variable = Text.decodeUtf8 (B.PS fp start (end - start))
170 in
171 if start == offset then
172 if Set.member variable reservedWords then
173 eerr noError
174 else
175 cok (Nothing, variable) newState noError
176 else
177 let !home = Text.decodeUtf8 (B.PS fp offset ((start - 1) - offset)) in
178 cok (Just home, variable) newState noError
181foreignAlphaHelp :: ForeignPtr Word8 -> Int -> Int -> Int -> (# Int, Int, Int #)
182foreignAlphaHelp fp offset terminal col =
183 let
184 (# lowerOffset, lowerCol #) = chompLower fp offset terminal col
185 in
186 if offset < lowerOffset then
187 (# offset, lowerOffset, lowerCol #)
189 else
190 let
191 (# upperOffset, upperCol #) = chompUpper fp offset terminal col
192 in
193 if offset == upperOffset then
194 (# offset, offset, col #)
196 else if isDot fp upperOffset terminal then
197 foreignAlphaHelp fp (upperOffset + 1) terminal (upperCol + 1)
199 else
200 (# offset, upperOffset, upperCol #)
204---- CHAR CHOMPERS ----
208-- DOTS
211{-# INLINE isDot #-}
212isDot :: ForeignPtr Word8 -> Int -> Int -> Bool
213isDot fp offset terminal =
214 offset < terminal && unsafeIndex fp offset == 0x2e {- . -}
218-- UPPER CHARS
221chompUpper :: ForeignPtr Word8 -> Int -> Int -> Int -> (# Int, Int #)
222chompUpper fp offset terminal col =
223 let !width = getUpperWidth fp offset terminal in
224 if width == 0 then
225 (# offset, col #)
226 else
227 chompInnerChars fp (offset + width) terminal (col + 1)
230{-# INLINE getUpperWidth #-}
231getUpperWidth :: ForeignPtr Word8 -> Int -> Int -> Int
232getUpperWidth fp offset terminal =
233 if offset < terminal then
234 getUpperWidthHelp fp offset terminal (unsafeIndex fp offset)
235 else
236 0
239{-# INLINE getUpperWidthHelp #-}
240getUpperWidthHelp :: ForeignPtr Word8 -> Int -> Int -> Word8 -> Int
241getUpperWidthHelp fp offset terminal word
242 | 0x41 {- A -} <= word && word <= 0x5A {- Z -} = 1
243 | word < 0xc0 = 0
244 | word < 0xe0 = if Char.isUpper (getChar2 fp offset terminal word) then 2 else 0
245 | word < 0xf0 = if Char.isUpper (getChar3 fp offset terminal word) then 3 else 0
246 | word < 0xf8 = if Char.isUpper (getChar4 fp offset terminal word) then 4 else 0
247 | True = 0
251-- LOWER CHARS
254chompLower :: ForeignPtr Word8 -> Int -> Int -> Int -> (# Int, Int #)
255chompLower fp offset terminal col =
256 let !width = getLowerWidth fp offset terminal in
257 if width == 0 then
258 (# offset, col #)
259 else
260 chompInnerChars fp (offset + width) terminal (col + 1)
263{-# INLINE getLowerWidth #-}
264getLowerWidth :: ForeignPtr Word8 -> Int -> Int -> Int
265getLowerWidth fp offset terminal =
266 if offset < terminal then
267 getLowerWidthHelp fp offset terminal (unsafeIndex fp offset)
268 else
269 0
272{-# INLINE getLowerWidthHelp #-}
273getLowerWidthHelp :: ForeignPtr Word8 -> Int -> Int -> Word8 -> Int
274getLowerWidthHelp fp offset terminal word
275 | 0x61 {- a -} <= word && word <= 0x7A {- z -} = 1
276 | word < 0xc0 = 0
277 | word < 0xe0 = if Char.isLower (getChar2 fp offset terminal word) then 2 else 0
278 | word < 0xf0 = if Char.isLower (getChar3 fp offset terminal word) then 3 else 0
279 | word < 0xf8 = if Char.isLower (getChar4 fp offset terminal word) then 4 else 0
280 | True = 0
284-- INNER CHARS
287chompInnerChars :: ForeignPtr Word8 -> Int -> Int -> Int -> (# Int, Int #)
288chompInnerChars fp !offset terminal !col =
289 let !width = getInnerWidth fp offset terminal in
290 if width == 0 then
291 (# offset, col #)
292 else
293 chompInnerChars fp (offset + width) terminal (col + 1)
296getInnerWidth :: ForeignPtr Word8 -> Int -> Int -> Int
297getInnerWidth fp offset terminal =
298 if offset < terminal then
299 getInnerWidthHelp fp offset terminal (unsafeIndex fp offset)
300 else
301 0
304{-# INLINE getInnerWidthHelp #-}
305getInnerWidthHelp :: ForeignPtr Word8 -> Int -> Int -> Word8 -> Int
306getInnerWidthHelp fp offset terminal word
307 | 0x61 {- a -} <= word && word <= 0x7A {- z -} = 1
308 | 0x41 {- A -} <= word && word <= 0x5A {- Z -} = 1
309 | 0x30 {- 0 -} <= word && word <= 0x39 {- 9 -} = 1
310 | word == 0x5F {- _ -} = 1
311 | word < 0xc0 = 0
312 | word < 0xe0 = if Char.isAlpha (getChar2 fp offset terminal word) then 2 else 0
313 | word < 0xf0 = if Char.isAlpha (getChar3 fp offset terminal word) then 3 else 0
314 | word < 0xf8 = if Char.isAlpha (getChar4 fp offset terminal word) then 4 else 0
315 | True = 0
319-- EXTRACT CHARACTERS
322push :: Word8 -> Int -> Int
323push word code =
324 assert (word .&. 0xc0 == 0x80) (
325 shiftL code 6 .|. fromEnum (word .&. 0x3f)
326 )
329getChar2 :: ForeignPtr Word8 -> Int -> Int -> Word8 -> Char
330getChar2 fp offset terminal word =
331 assert (offset + 2 <= terminal) (
332 let
333 !word1 = word .&. 0x1f
334 !word2 = unsafeIndex fp (offset + 1)
335 !code = push word2 (fromEnum word1)
336 in
337 assert (0x80 <= code) (
338 toEnum code
339 )
340 )
343getChar3 :: ForeignPtr Word8 -> Int -> Int -> Word8 -> Char
344getChar3 fp offset terminal word =
345 assert (offset + 3 <= terminal) (
346 let
347 !word1 = word .&. 0x0f
348 !word2 = unsafeIndex fp (offset + 1)
349 !word3 = unsafeIndex fp (offset + 2)
350 !code = push word3 (push word2 (fromEnum word1))
351 in
352 assert ((0x800 <= code && code < 0xd800) || (0xdfff < code && code < 0xfffe)) (
353 toEnum code
354 )
355 )
358getChar4 :: ForeignPtr Word8 -> Int -> Int -> Word8 -> Char
359getChar4 fp offset terminal word =
360 assert (offset + 4 <= terminal) (
361 let
362 !word1 = word .&. 0x07
363 !word2 = unsafeIndex fp (offset + 1)
364 !word3 = unsafeIndex fp (offset + 2)
365 !word4 = unsafeIndex fp (offset + 3)
366 !code = push word4 (push word3 (push word2 (fromEnum word1)))
367 in
368 assert (0x10000 <= code && code < 0x110000) (
369 toEnum code
370 )
371 )