@@ -1,100 +1,151 @@
11{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
2+{-# LANGUAGE OverloadedStrings #-}
23module Parse.Declaration where
34
4−import Text.Parsec ( (<?>), choice, digit, optionMaybe, string, try )
5+import Data.Text (Text)
56
67import qualified AST.Declaration as Decl
7−import qualified Parse.Binop as Binop
8+import qualified AST.Type as Type
89import qualified Parse.Expression as Expr
910import Parse.Helpers as Help
1011import qualified Parse.Type as Type
12+import qualified Reporting.Annotation as A
13+import qualified Reporting.Region as R
1114
1215
1316
14−declaration :: IParser Decl.Source
17+-- DECLARATION
18+
19+
20+declaration :: SParser Decl.Source
1521declaration =
16− commentOr $ addLocation $
17− choice
18− [ typeDecl
19− , infixDecl
20− , portDecl
21− , definition
22− ]
23−
24−
25−commentOr :: IParser a -> IParser (Decl.CommentOr a)
26−commentOr parser =
27− choice
28− [ Decl.Comment <$> addLocation Help.docComment
29− , Decl.Whatever <$> parser
30− ]
22+ do start <- getPosition
23+ oneOf
24+ [ docDecl start
25+ , typeDecl start
26+ , infixDecl start
27+ , portDecl start
28+ , defDecl start
29+ ]
30+
31+
32+
33+-- DOC COMMENTS
34+
3135
36+docDecl :: R.Position -> SParser Decl.Source
37+docDecl start =
38+ do comment <- docComment
39+ end <- getPosition
40+ space <- whitespace
41+ return ( Decl.Comment (A.at start end comment), end, space )
3242
3343
3444-- TYPE ANNOTATIONS and DEFINITIONS
3545
3646
37−definition :: IParser Decl.Raw
38−definition =
39− do def <- Expr.def <?> "a definition or type annotation"
40− return $ Decl.Def def
47+defDecl :: R.Position -> SParser Decl.Source
48+defDecl start =
49+ do (def, end, space) <- Expr.definition
50+ let decl = A.at start end (Decl.Def def)
51+ return ( Decl.Whatever decl, end, space )
4152
4253
4354
4455-- TYPE ALIAS and UNION TYPES
4556
4657
47−typeDecl :: IParser Decl.Raw
48−typeDecl =
49− do try (reserved "type") <?> "a type declaration"
50− forcedWS
51− isAlias <- optionMaybe (string "alias" >> forcedWS)
52−
53− name <- capVar
54− args <- spacePrefix lowVar
55− padded equals
58+typeDecl :: R.Position -> SParser Decl.Source
59+typeDecl start =
60+ do keyword "type"
61+ spaces
62+ oneOf
63+ [ do keyword "alias"
64+ spaces
65+ (name, args) <- nameArgsEquals
66+ (tipe, end, space) <- Type.expression
67+ let decl = A.at start end (Decl.Alias (Decl.Type name args tipe))
68+ return ( Decl.Whatever decl, end, space )
69+ , do (name, args) <- nameArgsEquals
70+ (firstCtor, firstEnd, firstSpace) <- Type.unionConstructor
71+ (ctors, end, space) <- chompConstructors [firstCtor] firstEnd firstSpace
72+ let decl = A.at start end (Decl.Union (Decl.Type name args ctors))
73+ return ( Decl.Whatever decl, end, space )
74+ ]
75+
76+
77+nameArgsEquals :: Parser (Text, [Text])
78+nameArgsEquals =
79+ do name <- capVar
80+ spaces
81+ nameArgsEqualsHelp name []
82+
83+
84+nameArgsEqualsHelp :: Text -> [Text] -> Parser (Text, [Text])
85+nameArgsEqualsHelp name args =
86+ oneOf
87+ [ do arg <- lowVar
88+ spaces
89+ nameArgsEqualsHelp name (arg:args)
90+ , do equals
91+ spaces
92+ return ( name, reverse args )
93+ ]
5694
57− case isAlias of
58− Just _ ->
59− do tipe <- Type.expr <?> "a type"
60− return $ Decl.Alias (Decl.Type name args tipe)
6195
62− Nothing ->
63− do tcs <- pipeSep1 Type.constructor <?> "a constructor for a union type"
64− return $ Decl.Union (Decl.Type name args tcs)
96+chompConstructors :: [(Text, [Type.Raw])] -> R.Position -> Space -> SParser [(Text, [Type.Raw])]
97+chompConstructors ctors end space =
98+ oneOf
99+ [ do checkSpaces space
100+ pipe
101+ spaces
102+ (ctor, newEnd, newSpace) <- Type.unionConstructor
103+ chompConstructors (ctor:ctors) newEnd newSpace
104+ , return ( reverse ctors, end, space )
105+ ]
65106
66107
67108
68109-- INFIX
69110
70111
71−infixDecl :: IParser Decl.Raw
72−infixDecl =
73− expecting "an infix declaration" $
74− do assoc <-
75− choice
76− [ try (reserved "infixl") >> return Decl.L
77− , try (reserved "infixr") >> return Decl.R
78− , try (reserved "infix") >> return Decl.N
79− ]
80− forcedWS
112+infixDecl :: R.Position -> SParser Decl.Source
113+infixDecl start =
114+ oneOf
115+ [ do keyword "infixl"
116+ infixDeclHelp start Decl.L
117+ , do keyword "infixr"
118+ infixDeclHelp start Decl.R
119+ , do keyword "infix"
120+ infixDeclHelp start Decl.N
121+ ]
122+
123+
124+infixDeclHelp :: R.Position -> Decl.Assoc -> SParser Decl.Source
125+infixDeclHelp start assoc =
126+ do spaces
81127 n <- digit
82− forcedWS
83− op <- Binop.infixOp
84− return $ Decl.Fixity (Decl.Infix op assoc (read [n]))
128+ spaces
129+ op <- infixOp
130+ end <- getPosition
131+ space <- whitespace
132+ let decl = A.at start end (Decl.Fixity (Decl.Infix op assoc n))
133+ return ( Decl.Whatever decl, end, space )
85134
86135
87136
88137-- FOREIGN
89138
90139
91−portDecl :: IParser Decl.Raw
92−portDecl =
93− expecting "a port declaration" $
94− do try (reserved "port")
95− forcedWS
96− name <- Help.lowVar
97− padded hasType
98− tipe <- Type.expr
99− return $ Decl.Port name tipe
140+portDecl :: R.Position -> SParser Decl.Source
141+portDecl start =
142+ do keyword "port"
143+ spaces
144+ name <- lowVar
145+ spaces
146+ hasType
147+ spaces
148+ (tipe, end, space) <- Type.expression
149+ let decl = A.at start end (Decl.Port name tipe)
150+ return ( Decl.Whatever decl, end, space )
100151