git.iko.soy/elk
on 00a3069 help sign in
elk/src/Parse/Declaration.hs
197 lines 5.2 kB history raw
1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Parse.Declaration
4 ( declaration
5 , infix_
6 )
7 where
10import Data.Text (Text)
11import qualified Data.Text.Encoding as Text
13import qualified AST.Source as Src
14import qualified AST.Utils.Binop as Binop
15import qualified Parse.Expression as Expr
16import qualified Parse.Pattern as Pattern
17import Parse.Primitives
18import qualified Parse.Primitives.Keyword as Keyword
19import qualified Parse.Primitives.Number as Number
20import qualified Parse.Primitives.Symbol as Symbol
21import qualified Parse.Primitives.Variable as Var
22import qualified Parse.Primitives.Whitespace as W
23import qualified Parse.Type as Type
24import qualified Reporting.Annotation as A
25import qualified Reporting.Error.Syntax as E
26import qualified Reporting.Region as R
30-- DECLARATION
33declaration :: SParser Src.Decl
34declaration =
35 hint E.Decl $
36 do start <- getPosition
37 oneOf
38 [ doc_ start
39 , type_ start
40 , port_ start
41 , def_ start
42 ]
46-- DOC COMMENTS
49{-# INLINE doc_ #-}
50doc_ :: R.Position -> SParser Src.Decl
51doc_ start =
52 do doc <- W.docComment
53 end <- getPosition
54 pos <- W.whitespace
55 return ( A.at start end (Src.Docs (Text.decodeUtf8 doc)), end, pos )
59-- DEFINITION and ANNOTATION
62{-# INLINE def_ #-}
63def_ :: R.Position -> SParser Src.Decl
64def_ start =
65 do name <- Var.lower
66 nameEnd <- getPosition
67 let locatedName = A.at start nameEnd name
68 spaces
69 oneOf
70 [ do Symbol.hasType
71 inContext start (E.Annotation name) $
72 do spaces
73 (tipe, end, space) <- Type.expression
74 return ( A.at start end (Src.Annotation locatedName tipe), end, space )
75 , inContext start (E.Definition name) $
76 definitionHelp start locatedName []
77 ]
80definitionHelp :: R.Position -> A.Located Text -> [Src.Pattern] -> SParser Src.Decl
81definitionHelp start name revArgs =
82 oneOf
83 [ do arg <- hint E.Arg Pattern.term
84 spaces
85 definitionHelp start name (arg : revArgs)
86 , do Symbol.equals
87 spaces
88 (body, end, space) <- Expr.expression
89 let def = A.at start end (Src.Definition name (reverse revArgs) body)
90 return ( def, end, space )
91 ]
95-- TYPE ALIAS and UNION TYPES
98{-# INLINE type_ #-}
99type_ :: R.Position -> SParser Src.Decl
100type_ start =
101 do Keyword.type_
102 spaces
103 oneOf
104 [ do Keyword.alias_
105 inContext start E.TypeAlias $
106 do spaces
107 (name, args) <- nameArgsEquals
108 (tipe, end, pos) <- Type.expression
109 return ( A.at start end (Src.Alias name args tipe), end, pos )
110 , inContext start E.TypeUnion $
111 do (name, args) <- nameArgsEquals
112 (firstCtor, firstEnd, firstSpace) <- Type.unionConstructor
113 (ctors, end, pos) <- chompConstructors [firstCtor] firstEnd firstSpace
114 return ( A.at start end (Src.Union name args ctors), end, pos )
115 ]
118nameArgsEquals :: Parser (A.Located Text, [A.Located Text])
119nameArgsEquals =
120 do name <- addLocation Var.upper
121 spaces
122 nameArgsEqualsHelp name []
125nameArgsEqualsHelp :: A.Located Text -> [A.Located Text] -> Parser (A.Located Text, [A.Located Text])
126nameArgsEqualsHelp name args =
127 oneOf
128 [ do arg <- addLocation Var.lower
129 spaces
130 nameArgsEqualsHelp name (arg:args)
131 , do Symbol.equals
132 spaces
133 return ( name, reverse args )
134 ]
137chompConstructors :: [(A.Located Text, [Src.Type])] -> R.Position -> SPos -> SParser [(A.Located Text, [Src.Type])]
138chompConstructors ctors end pos =
139 oneOf
140 [ do checkSpace pos
141 Symbol.pipe
142 spaces
143 (ctor, newEnd, newSpace) <- Type.unionConstructor
144 chompConstructors (ctor:ctors) newEnd newSpace
145 , return ( reverse ctors, end, pos )
146 ]
150-- PORT
153{-# INLINE port_ #-}
154port_ :: R.Position -> SParser Src.Decl
155port_ start =
156 do Keyword.port_
157 inContext start E.Port $
158 do spaces
159 name <- addLocation Var.lower
160 spaces
161 Symbol.hasType
162 spaces
163 (tipe, end, pos) <- Type.expression
164 return ( A.at start end (Src.Port name tipe), end, pos )
168-- INFIX
171-- INVARIANT: always chomps to a freshline
172--
173infix_ :: Parser Src.Decl
174infix_ =
175 do start <- getPosition
176 Keyword.infix_
177 inContext start E.Infix $
178 do spaces
179 associativity <-
180 oneOf
181 [ Keyword.left_ >> return Binop.Left
182 , Keyword.right_ >> return Binop.Right
183 , Keyword.non_ >> return Binop.Non
184 ]
185 spaces
186 precedence <- Number.precedence
187 spaces
188 Symbol.leftParen
189 op <- Symbol.binop
190 Symbol.rightParen
191 spaces
192 Symbol.equals
193 spaces
194 name <- Var.lower
195 end <- getPosition
196 checkFreshLine =<< W.whitespace
197 return (A.at start end (Src.Binop op associativity precedence name))