git.iko.soy/elk
on 1238607 help sign in
elk/compiler/src/Parse/Pattern.hs
271 lines 6.9 kB history raw
1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Parse.Pattern
4 ( term
5 , expression
6 )
7 where
10import qualified Data.List as List
11import qualified Data.Name as Name
13import qualified AST.Source as Src
14import Parse.Utils (Parser, SParser, SPos, checkSpace, spaces, whitespace)
15import qualified Parse.Keyword as Keyword
16import qualified Parse.Number as Number
17import qualified Parse.Symbol as Symbol
18import qualified Parse.Utf8 as Utf8
19import qualified Parse.Variable as Var
20import qualified Parse.Primitives as P
21import Parse.Primitives (addLocation, getPosition, inContext, oneOf, word1)
22import qualified Reporting.Annotation as A
23import qualified Reporting.Error.Syntax as E
27-- TERM
30term :: Parser Src.Pattern
31term =
32 do start <- getPosition
33 oneOf E.XXX
34 [ record start
35 , tuple start
36 , list start
37 , termHelp start
38 ]
41termHelp :: A.Position -> Parser Src.Pattern
42termHelp start =
43 oneOf E.XXX
44 [
45 do Symbol.underscore
46 end <- getPosition
47 return (A.at start end Src.PAnything)
48 ,
49 do name <- Var.lower
50 end <- getPosition
51 return (A.at start end (Src.PVar name))
52 ,
53 do upper <- Var.foreignUpper
54 end <- getPosition
55 let region = A.Region start end
56 return $ A.at start end $
57 case upper of
58 Var.Unqualified name ->
59 Src.PCtor region name []
61 Var.Qualified home name ->
62 Src.PCtorQual region home name []
63 ,
64 do number <- Number.number
65 end <- getPosition
66 case number of
67 Number.Int int ->
68 return (A.at start end (Src.PInt int))
70 Number.Float _ ->
71 noFloatsAllowedInPatterns
72 ,
73 do str <- Utf8.string
74 end <- getPosition
75 return (A.at start end (Src.PStr str))
76 ,
77 do chr <- Utf8.character
78 end <- getPosition
79 return (A.at start end (Src.PChr chr))
80 ]
83noFloatsAllowedInPatterns :: Parser a
84noFloatsAllowedInPatterns =
85 P.Parser $ \(P.State _ _ _ row col ctx) _ _ cerr _ ->
86 cerr row col ctx E.FloatInPattern
90-- RECORDS
93record :: A.Position -> Parser Src.Pattern
94record start =
95 inContext E.ExprRecord (word1 0x7B {- { -} E.XXX) $
96 do spaces
97 oneOf E.XXX
98 [ do var <- addLocation Var.lower
99 spaces
100 recordHelp start [var]
101 , do word1 0x7D {-}-} E.XXX
102 end <- getPosition
103 return (A.at start end (Src.PRecord []))
104 ]
107recordHelp :: A.Position -> [A.Located Name.Name] -> Parser Src.Pattern
108recordHelp start vars =
109 oneOf E.XXX
110 [ do word1 0x2C {-,-} E.XXX
111 spaces
112 var <- addLocation Var.lower
113 spaces
114 recordHelp start (var:vars)
115 , do word1 0x7D {-}-} E.XXX
116 end <- getPosition
117 return (A.at start end (Src.PRecord vars))
118 ]
122-- TUPLES
125tuple :: A.Position -> Parser Src.Pattern
126tuple start =
127 inContext E.ExprTuple (word1 0x28 {-(-} E.XXX) $
128 do spaces
129 oneOf E.XXX
130 [ do (pattern, sPos) <- expression
131 checkSpace sPos
132 tupleHelp start pattern []
133 , do word1 0x29 {-)-} E.XXX
134 end <- getPosition
135 return (A.at start end Src.PUnit)
136 ]
139tupleHelp :: A.Position -> Src.Pattern -> [Src.Pattern] -> Parser Src.Pattern
140tupleHelp start firstPattern revPatterns =
141 oneOf E.XXX
142 [ do word1 0x2C {-,-} E.XXX
143 spaces
144 (pattern, sPos) <- expression
145 checkSpace sPos
146 tupleHelp start firstPattern (pattern : revPatterns)
147 , do word1 0x29 {-)-} E.XXX
148 case reverse revPatterns of
149 [] ->
150 return firstPattern
152 secondPattern : otherPatterns ->
153 do end <- getPosition
154 return (A.at start end (Src.PTuple firstPattern secondPattern otherPatterns))
155 ]
159-- LIST
162list :: A.Position -> Parser Src.Pattern
163list start =
164 inContext E.PatternList (word1 0x5B {-[-} E.XXX) $
165 do spaces
166 oneOf E.XXX
167 [ do (pattern, sPos) <- expression
168 checkSpace sPos
169 listHelp start [pattern]
170 , do word1 0x5D {-]-} E.XXX
171 end <- getPosition
172 return (A.at start end (Src.PList []))
173 ]
176listHelp :: A.Position -> [Src.Pattern] -> Parser Src.Pattern
177listHelp start patterns =
178 oneOf E.XXX
179 [ do word1 0x2C {-,-} E.XXX
180 spaces
181 (pattern, sPos) <- expression
182 checkSpace sPos
183 listHelp start (pattern:patterns)
184 , do word1 0x5D {-]-} E.XXX
185 end <- getPosition
186 return (A.at start end (Src.PList (reverse patterns)))
187 ]
191-- EXPRESSION
194expression :: Parser (Src.Pattern, SPos)
195expression =
196 do start <- getPosition
197 cTerm <- exprTerm
198 exprHelp start [] cTerm
201exprHelp :: A.Position -> [Src.Pattern] -> (Src.Pattern, A.Position, SPos) -> Parser (Src.Pattern, SPos)
202exprHelp start patterns (pattern, _end, sPos) =
203 oneOf E.XXX
204 [ do checkSpace sPos
205 word1 0x3A {-:-} E.XXX
206 spaces
207 cTerm <- exprTerm
208 exprHelp start (pattern:patterns) cTerm
209 , do checkSpace sPos
210 Keyword.as_
211 spaces
212 nameStart <- getPosition
213 name <- Var.lower
214 newEnd <- getPosition
215 newSpace <- whitespace
216 let alias = A.at nameStart newEnd name
217 return
218 ( A.at start newEnd (Src.PAlias (List.foldl' cons pattern patterns) alias)
219 , newSpace
220 )
221 , return
222 ( List.foldl' cons pattern patterns
223 , sPos
224 )
225 ]
228cons :: Src.Pattern -> Src.Pattern -> Src.Pattern
229cons tl hd =
230 A.merge hd tl (Src.PCons hd tl)
234-- EXPRESSION TERM
237exprTerm :: SParser Src.Pattern
238exprTerm =
239 oneOf E.XXX
240 [
241 do start <- getPosition
242 upper <- Var.foreignUpper
243 end <- getPosition
244 exprTermHelp (A.Region start end) upper start []
245 ,
246 do t@(A.At (A.Region _ end) _) <- term
247 pos <- whitespace
248 return (t, end, pos)
249 ]
252exprTermHelp :: A.Region -> Var.Upper -> A.Position -> [Src.Pattern] -> SParser Src.Pattern
253exprTermHelp region upper start revArgs =
254 do end <- getPosition
255 sPos <- whitespace
256 oneOf E.XXX
257 [ do checkSpace sPos
258 arg <- term
259 exprTermHelp region upper start (arg:revArgs)
260 , return
261 ( A.at start end $
262 case upper of
263 Var.Unqualified name ->
264 Src.PCtor region name (reverse revArgs)
266 Var.Qualified home name ->
267 Src.PCtorQual region home name (reverse revArgs)
268 , end
269 , sPos
270 )
271 ]