git.iko.soy/elk
on 00a3069 help sign in
elk/src/Parse/Primitives/Variable.hs
377 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 , Upper(..)
8 , foreignUpper
9 , foreignAlpha
10 , chompInnerChars
11 , getInnerWidth
12 , getInnerWidthHelp
13 )
14 where
17import Control.Exception (assert)
18import Data.Bits ((.&.), (.|.), shiftL)
19import qualified Data.Char as Char
20import qualified Data.Set as Set
21import Data.Text (Text)
22import Foreign.ForeignPtr (ForeignPtr)
23import GHC.Word (Word8)
25import qualified AST.Source as Src
26import qualified Elm.Name as N
27import Parse.Primitives.Internals (Parser(..), State(..), expect, noError, unsafeIndex)
28import qualified Reporting.Error.Syntax as E
32-- LOCAL UPPER
35upper :: Parser Text
36upper =
37 Parser $ \(State fp offset terminal indent row col ctx) cok _ _ eerr ->
38 let (# newOffset, newCol #) = chompUpper fp offset terminal col in
39 if offset == newOffset then
40 eerr (expect row col ctx E.CapVar)
41 else
42 let !name = N.fromForeignPtr fp offset (newOffset - offset) in
43 cok name (State fp newOffset terminal indent row newCol ctx) noError
47-- LOCAL LOWER
50lower :: Parser Text
51lower =
52 Parser $ \(State fp offset terminal indent row col ctx) cok _ _ eerr ->
53 let (# newOffset, newCol #) = chompLower fp offset terminal col in
54 if offset == newOffset then
55 eerr (expect row col ctx E.LowVar)
56 else
57 let !name = N.fromForeignPtr fp offset (newOffset - offset) in
58 if Set.member name reservedWords then
59 eerr (expect row col ctx E.LowVar)
60 else
61 cok name (State fp newOffset terminal indent row newCol ctx) noError
64{-# NOINLINE reservedWords #-}
65reservedWords :: Set.Set Text
66reservedWords =
67 Set.fromList
68 [ "if", "then", "else"
69 , "case", "of"
70 , "let", "in"
71 , "type"
72 , "module", "where"
73 , "import", "exposing"
74 , "as"
75 , "port"
76 ]
80-- MODULE NAME
83moduleName :: Parser Text
84moduleName =
85 Parser $ \(State fp offset terminal indent row col ctx) cok _ _ eerr ->
86 let (# newOffset, newCol #) = chompUpper fp offset terminal col in
87 case moduleNameHelp fp newOffset terminal newCol of
88 Bad badCol ->
89 eerr (expect row badCol ctx E.CapVar)
91 Good end endCol ->
92 let
93 !name = N.fromForeignPtr fp offset (end - offset)
94 !newState = State fp end terminal indent row endCol ctx
95 in
96 cok name newState noError
99data ModuleName = Bad Int | Good Int Int
102moduleNameHelp :: ForeignPtr Word8 -> Int -> Int -> Int -> ModuleName
103moduleNameHelp fp offset terminal col =
104 if isDot fp offset terminal then
105 let
106 !offset1 = offset + 1
107 (# newOffset, newCol #) = chompUpper fp offset1 terminal (col + 1)
108 in
109 if offset1 == newOffset then
110 Bad newCol
111 else
112 moduleNameHelp fp newOffset terminal newCol
114 else
115 Good offset col
119-- FOREIGN UPPER
122data Upper
123 = Unqualified N.Name
124 | Qualified N.Name N.Name
127foreignUpper :: Parser Upper
128foreignUpper =
129 Parser $ \(State fp offset terminal indent row col ctx) cok _ _ eerr ->
130 let (# start, end, newCol #) = foreignUpperHelp fp offset terminal col in
131 if start == end then
132 eerr (expect row newCol ctx E.CapVar)
133 else
134 let
135 !newState = State fp end terminal indent row newCol ctx
136 !name = N.fromForeignPtr fp start (end - start)
137 !foreign =
138 if start == offset then
139 Unqualified name
140 else
141 let !home = N.fromForeignPtr fp offset ((start - 1) - offset) in
142 Qualified home name
143 in
144 cok foreign newState noError
147foreignUpperHelp :: ForeignPtr Word8 -> Int -> Int -> Int -> (# Int, Int, Int #)
148foreignUpperHelp fp offset terminal col =
149 let
150 (# newOffset, newCol #) = chompUpper fp offset terminal col
151 in
152 if offset == newOffset then
153 (# offset, offset, col #)
155 else if isDot fp newOffset terminal then
156 foreignUpperHelp fp (newOffset + 1) terminal (newCol + 1)
158 else
159 (# offset, newOffset, newCol #)
163-- FOREIGN ALPHA
166foreignAlpha :: Parser Src.Expr_
167foreignAlpha =
168 Parser $ \(State fp offset terminal indent row col ctx) cok _ _ eerr ->
169 let (# start, end, newCol, varType #) = foreignAlphaHelp fp offset terminal col in
170 if start == end then
171 eerr (E.ParseError row newCol (E.Theories ctx [E.LowVar, E.CapVar]))
172 else
173 let
174 !newState = State fp end terminal indent row newCol ctx
175 !name = N.fromForeignPtr fp start (end - start)
176 in
177 if start == offset then
178 if Set.member name reservedWords then
179 eerr noError
180 else
181 cok (Src.Var varType name) newState noError
182 else
183 let !home = N.fromForeignPtr fp offset ((start - 1) - offset) in
184 cok (Src.VarQual varType home name) newState noError
187foreignAlphaHelp :: ForeignPtr Word8 -> Int -> Int -> Int -> (# Int, Int, Int, Src.VarType #)
188foreignAlphaHelp fp offset terminal col =
189 let
190 (# lowerOffset, lowerCol #) = chompLower fp offset terminal col
191 in
192 if offset < lowerOffset then
193 (# offset, lowerOffset, lowerCol, Src.Value #)
195 else
196 let
197 (# upperOffset, upperCol #) = chompUpper fp offset terminal col
198 in
199 if offset == upperOffset then
200 (# offset, offset, col, Src.Ctor #)
202 else if isDot fp upperOffset terminal then
203 foreignAlphaHelp fp (upperOffset + 1) terminal (upperCol + 1)
205 else
206 (# offset, upperOffset, upperCol, Src.Ctor #)
210---- CHAR CHOMPERS ----
214-- DOTS
217{-# INLINE isDot #-}
218isDot :: ForeignPtr Word8 -> Int -> Int -> Bool
219isDot fp offset terminal =
220 offset < terminal && unsafeIndex fp offset == 0x2e {- . -}
224-- UPPER CHARS
227chompUpper :: ForeignPtr Word8 -> Int -> Int -> Int -> (# Int, Int #)
228chompUpper fp offset terminal col =
229 let !width = getUpperWidth fp offset terminal in
230 if width == 0 then
231 (# offset, col #)
232 else
233 chompInnerChars fp (offset + width) terminal (col + 1)
236{-# INLINE getUpperWidth #-}
237getUpperWidth :: ForeignPtr Word8 -> Int -> Int -> Int
238getUpperWidth fp offset terminal =
239 if offset < terminal then
240 getUpperWidthHelp fp offset terminal (unsafeIndex fp offset)
241 else
242 0
245{-# INLINE getUpperWidthHelp #-}
246getUpperWidthHelp :: ForeignPtr Word8 -> Int -> Int -> Word8 -> Int
247getUpperWidthHelp fp offset terminal word
248 | 0x41 {- A -} <= word && word <= 0x5A {- Z -} = 1
249 | word < 0xc0 = 0
250 | word < 0xe0 = if Char.isUpper (getChar2 fp offset terminal word) then 2 else 0
251 | word < 0xf0 = if Char.isUpper (getChar3 fp offset terminal word) then 3 else 0
252 | word < 0xf8 = if Char.isUpper (getChar4 fp offset terminal word) then 4 else 0
253 | True = 0
257-- LOWER CHARS
260chompLower :: ForeignPtr Word8 -> Int -> Int -> Int -> (# Int, Int #)
261chompLower fp offset terminal col =
262 let !width = getLowerWidth fp offset terminal in
263 if width == 0 then
264 (# offset, col #)
265 else
266 chompInnerChars fp (offset + width) terminal (col + 1)
269{-# INLINE getLowerWidth #-}
270getLowerWidth :: ForeignPtr Word8 -> Int -> Int -> Int
271getLowerWidth fp offset terminal =
272 if offset < terminal then
273 getLowerWidthHelp fp offset terminal (unsafeIndex fp offset)
274 else
275 0
278{-# INLINE getLowerWidthHelp #-}
279getLowerWidthHelp :: ForeignPtr Word8 -> Int -> Int -> Word8 -> Int
280getLowerWidthHelp fp offset terminal word
281 | 0x61 {- a -} <= word && word <= 0x7A {- z -} = 1
282 | word < 0xc0 = 0
283 | word < 0xe0 = if Char.isLower (getChar2 fp offset terminal word) then 2 else 0
284 | word < 0xf0 = if Char.isLower (getChar3 fp offset terminal word) then 3 else 0
285 | word < 0xf8 = if Char.isLower (getChar4 fp offset terminal word) then 4 else 0
286 | True = 0
290-- INNER CHARS
293chompInnerChars :: ForeignPtr Word8 -> Int -> Int -> Int -> (# Int, Int #)
294chompInnerChars fp !offset terminal !col =
295 let !width = getInnerWidth fp offset terminal in
296 if width == 0 then
297 (# offset, col #)
298 else
299 chompInnerChars fp (offset + width) terminal (col + 1)
302getInnerWidth :: ForeignPtr Word8 -> Int -> Int -> Int
303getInnerWidth fp offset terminal =
304 if offset < terminal then
305 getInnerWidthHelp fp offset terminal (unsafeIndex fp offset)
306 else
307 0
310{-# INLINE getInnerWidthHelp #-}
311getInnerWidthHelp :: ForeignPtr Word8 -> Int -> Int -> Word8 -> Int
312getInnerWidthHelp fp offset terminal word
313 | 0x61 {- a -} <= word && word <= 0x7A {- z -} = 1
314 | 0x41 {- A -} <= word && word <= 0x5A {- Z -} = 1
315 | 0x30 {- 0 -} <= word && word <= 0x39 {- 9 -} = 1
316 | word == 0x5F {- _ -} = 1
317 | word < 0xc0 = 0
318 | word < 0xe0 = if Char.isAlpha (getChar2 fp offset terminal word) then 2 else 0
319 | word < 0xf0 = if Char.isAlpha (getChar3 fp offset terminal word) then 3 else 0
320 | word < 0xf8 = if Char.isAlpha (getChar4 fp offset terminal word) then 4 else 0
321 | True = 0
325-- EXTRACT CHARACTERS
328push :: Word8 -> Int -> Int
329push word code =
330 assert (word .&. 0xc0 == 0x80) (
331 shiftL code 6 .|. fromEnum (word .&. 0x3f)
332 )
335getChar2 :: ForeignPtr Word8 -> Int -> Int -> Word8 -> Char
336getChar2 fp offset terminal word =
337 assert (offset + 2 <= terminal) (
338 let
339 !word1 = word .&. 0x1f
340 !word2 = unsafeIndex fp (offset + 1)
341 !code = push word2 (fromEnum word1)
342 in
343 assert (0x80 <= code) (
344 toEnum code
345 )
346 )
349getChar3 :: ForeignPtr Word8 -> Int -> Int -> Word8 -> Char
350getChar3 fp offset terminal word =
351 assert (offset + 3 <= terminal) (
352 let
353 !word1 = word .&. 0x0f
354 !word2 = unsafeIndex fp (offset + 1)
355 !word3 = unsafeIndex fp (offset + 2)
356 !code = push word3 (push word2 (fromEnum word1))
357 in
358 assert ((0x800 <= code && code < 0xd800) || (0xdfff < code && code < 0xfffe)) (
359 toEnum code
360 )
361 )
364getChar4 :: ForeignPtr Word8 -> Int -> Int -> Word8 -> Char
365getChar4 fp offset terminal word =
366 assert (offset + 4 <= terminal) (
367 let
368 !word1 = word .&. 0x07
369 !word2 = unsafeIndex fp (offset + 1)
370 !word3 = unsafeIndex fp (offset + 2)
371 !word4 = unsafeIndex fp (offset + 3)
372 !code = push word4 (push word3 (push word2 (fromEnum word1)))
373 in
374 assert (0x10000 <= code && code < 0x110000) (
375 toEnum code
376 )
377 )