git.iko.soy/elk
on 1238607 help sign in
elk/compiler/src/Parse/Variable.hs
382 lines 9.2 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples, OverloadedStrings #-}
3module Parse.Variable
4 ( lower
5 , upper
6 , moduleName
7 , Upper(..)
8 , foreignUpper
9 , foreignAlpha
10 , chompInnerChars
11 , getInnerWidth
12 , getInnerWidthHelp
13 )
14 where
17import qualified Data.Char as Char
18import qualified Data.Name as Name
19import qualified Data.Set as Set
20import Data.Word (Word8, Word16)
21import Foreign.Ptr (Ptr, plusPtr)
22import GHC.Exts (Char(C#), Int#, (+#), (-#), chr#, uncheckedIShiftL#, word2Int#)
23import GHC.Word (Word8(W8#))
25import qualified AST.Source as Src
26import Parse.Utils (Parser)
27import Parse.Primitives (unsafeIndex)
28import qualified Parse.Primitives as P
29import qualified Reporting.Error.Syntax as E
33-- LOCAL UPPER
36upper :: Parser Name.Name
37upper =
38 P.Parser $ \(P.State pos end indent row col ctx) cok _ _ eerr ->
39 let (# newPos, newCol #) = chompUpper pos end col in
40 if pos == newPos then
41 eerr row col ctx E.Upper
42 else
43 let !name = Name.fromPtr pos newPos in
44 cok name (P.State newPos end indent row newCol ctx)
48-- LOCAL LOWER
51lower :: Parser Name.Name
52lower =
53 P.Parser $ \(P.State pos end indent row col ctx) cok _ _ eerr ->
54 let (# newPos, newCol #) = chompLower pos end col in
55 if pos == newPos then
56 eerr row col ctx E.Lower
57 else
58 let !name = Name.fromPtr pos newPos in
59 if Set.member name reservedWords then
60 eerr row col ctx E.Lower
61 else
62 let
63 !newState =
64 P.State newPos end indent row newCol ctx
65 in
66 cok name newState
69{-# NOINLINE reservedWords #-}
70reservedWords :: Set.Set Name.Name
71reservedWords =
72 Set.fromList
73 [ "if", "then", "else"
74 , "case", "of"
75 , "let", "in"
76 , "type"
77 , "module", "where"
78 , "import", "exposing"
79 , "as"
80 , "port"
81 ]
85-- MODULE NAME
88moduleName :: Parser Name.Name
89moduleName =
90 P.Parser $ \(P.State pos end indent row col ctx) cok _ _ eerr ->
91 let
92 (# pos1, col1 #) = chompUpper pos end col
93 (# status, newPos, newCol #) = moduleNameHelp pos1 end col1
94 in
95 case status of
96 Good ->
97 let
98 !name = Name.fromPtr pos newPos
99 !newState = P.State newPos end indent row newCol ctx
100 in
101 cok name newState
103 Bad ->
104 eerr row newCol ctx E.ModuleName
107data ModuleNameStatus
108 = Good
109 | Bad
112moduleNameHelp :: Ptr Word8 -> Ptr Word8 -> Word16 -> (# ModuleNameStatus, Ptr Word8, Word16 #)
113moduleNameHelp pos end col =
114 if isDot pos end then
115 let
116 !pos1 = plusPtr pos 1
117 (# newPos, newCol #) = chompUpper pos1 end (col + 1)
118 in
119 if pos1 == newPos then
120 (# Bad, newPos, newCol #)
121 else
122 moduleNameHelp newPos end newCol
124 else
125 (# Good, pos, col #)
129-- FOREIGN UPPER
132data Upper
133 = Unqualified Name.Name
134 | Qualified Name.Name Name.Name
137foreignUpper :: Parser Upper
138foreignUpper =
139 P.Parser $ \(P.State pos end indent row col ctx) cok _ _ eerr ->
140 let (# upperStart, upperEnd, newCol #) = foreignUpperHelp pos end col in
141 if upperStart == upperEnd then
142 eerr row newCol ctx E.Upper
143 else
144 let
145 !newState = P.State upperEnd end indent row newCol ctx
146 !name = Name.fromPtr upperStart upperEnd
147 !foreign =
148 if upperStart == pos then
149 Unqualified name
150 else
151 let !home = Name.fromPtr pos (plusPtr upperStart (-1)) in
152 Qualified home name
153 in
154 cok foreign newState
157foreignUpperHelp :: Ptr Word8 -> Ptr Word8 -> Word16 -> (# Ptr Word8, Ptr Word8, Word16 #)
158foreignUpperHelp pos end col =
159 let
160 (# newPos, newCol #) = chompUpper pos end col
161 in
162 if pos == newPos then
163 (# pos, pos, col #)
165 else if isDot newPos end then
166 foreignUpperHelp (plusPtr newPos 1) end (newCol + 1)
168 else
169 (# pos, newPos, newCol #)
173-- FOREIGN ALPHA
176foreignAlpha :: Parser Src.Expr_
177foreignAlpha =
178 P.Parser $ \(P.State pos end indent row col ctx) cok _ _ eerr ->
179 let (# alphaStart, alphaEnd, newCol, varType #) = foreignAlphaHelp pos end col in
180 if alphaStart == alphaEnd then
181 eerr row newCol ctx E.Alpha
182 else
183 let
184 !newState = P.State alphaEnd end indent row newCol ctx
185 !name = Name.fromPtr alphaStart alphaEnd
186 in
187 if alphaStart == pos then
188 if Set.member name reservedWords then
189 eerr row col ctx E.Alpha
190 else
191 cok (Src.Var varType name) newState
192 else
193 let !home = Name.fromPtr pos (plusPtr alphaStart (-1)) in
194 cok (Src.VarQual varType home name) newState
197foreignAlphaHelp :: Ptr Word8 -> Ptr Word8 -> Word16 -> (# Ptr Word8, Ptr Word8, Word16, Src.VarType #)
198foreignAlphaHelp pos end col =
199 let
200 (# lowerPos, lowerCol #) = chompLower pos end col
201 in
202 if pos < lowerPos then
203 (# pos, lowerPos, lowerCol, Src.LowVar #)
205 else
206 let
207 (# upperPos, upperCol #) = chompUpper pos end col
208 in
209 if pos == upperPos then
210 (# pos, pos, col, Src.CapVar #)
212 else if isDot upperPos end then
213 foreignAlphaHelp (plusPtr upperPos 1) end (upperCol + 1)
215 else
216 (# pos, upperPos, upperCol, Src.CapVar #)
220---- CHAR CHOMPERS ----
224-- DOTS
227{-# INLINE isDot #-}
228isDot :: Ptr Word8 -> Ptr Word8 -> Bool
229isDot pos end =
230 pos < end && unsafeIndex pos == 0x2e {- . -}
234-- UPPER CHARS
237chompUpper :: Ptr Word8 -> Ptr Word8 -> Word16 -> (# Ptr Word8, Word16 #)
238chompUpper pos end col =
239 let !width = getUpperWidth pos end in
240 if width == 0 then
241 (# pos, col #)
242 else
243 chompInnerChars (plusPtr pos width) end (col + 1)
246{-# INLINE getUpperWidth #-}
247getUpperWidth :: Ptr Word8 -> Ptr Word8 -> Int
248getUpperWidth pos end =
249 if pos < end then
250 getUpperWidthHelp pos end (unsafeIndex pos)
251 else
252 0
255{-# INLINE getUpperWidthHelp #-}
256getUpperWidthHelp :: Ptr Word8 -> Ptr Word8 -> Word8 -> Int
257getUpperWidthHelp pos _ word
258 | 0x41 {- A -} <= word && word <= 0x5A {- Z -} = 1
259 | word < 0xc0 = 0
260 | word < 0xe0 = if Char.isUpper (chr2 pos word) then 2 else 0
261 | word < 0xf0 = if Char.isUpper (chr3 pos word) then 3 else 0
262 | word < 0xf8 = if Char.isUpper (chr4 pos word) then 4 else 0
263 | True = 0
267-- LOWER CHARS
270chompLower :: Ptr Word8 -> Ptr Word8 -> Word16 -> (# Ptr Word8, Word16 #)
271chompLower pos end col =
272 let !width = getLowerWidth pos end in
273 if width == 0 then
274 (# pos, col #)
275 else
276 chompInnerChars (plusPtr pos width) end (col + 1)
279{-# INLINE getLowerWidth #-}
280getLowerWidth :: Ptr Word8 -> Ptr Word8 -> Int
281getLowerWidth pos end =
282 if pos < end then
283 getLowerWidthHelp pos end (unsafeIndex pos)
284 else
285 0
288{-# INLINE getLowerWidthHelp #-}
289getLowerWidthHelp :: Ptr Word8 -> Ptr Word8 -> Word8 -> Int
290getLowerWidthHelp pos _ word
291 | 0x61 {- a -} <= word && word <= 0x7A {- z -} = 1
292 | word < 0xc0 = 0
293 | word < 0xe0 = if Char.isLower (chr2 pos word) then 2 else 0
294 | word < 0xf0 = if Char.isLower (chr3 pos word) then 3 else 0
295 | word < 0xf8 = if Char.isLower (chr4 pos word) then 4 else 0
296 | True = 0
300-- INNER CHARS
303chompInnerChars :: Ptr Word8 -> Ptr Word8 -> Word16 -> (# Ptr Word8, Word16 #)
304chompInnerChars !pos end !col =
305 let !width = getInnerWidth pos end in
306 if width == 0 then
307 (# pos, col #)
308 else
309 chompInnerChars (plusPtr pos width) end (col + 1)
312getInnerWidth :: Ptr Word8 -> Ptr Word8 -> Int
313getInnerWidth pos end =
314 if pos < end then
315 getInnerWidthHelp pos end (unsafeIndex pos)
316 else
317 0
320{-# INLINE getInnerWidthHelp #-}
321getInnerWidthHelp :: Ptr Word8 -> Ptr Word8 -> Word8 -> Int
322getInnerWidthHelp pos _ word
323 | 0x61 {- a -} <= word && word <= 0x7A {- z -} = 1
324 | 0x41 {- A -} <= word && word <= 0x5A {- Z -} = 1
325 | 0x30 {- 0 -} <= word && word <= 0x39 {- 9 -} = 1
326 | word == 0x5F {- _ -} = 1
327 | word < 0xc0 = 0
328 | word < 0xe0 = if Char.isAlpha (chr2 pos word) then 2 else 0
329 | word < 0xf0 = if Char.isAlpha (chr3 pos word) then 3 else 0
330 | word < 0xf8 = if Char.isAlpha (chr4 pos word) then 4 else 0
331 | True = 0
335-- EXTRACT CHARACTERS
338{-# INLINE chr2 #-}
339chr2 :: Ptr Word8 -> Word8 -> Char
340chr2 pos firstWord =
341 let
342 !i1# = unpack firstWord
343 !i2# = unpack (unsafeIndex (plusPtr pos 1))
344 !c1# = uncheckedIShiftL# (i1# -# 0xC0#) 6#
345 !c2# = i2# -# 0x80#
346 in
347 C# (chr# (c1# +# c2#))
350{-# INLINE chr3 #-}
351chr3 :: Ptr Word8 -> Word8 -> Char
352chr3 pos firstWord =
353 let
354 !i1# = unpack firstWord
355 !i2# = unpack (unsafeIndex (plusPtr pos 1))
356 !i3# = unpack (unsafeIndex (plusPtr pos 2))
357 !c1# = uncheckedIShiftL# (i1# -# 0xE0#) 12#
358 !c2# = uncheckedIShiftL# (i2# -# 0x80#) 6#
359 !c3# = i3# -# 0x80#
360 in
361 C# (chr# (c1# +# c2# +# c3#))
364{-# INLINE chr4 #-}
365chr4 :: Ptr Word8 -> Word8 -> Char
366chr4 pos firstWord =
367 let
368 !i1# = unpack firstWord
369 !i2# = unpack (unsafeIndex (plusPtr pos 1))
370 !i3# = unpack (unsafeIndex (plusPtr pos 2))
371 !i4# = unpack (unsafeIndex (plusPtr pos 3))
372 !c1# = uncheckedIShiftL# (i1# -# 0xF0#) 18#
373 !c2# = uncheckedIShiftL# (i2# -# 0x80#) 12#
374 !c3# = uncheckedIShiftL# (i3# -# 0x80#) 6#
375 !c4# = i4# -# 0x80#
376 in
377 C# (chr# (c1# +# c2# +# c3# +# c4#))
380unpack :: Word8 -> Int#
381unpack (W8# word#) =
382 word2Int# word#