git.iko.soy/elk
on 2edbe13 help sign in
elk/compiler/src/Parse/Pattern.hs
279 lines 8.3 kB history raw
1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
2{-# LANGUAGE BangPatterns, UnboxedTuples, OverloadedStrings #-}
3module Parse.Pattern
4 ( term
5 , expression
6 )
7 where
10import qualified Data.List as List
11import qualified Data.Name as Name
12import qualified Data.Utf8 as Utf8
13import Foreign.Ptr (plusPtr)
15import qualified AST.Source as Src
16import qualified Parse.Keyword as Keyword
17import qualified Parse.Number as Number
18import qualified Parse.Space as Space
19import qualified Parse.String as String
20import qualified Parse.Variable as Var
21import qualified Parse.Primitives as P
22import Parse.Primitives (Parser, addLocation, addEnd, getPosition, inContext, oneOf, oneOfWithFallback, word1, word2)
23import qualified Reporting.Annotation as A
24import qualified Reporting.Error.Syntax as E
28-- TERM
31term :: Parser E.Pattern Src.Pattern
32term =
33 do start <- getPosition
34 oneOf E.PStart
35 [ record start
36 , tuple start
37 , list start
38 , termHelp start
39 ]
42termHelp :: A.Position -> Parser E.Pattern Src.Pattern
43termHelp start =
44 oneOf E.PStart
45 [
46 do wildcard
47 addEnd start Src.PAnything
48 ,
49 do name <- Var.lower E.PStart
50 addEnd start (Src.PVar name)
51 ,
52 do upper <- Var.foreignUpper E.PStart
53 end <- getPosition
54 let region = A.Region start end
55 return $ A.at start end $
56 case upper of
57 Var.Unqualified name ->
58 Src.PCtor region name []
60 Var.Qualified home name ->
61 Src.PCtorQual region home name []
62 ,
63 do number <- Number.number E.PStart E.PNumber
64 end <- getPosition
65 case number of
66 Number.Int int ->
67 return (A.at start end (Src.PInt int))
69 Number.Float float ->
70 P.Parser $ \(P.State _ _ _ _ row col) _ _ cerr _ ->
71 let
72 width = fromIntegral (Utf8.size float)
73 in
74 cerr row (col - width) (E.PFloat width)
75 ,
76 do str <- String.string E.PStart E.PString
77 addEnd start (Src.PStr str)
78 ,
79 do chr <- String.character E.PStart E.PChar
80 addEnd start (Src.PChr chr)
81 ]
85-- WILDCARD
88wildcard :: Parser E.Pattern ()
89wildcard =
90 P.Parser $ \(P.State src pos end indent row col) cok _ cerr eerr ->
91 if pos == end || P.unsafeIndex pos /= 0x5F {- _ -} then
92 eerr row col E.PStart
93 else
94 let
95 !newPos = plusPtr pos 1
96 !newCol = col + 1
97 in
98 if Var.getInnerWidth newPos end > 0 then
99 let (# badPos, badCol #) = Var.chompInnerChars newPos end newCol in
100 cerr row col (E.PWildcardNotVar (Name.fromPtr pos badPos) (fromIntegral (badCol - col)))
101 else
102 let !newState = P.State src newPos end indent row newCol in
103 cok () newState
107-- RECORDS
110record :: A.Position -> Parser E.Pattern Src.Pattern
111record start =
112 inContext E.PRecord (word1 0x7B {- { -} E.PStart) $
113 do Space.chompAndCheckIndent E.PRecordSpace E.PRecordIndentOpen
114 oneOf E.PRecordOpen
115 [ do var <- addLocation (Var.lower E.PRecordField)
116 Space.chompAndCheckIndent E.PRecordSpace E.PRecordIndentEnd
117 recordHelp start [var]
118 , do word1 0x7D {-}-} E.PRecordEnd
119 addEnd start (Src.PRecord [])
120 ]
123recordHelp :: A.Position -> [A.Located Name.Name] -> Parser E.PRecord Src.Pattern
124recordHelp start vars =
125 oneOf E.PRecordEnd
126 [ do word1 0x2C {-,-} E.PRecordEnd
127 Space.chompAndCheckIndent E.PRecordSpace E.PRecordIndentField
128 var <- addLocation (Var.lower E.PRecordField)
129 Space.chompAndCheckIndent E.PRecordSpace E.PRecordIndentEnd
130 recordHelp start (var:vars)
131 , do word1 0x7D {-}-} E.PRecordEnd
132 addEnd start (Src.PRecord vars)
133 ]
137-- TUPLES
140tuple :: A.Position -> Parser E.Pattern Src.Pattern
141tuple start =
142 inContext E.PTuple (word1 0x28 {-(-} E.PStart) $
143 do Space.chompAndCheckIndent E.PTupleSpace E.PTupleIndentExpr1
144 oneOf E.PTupleOpen
145 [ do (pattern, end) <- P.specialize E.PTupleExpr expression
146 Space.checkIndent end E.PTupleIndentEnd
147 tupleHelp start pattern []
148 , do word1 0x29 {-)-} E.PTupleEnd
149 addEnd start Src.PUnit
150 ]
153tupleHelp :: A.Position -> Src.Pattern -> [Src.Pattern] -> Parser E.PTuple Src.Pattern
154tupleHelp start firstPattern revPatterns =
155 oneOf E.PTupleEnd
156 [ do word1 0x2C {-,-} E.PTupleEnd
157 Space.chompAndCheckIndent E.PTupleSpace E.PTupleIndentExprN
158 (pattern, end) <- P.specialize E.PTupleExpr expression
159 Space.checkIndent end E.PTupleIndentEnd
160 tupleHelp start firstPattern (pattern : revPatterns)
161 , do word1 0x29 {-)-} E.PTupleEnd
162 case reverse revPatterns of
163 [] ->
164 return firstPattern
166 secondPattern : otherPatterns ->
167 addEnd start (Src.PTuple firstPattern secondPattern otherPatterns)
168 ]
172-- LIST
175list :: A.Position -> Parser E.Pattern Src.Pattern
176list start =
177 inContext E.PList (word1 0x5B {-[-} E.PStart) $
178 do Space.chompAndCheckIndent E.PListSpace E.PListIndentOpen
179 oneOf E.PListOpen
180 [ do (pattern, end) <- P.specialize E.PListExpr expression
181 Space.checkIndent end E.PListIndentEnd
182 listHelp start [pattern]
183 , do word1 0x5D {-]-} E.PListEnd
184 addEnd start (Src.PList [])
185 ]
188listHelp :: A.Position -> [Src.Pattern] -> Parser E.PList Src.Pattern
189listHelp start patterns =
190 oneOf E.PListEnd
191 [ do word1 0x2C {-,-} E.PListEnd
192 Space.chompAndCheckIndent E.PListSpace E.PListIndentExpr
193 (pattern, end) <- P.specialize E.PListExpr expression
194 Space.checkIndent end E.PListIndentEnd
195 listHelp start (pattern:patterns)
196 , do word1 0x5D {-]-} E.PListEnd
197 addEnd start (Src.PList (reverse patterns))
198 ]
202-- EXPRESSION
205expression :: Space.Parser E.Pattern Src.Pattern
206expression =
207 do start <- getPosition
208 ePart <- exprPart
209 exprHelp start [] ePart
212exprHelp :: A.Position -> [Src.Pattern] -> (Src.Pattern, A.Position) -> Space.Parser E.Pattern Src.Pattern
213exprHelp start revPatterns (pattern, end) =
214 oneOfWithFallback
215 [ do Space.checkIndent end E.PIndentStart
216 word2 0x3A 0x3A {-::-} E.PStart
217 Space.chompAndCheckIndent E.PSpace E.PIndentStart
218 ePart <- exprPart
219 exprHelp start (pattern:revPatterns) ePart
220 , do Space.checkIndent end E.PIndentStart
221 Keyword.as_ E.PStart
222 Space.chompAndCheckIndent E.PSpace E.PIndentAlias
223 nameStart <- getPosition
224 name <- Var.lower E.PAlias
225 newEnd <- getPosition
226 Space.chomp E.PSpace
227 let alias = A.at nameStart newEnd name
228 return
229 ( A.at start newEnd (Src.PAlias (List.foldl' cons pattern revPatterns) alias)
230 , newEnd
231 )
232 ]
233 ( List.foldl' cons pattern revPatterns
234 , end
235 )
238cons :: Src.Pattern -> Src.Pattern -> Src.Pattern
239cons tl hd =
240 A.merge hd tl (Src.PCons hd tl)
244-- EXPRESSION PART
247exprPart :: Space.Parser E.Pattern Src.Pattern
248exprPart =
249 oneOf E.PStart
250 [
251 do start <- getPosition
252 upper <- Var.foreignUpper E.PStart
253 end <- getPosition
254 exprTermHelp (A.Region start end) upper start []
255 ,
256 do eterm@(A.At (A.Region _ end) _) <- term
257 Space.chomp E.PSpace
258 return (eterm, end)
259 ]
262exprTermHelp :: A.Region -> Var.Upper -> A.Position -> [Src.Pattern] -> Space.Parser E.Pattern Src.Pattern
263exprTermHelp region upper start revArgs =
264 do end <- getPosition
265 Space.chomp E.PSpace
266 oneOfWithFallback
267 [ do Space.checkIndent end E.PIndentStart
268 arg <- term
269 exprTermHelp region upper start (arg:revArgs)
270 ]
271 ( A.at start end $
272 case upper of
273 Var.Unqualified name ->
274 Src.PCtor region name (reverse revArgs)
276 Var.Qualified home name ->
277 Src.PCtorQual region home name (reverse revArgs)
278 , end
279 )