git.iko.soy/elk
on c19392f help sign in
elk/src/Parse/Primitives/Variable.hs
374 lines 9.9 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 !foreign = toForeign fp offset start end
130 !newState = State fp end terminal indent row newCol ctx
131 in
132 cok foreign newState noError
135foreignUpperHelp :: ForeignPtr Word8 -> Int -> Int -> Int -> (# Int, Int, Int #)
136foreignUpperHelp fp offset terminal col =
137 let
138 (# newOffset, newCol #) = chompUpper fp offset terminal col
139 in
140 if offset == newOffset then
141 (# offset, offset, col #)
143 else if isDot fp newOffset terminal then
144 foreignUpperHelp fp (newOffset + 1) terminal (newCol + 1)
146 else
147 (# offset, newOffset, newCol #)
151-- FOREIGN ALPHA
154foreignAlpha :: Parser (Maybe Text, Text)
155foreignAlpha =
156 Parser $ \(State fp offset terminal indent row col ctx) cok _ _ eerr ->
157 let (# start, end, newCol #) = foreignAlphaHelp fp offset terminal col in
158 if start == end then
159 eerr (E.ParseError row newCol (E.Theories ctx [E.LowVar, E.CapVar]))
160 else
161 cok (toForeign fp offset start end) (State fp end terminal indent row newCol ctx) noError
164foreignAlphaHelp :: ForeignPtr Word8 -> Int -> Int -> Int -> (# Int, Int, Int #)
165foreignAlphaHelp fp offset terminal col =
166 let
167 (# lowerOffset, lowerCol #) = chompLower fp offset terminal col
168 in
169 if offset < lowerOffset then
170 (# offset, lowerOffset, lowerCol #)
172 else
173 let
174 (# upperOffset, upperCol #) = chompUpper fp offset terminal col
175 in
176 if offset == upperOffset then
177 (# offset, offset, col #)
179 else if isDot fp upperOffset terminal then
180 foreignAlphaHelp fp (upperOffset + 1) terminal (upperCol + 1)
182 else
183 (# offset, upperOffset, upperCol #)
187-- TO FOREIGN NAME
190toForeign :: ForeignPtr Word8 -> Int -> Int -> Int -> ( Maybe Text, Text )
191toForeign fp offset start end =
192 let
193 !qualifier =
194 if start == offset then
195 Nothing
196 else
197 Just (Text.decodeUtf8 (B.PS fp offset ((start - 1) - offset)))
199 !variable =
200 Text.decodeUtf8 (B.PS fp start (end - start))
201 in
202 ( qualifier, variable )
207---- CHAR CHOMPERS ----
211-- DOTS
214{-# INLINE isDot #-}
215isDot :: ForeignPtr Word8 -> Int -> Int -> Bool
216isDot fp offset terminal =
217 offset < terminal && unsafeIndex fp offset == 0x2e {- . -}
221-- UPPER CHARS
224chompUpper :: ForeignPtr Word8 -> Int -> Int -> Int -> (# Int, Int #)
225chompUpper fp offset terminal col =
226 let !width = getUpperWidth fp offset terminal in
227 if width == 0 then
228 (# offset, col #)
229 else
230 chompInnerChars fp (offset + width) terminal (col + 1)
233{-# INLINE getUpperWidth #-}
234getUpperWidth :: ForeignPtr Word8 -> Int -> Int -> Int
235getUpperWidth fp offset terminal =
236 if offset < terminal then
237 getUpperWidthHelp fp offset terminal (unsafeIndex fp offset)
238 else
239 0
242{-# INLINE getUpperWidthHelp #-}
243getUpperWidthHelp :: ForeignPtr Word8 -> Int -> Int -> Word8 -> Int
244getUpperWidthHelp fp offset terminal word
245 | 0x41 {- A -} <= word && word <= 0x5A {- Z -} = 1
246 | word < 0xc0 = 0
247 | word < 0xe0 = if Char.isUpper (getChar2 fp offset terminal word) then 2 else 0
248 | word < 0xf0 = if Char.isUpper (getChar3 fp offset terminal word) then 3 else 0
249 | word < 0xf8 = if Char.isUpper (getChar4 fp offset terminal word) then 4 else 0
250 | True = 0
254-- LOWER CHARS
257chompLower :: ForeignPtr Word8 -> Int -> Int -> Int -> (# Int, Int #)
258chompLower fp offset terminal col =
259 let !width = getLowerWidth fp offset terminal in
260 if width == 0 then
261 (# offset, col #)
262 else
263 chompInnerChars fp (offset + width) terminal (col + 1)
266{-# INLINE getLowerWidth #-}
267getLowerWidth :: ForeignPtr Word8 -> Int -> Int -> Int
268getLowerWidth fp offset terminal =
269 if offset < terminal then
270 getLowerWidthHelp fp offset terminal (unsafeIndex fp offset)
271 else
272 0
275{-# INLINE getLowerWidthHelp #-}
276getLowerWidthHelp :: ForeignPtr Word8 -> Int -> Int -> Word8 -> Int
277getLowerWidthHelp fp offset terminal word
278 | 0x61 {- a -} <= word && word <= 0x7A {- z -} = 1
279 | word < 0xc0 = 0
280 | word < 0xe0 = if Char.isLower (getChar2 fp offset terminal word) then 2 else 0
281 | word < 0xf0 = if Char.isLower (getChar3 fp offset terminal word) then 3 else 0
282 | word < 0xf8 = if Char.isLower (getChar4 fp offset terminal word) then 4 else 0
283 | True = 0
287-- INNER CHARS
290chompInnerChars :: ForeignPtr Word8 -> Int -> Int -> Int -> (# Int, Int #)
291chompInnerChars fp !offset terminal !col =
292 let !width = getInnerWidth fp offset terminal in
293 if width == 0 then
294 (# offset, col #)
295 else
296 chompInnerChars fp (offset + width) terminal (col + 1)
299getInnerWidth :: ForeignPtr Word8 -> Int -> Int -> Int
300getInnerWidth fp offset terminal =
301 if offset < terminal then
302 getInnerWidthHelp fp offset terminal (unsafeIndex fp offset)
303 else
304 0
307{-# INLINE getInnerWidthHelp #-}
308getInnerWidthHelp :: ForeignPtr Word8 -> Int -> Int -> Word8 -> Int
309getInnerWidthHelp fp offset terminal word
310 | 0x61 {- a -} <= word && word <= 0x7A {- z -} = 1
311 | 0x41 {- A -} <= word && word <= 0x5A {- Z -} = 1
312 | 0x30 {- 0 -} <= word && word <= 0x39 {- 9 -} = 1
313 | word == 0x5F {- _ -} = 1
314 | word < 0xc0 = 0
315 | word < 0xe0 = if Char.isAlpha (getChar2 fp offset terminal word) then 2 else 0
316 | word < 0xf0 = if Char.isAlpha (getChar3 fp offset terminal word) then 3 else 0
317 | word < 0xf8 = if Char.isAlpha (getChar4 fp offset terminal word) then 4 else 0
318 | True = 0
322-- EXTRACT CHARACTERS
325push :: Word8 -> Int -> Int
326push word code =
327 assert (word .&. 0xc0 == 0x80) (
328 shiftL code 6 .|. fromEnum (word .&. 0x3f)
329 )
332getChar2 :: ForeignPtr Word8 -> Int -> Int -> Word8 -> Char
333getChar2 fp offset terminal word =
334 assert (offset + 2 <= terminal) (
335 let
336 !word1 = word .&. 0x1f
337 !word2 = unsafeIndex fp (offset + 1)
338 !code = push word2 (fromEnum word1)
339 in
340 assert (0x80 <= code) (
341 toEnum code
342 )
343 )
346getChar3 :: ForeignPtr Word8 -> Int -> Int -> Word8 -> Char
347getChar3 fp offset terminal word =
348 assert (offset + 3 <= terminal) (
349 let
350 !word1 = word .&. 0x0f
351 !word2 = unsafeIndex fp (offset + 1)
352 !word3 = unsafeIndex fp (offset + 2)
353 !code = push word3 (push word2 (fromEnum word1))
354 in
355 assert ((0x800 <= code && code < 0xd800) || (0xdfff < code && code < 0xfffe)) (
356 toEnum code
357 )
358 )
361getChar4 :: ForeignPtr Word8 -> Int -> Int -> Word8 -> Char
362getChar4 fp offset terminal word =
363 assert (offset + 4 <= terminal) (
364 let
365 !word1 = word .&. 0x07
366 !word2 = unsafeIndex fp (offset + 1)
367 !word3 = unsafeIndex fp (offset + 2)
368 !word4 = unsafeIndex fp (offset + 3)
369 !code = push word4 (push word3 (push word2 (fromEnum word1)))
370 in
371 assert (0x10000 <= code && code < 0x110000) (
372 toEnum code
373 )
374 )