git.iko.soy/Idris-dev
on aeb032a help sign in
Idris-dev/src/Idris/Parser/Helpers.hs
642 lines 26 kB history raw
1{-|
2Module : Idris.Parser.Helpers
3Description : Utilities for Idris' parser.
4Copyright :
5License : BSD3
6Maintainer : The Idris Community.
7-}
8{-# LANGUAGE ConstraintKinds, FlexibleContexts #-}
9module Idris.Parser.Helpers where
11import Idris.AbsSyntax
12import Idris.Core.Evaluate
13import Idris.Core.TT
14import Idris.Delaborate (pprintErr)
15import Idris.Docstrings
16import Idris.Options
17import Idris.Output (iWarn)
19import Prelude hiding (pi)
21import Control.Applicative
22import Control.Monad
23import Control.Monad.State.Strict
24import Data.Char
25import qualified Data.HashSet as HS
26import Data.List
27import qualified Data.List.NonEmpty as NonEmpty
28import qualified Data.Map as M
29import Data.Maybe
30import qualified Data.Text as T
31import Data.Void (Void(..))
32import System.FilePath
33import Text.Megaparsec ((<?>))
34import qualified Text.Megaparsec as P
35import qualified Text.Megaparsec.Char as P
36import qualified Text.Megaparsec.Char.Lexer as P hiding (space)
37import qualified Text.PrettyPrint.ANSI.Leijen as PP
40-- | Idris parser with state used during parsing
41type IdrisParser = StateT IState IdrisInnerParser
42type IdrisInnerParser = P.Parsec Void String
43type ParseState = P.State String
44data ParseError = ParseError String (P.ParseError (P.Token String) Void)
46parseErrorPretty :: ParseError -> String
47parseErrorPretty (ParseError s err) = P.parseErrorPretty' s err
49parseErrorDoc :: ParseError -> PP.Doc
50parseErrorDoc = PP.string . parseErrorPretty
52-- | Generalized monadic parsing constraint type
53type MonadicParsing m = (P.MonadParsec Void String m)
55someSpace :: MonadicParsing m => m ()
56someSpace = many (simpleWhiteSpace <|> singleLineComment <|> multiLineComment) *> pure ()
58tokenFC :: MonadicParsing m => m a -> m (a, FC)
59tokenFC p = do (FC fn (sl, sc) _) <- getFC --TODO: Update after fixing getFC
60 -- See Issue #1594
61 r <- p
62 (FC fn _ (el, ec)) <- getFC
63 whiteSpace
64 return (r, FC fn (sl, sc) (el, ec))
66token :: MonadicParsing m => m a -> m a
67token p = p <* whiteSpace
69-- | Helper to run Idris inner parser based stateT parsers
70runparser :: StateT st IdrisInnerParser res -> st -> String -> String -> Either ParseError res
71runparser p i inputname s =
72 case P.parse (evalStateT p i) inputname s of
73 Left err -> Left $ ParseError s err
74 Right v -> Right v
77highlightP :: FC -> OutputAnnotation -> IdrisParser ()
78highlightP fc annot = do ist <- get
79 put ist { idris_parserHighlights = (fc, annot) : idris_parserHighlights ist}
81noDocCommentHere :: String -> IdrisParser ()
82noDocCommentHere msg =
83 optional (do fc <- getFC
84 docComment
85 ist <- get
86 put ist { parserWarnings = (fc, Msg msg) : parserWarnings ist}) *>
87 pure ()
89clearParserWarnings :: Idris ()
90clearParserWarnings = do ist <- getIState
91 putIState ist { parserWarnings = [] }
93reportParserWarnings :: Idris ()
94reportParserWarnings = do ist <- getIState
95 mapM_ (uncurry iWarn)
96 (map (\ (fc, err) -> (fc, pprintErr ist err)) .
97 reverse .
98 nubBy (\(fc, err) (fc', err') ->
99 FC' fc == FC' fc' && err == err') $
100 parserWarnings ist)
101 clearParserWarnings
104parserWarning :: FC -> Maybe Opt -> Err -> IdrisParser ()
105parserWarning fc warnOpt warnErr = do
106 ist <- get
107 let cmdline = opt_cmdline (idris_options ist)
108 unless (maybe False (`elem` cmdline) warnOpt) $
109 put ist { parserWarnings = (fc, warnErr) : parserWarnings ist }
111{- * Space, comments and literals (token/lexing like parsers) -}
113-- | Consumes any simple whitespace (any character which satisfies Char.isSpace)
114simpleWhiteSpace :: MonadicParsing m => m ()
115simpleWhiteSpace = () <$ P.satisfy isSpace
117-- | Checks if a charcter is end of line
118isEol :: Char -> Bool
119isEol '\n' = True
120isEol _ = False
122-- | A parser that succeeds at the end of the line
123eol :: MonadicParsing m => m ()
124eol = () <$ P.satisfy isEol <|> P.lookAhead P.eof <?> "end of line"
126{- | Consumes a single-line comment
129 SingleLineComment_t ::= '--' ~EOL_t* EOL_t ;
131 -}
132singleLineComment :: MonadicParsing m => m ()
133singleLineComment = P.hidden (() <$ string "--" *> many (P.satisfy (not . isEol)) *> eol)
135{- | Consumes a multi-line comment
138 MultiLineComment_t ::=
139 '{ -- }'
140 | '{ -' InCommentChars_t
141 ;
145 InCommentChars_t ::=
146 '- }'
147 | MultiLineComment_t InCommentChars_t
148 | ~'- }'+ InCommentChars_t
149 ;
151-}
152multiLineComment :: MonadicParsing m => m ()
153multiLineComment = P.hidden $ P.try (string "{-" *> string "-}" *> pure ())
154 <|> string "{-" *> inCommentChars
155 where inCommentChars :: MonadicParsing m => m ()
156 inCommentChars = string "-}" *> pure ()
157 <|> P.try (multiLineComment) *> inCommentChars
158 <|> string "|||" *> many (P.satisfy (not . isEol)) *> eol *> inCommentChars
159 <|> P.skipSome (P.noneOf startEnd) *> inCommentChars
160 <|> P.oneOf startEnd *> inCommentChars
161 <?> "end of comment"
162 startEnd :: String
163 startEnd = "{}-"
165{-| Parses a documentation comment
168 DocComment_t ::= '|||' ~EOL_t* EOL_t
169 ;
171 -}
172docComment :: IdrisParser (Docstring (), [(Name, Docstring ())])
173docComment = do dc <- pushIndent *> docCommentLine
174 rest <- many (indented docCommentLine)
175 args <- many $ do (name, first) <- indented argDocCommentLine
176 rest <- many (indented docCommentLine)
177 return (name, concat (intersperse "\n" (first:rest)))
178 popIndent
179 return (parseDocstring $ T.pack (concat (intersperse "\n" (dc:rest))),
180 map (\(n, d) -> (n, parseDocstring (T.pack d))) args)
182 where docCommentLine :: MonadicParsing m => m String
183 docCommentLine = P.hidden $ P.try $ do
184 string "|||"
185 many (P.satisfy (==' '))
186 contents <- P.option "" (do first <- P.satisfy (\c -> not (isEol c || c == '@'))
187 res <- many (P.satisfy (not . isEol))
188 return $ first:res)
189 eol ; someSpace
190 return contents
192 argDocCommentLine :: IdrisParser (Name, String)
193 argDocCommentLine = do P.string "|||"
194 P.many (P.satisfy isSpace)
195 P.char '@'
196 P.many (P.satisfy isSpace)
197 n <- fst <$> name
198 P.many (P.satisfy isSpace)
199 docs <- P.many (P.satisfy (not . isEol))
200 P.eol ; someSpace
201 return (n, docs)
203-- | Parses some white space
204whiteSpace :: MonadicParsing m => m ()
205whiteSpace = someSpace <|> pure ()
207-- | Parses a string literal
208stringLiteral :: MonadicParsing m => m (String, FC)
209stringLiteral = tokenFC . P.try $ P.char '"' *> P.manyTill P.charLiteral (P.char '"')
211-- | Parses a char literal
212charLiteral :: IdrisParser (Char, FC)
213charLiteral = tokenFC . P.try $ P.char '\'' *> P.charLiteral <* P.char '\''
215-- | Parses a natural number
216natural :: IdrisParser (Integer, FC)
217natural = tokenFC ( P.try (P.char '0' *> P.char' 'x' *> P.hexadecimal)
218 <|> P.try (P.char '0' *> P.char' 'o' *> P.octal)
219 <|> P.try P.decimal)
221-- | Parses a floating point number
222float :: IdrisParser (Double, FC)
223float = tokenFC . P.try $ P.float
225{- * Symbols, identifiers, names and operators -}
227reservedIdentifiers :: HS.HashSet String
228reservedIdentifiers = HS.fromList
229 [ "Type"
230 , "abstract", "case", "class", "codata", "constructor", "corecord", "data"
231 , "do", "dsl", "else", "export", "if", "implementation", "implicit"
232 , "import", "impossible", "in", "infix", "infixl", "infixr", "instance"
233 , "interface", "let", "mutual", "namespace", "of", "parameters", "partial"
234 , "postulate", "private", "proof", "public", "quoteGoal", "record"
235 , "rewrite", "syntax", "then", "total", "using", "where", "with"
236 ]
238identifierOrReserved :: MonadicParsing m => m String
239identifierOrReserved = token $ P.try $ do
240 c <- P.satisfy isAlpha <|> P.oneOf "_"
241 cs <- P.many (P.satisfy isAlphaNum <|> P.oneOf "_'.")
242 return $ c : cs
244char :: MonadicParsing m => Char -> m Char
245char = P.char
247string :: MonadicParsing m => String -> m String
248string = P.string
250-- | Parses a character as a token
251lchar :: MonadicParsing m => Char -> m Char
252lchar = token . P.char
254-- | Parses a character as a token, returning the source span of the character
255lcharFC :: MonadicParsing m => Char -> m FC
256lcharFC ch = do (FC file (l, c) _) <- getFC
257 _ <- token (P.char ch)
258 return $ FC file (l, c) (l, c+1)
260symbol :: MonadicParsing m => String -> m ()
261symbol = void . P.symbol someSpace
263symbolFC :: MonadicParsing m => String -> m FC
264symbolFC str = do (FC file (l, c) _) <- getFC
265 symbol str
266 return $ FC file (l, c) (l, c + length str)
268-- | Parses a reserved identifier
269reserved :: MonadicParsing m => String -> m ()
270reserved name = token $ P.try $ do
271 P.string name
272 P.notFollowedBy (P.satisfy isAlphaNum <|> P.oneOf "_'.") <?> "end of " ++ name
274-- | Parses a reserved identifier, computing its span. Assumes that
275-- reserved identifiers never contain line breaks.
276reservedFC :: MonadicParsing m => String -> m FC
277reservedFC str = do (FC file (l, c) _) <- getFC
278 reserved str
279 return $ FC file (l, c) (l, c + length str)
281-- | Parse a reserved identfier, highlighting its span as a keyword
282reservedHL :: String -> IdrisParser ()
283reservedHL str = reservedFC str >>= flip highlightP AnnKeyword
285-- Taken from Parsec (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007
286-- | Parses a reserved operator
287reservedOp :: MonadicParsing m => String -> m ()
288reservedOp name = token $ P.try $
289 do string name
290 P.notFollowedBy operatorLetter <?> ("end of " ++ show name)
292reservedOpFC :: MonadicParsing m => String -> m FC
293reservedOpFC name = do (FC f (l, c) _) <- getFC
294 reservedOp name
295 return (FC f (l, c) (l, c + length name))
297-- | Parses an identifier as a token
298identifier :: (MonadicParsing m) => m (String, FC)
299identifier = P.try $ do
300 (FC f (l, c) _) <- getFC
301 ident <- identifierOrReserved
302 when (ident `HS.member` reservedIdentifiers) $ P.unexpected . P.Label . NonEmpty.fromList $ "reserved " ++ ident
303 when (ident == "_") $ P.unexpected . P.Label . NonEmpty.fromList $ "wildcard"
304 return (ident, FC f (l, c) (l, c + length ident))
306-- | Parses an identifier with possible namespace as a name
307iName :: (MonadicParsing m) => [String] -> m (Name, FC)
308iName bad = maybeWithNS identifier False bad <?> "name"
310-- | Parses an string possibly prefixed by a namespace
311maybeWithNS :: (MonadicParsing m) => m (String, FC) -> Bool -> [String] -> m (Name, FC)
312maybeWithNS parser ascend bad = do
313 fc <- getFC
314 i <- P.option "" (P.lookAhead (fst <$> identifier))
315 when (i `elem` bad) $ P.unexpected . P.Label . NonEmpty.fromList $ "reserved identifier"
316 let transf = if ascend then id else reverse
317 (x, xs, fc) <- P.choice (transf (parserNoNS parser : parsersNS parser i))
318 return (mkName (x, xs), fc)
319 where parserNoNS :: MonadicParsing m => m (String, FC) -> m (String, String, FC)
320 parserNoNS parser = do startFC <- getFC
321 (x, nameFC) <- parser
322 return (x, "", spanFC startFC nameFC)
323 parserNS :: MonadicParsing m => m (String, FC) -> String -> m (String, String, FC)
324 parserNS parser ns = do startFC <- getFC
325 xs <- string ns
326 lchar '.'; (x, nameFC) <- parser
327 return (x, xs, spanFC startFC nameFC)
328 parsersNS :: MonadicParsing m => m (String, FC) -> String -> [m (String, String, FC)]
329 parsersNS parser i = [P.try (parserNS parser ns) | ns <- (initsEndAt (=='.') i)]
331-- | Parses a name
332name :: IdrisParser (Name, FC)
333name = (<?> "name") $ do
334 keywords <- syntax_keywords <$> get
335 aliases <- module_aliases <$> get
336 (n, fc) <- iName keywords
337 return (unalias aliases n, fc)
338 where
339 unalias :: M.Map [T.Text] [T.Text] -> Name -> Name
340 unalias aliases (NS n ns) | Just ns' <- M.lookup ns aliases = NS n ns'
341 unalias aliases name = name
343{- | List of all initial segments in ascending order of a list. Every
344such initial segment ends right before an element satisfying the given
345condition.
346-}
347initsEndAt :: (a -> Bool) -> [a] -> [[a]]
348initsEndAt p [] = []
349initsEndAt p (x:xs) | p x = [] : x_inits_xs
350 | otherwise = x_inits_xs
351 where x_inits_xs = [x : cs | cs <- initsEndAt p xs]
354{- | Create a `Name' from a pair of strings representing a base name and its
355 namespace.
356-}
357mkName :: (String, String) -> Name
358mkName (n, "") = sUN n
359mkName (n, ns) = sNS (sUN n) (reverse (parseNS ns))
360 where parseNS x = case span (/= '.') x of
361 (x, "") -> [x]
362 (x, '.':y) -> x : parseNS y
364opChars :: String
365opChars = ":!#$%&*+./<=>?@\\^|-~"
367operatorLetter :: MonadicParsing m => m Char
368operatorLetter = P.oneOf opChars
370-- | Parse a package name
371packageName :: MonadicParsing m => m String
372packageName = (:) <$> P.oneOf firstChars <*> many (P.oneOf remChars)
373 where firstChars = ['a'..'z'] ++ ['A'..'Z']
374 remChars = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ ['-','_']
376commentMarkers :: [String]
377commentMarkers = [ "--", "|||" ]
379invalidOperators :: [String]
380invalidOperators = [":", "=>", "->", "<-", "=", "?=", "|", "**", "==>", "\\", "%", "~", "?", "!", "@"]
382-- | Parses an operator
383symbolicOperator :: MonadicParsing m => m String
384symbolicOperator = do op <- token . some $ operatorLetter
385 when (op `elem` (invalidOperators ++ commentMarkers)) $
386 fail $ op ++ " is not a valid operator"
387 return op
389-- | Parses an operator
390symbolicOperatorFC :: MonadicParsing m => m (String, FC)
391symbolicOperatorFC = do (FC f (l, c) _) <- getFC
392 op <- symbolicOperator
393 return (op, FC f (l, c) (l, c + length op))
395{- * Position helpers -}
396{- | Get file position as FC -}
397getFC :: MonadicParsing m => m FC
398getFC = do pos <- P.getPosition
399 let columnNumber = P.unPos . P.sourceColumn $ pos
400 let lineNumber = P.unPos . P.sourceLine $ pos
401 let (dir, file) = splitFileName (P.sourceName pos)
402 let f = if dir == addTrailingPathSeparator "." then file else P.sourceName pos
403 return $ FC f (lineNumber, columnNumber) (lineNumber, columnNumber) -- TODO: Change to actual spanning
404 -- Issue #1594 on the Issue Tracker.
405 -- https://github.com/idris-lang/Idris-dev/issues/1594
407{-* Syntax helpers-}
408-- | Bind constraints to term
409bindList :: (RigCount -> Name -> FC -> PTerm -> PTerm -> PTerm) -> [(RigCount, Name, FC, PTerm)] -> PTerm -> PTerm
410bindList b [] sc = sc
411bindList b ((r, n, fc, t):bs) sc = b r n fc t (bindList b bs sc)
413{- | @commaSeparated p@ parses one or more occurences of `p`,
414 separated by commas and optional whitespace. -}
415commaSeparated :: MonadicParsing m => m a -> m [a]
416commaSeparated p = p `P.sepBy1` (P.space >> P.char ',' >> P.space)
418{- * Layout helpers -}
420-- | Push indentation to stack
421pushIndent :: IdrisParser ()
422pushIndent = do columnNumber <- indent
423 ist <- get
424 put (ist { indent_stack = columnNumber : indent_stack ist })
426-- | Pops indentation from stack
427popIndent :: IdrisParser ()
428popIndent = do ist <- get
429 case indent_stack ist of
430 [] -> error "The impossible happened! Tried to pop an indentation level where none was pushed (underflow)."
431 (x : xs) -> put (ist { indent_stack = xs })
434-- | Gets current indentation
435indent :: MonadicParsing m => m Int
436indent = P.unPos . P.sourceColumn <$> P.getPosition
438-- | Gets last indentation
439lastIndent :: IdrisParser Int
440lastIndent = do ist <- get
441 case indent_stack ist of
442 (x : xs) -> return x
443 _ -> return 1
445-- | Applies parser in an indented position
446indented :: IdrisParser a -> IdrisParser a
447indented p = notEndBlock *> p <* keepTerminator
449-- | Applies parser to get a block (which has possibly indented statements)
450indentedBlock :: IdrisParser a -> IdrisParser [a]
451indentedBlock p = do openBlock
452 pushIndent
453 res <- many (indented p)
454 popIndent
455 closeBlock
456 return res
458-- | Applies parser to get a block with at least one statement (which has possibly indented statements)
459indentedBlock1 :: IdrisParser a -> IdrisParser [a]
460indentedBlock1 p = do openBlock
461 pushIndent
462 res <- some (indented p)
463 popIndent
464 closeBlock
465 return res
467-- | Applies parser to get a block with exactly one (possibly indented) statement
468indentedBlockS :: IdrisParser a -> IdrisParser a
469indentedBlockS p = do openBlock
470 pushIndent
471 res <- indented p
472 popIndent
473 closeBlock
474 return res
477-- | Checks if the following character matches provided parser
478lookAheadMatches :: MonadicParsing m => m a -> m Bool
479lookAheadMatches p = isJust <$> P.lookAhead (P.optional p)
481-- | Parses a start of block
482openBlock :: IdrisParser ()
483openBlock = do lchar '{'
484 ist <- get
485 put (ist { brace_stack = Nothing : brace_stack ist })
486 <|> do ist <- get
487 lvl' <- indent
488 -- if we're not indented further, it's an empty block, so
489 -- increment lvl to ensure we get to the end
490 let lvl = case brace_stack ist of
491 Just lvl_old : _ ->
492 if lvl' <= lvl_old then lvl_old+1
493 else lvl'
494 [] -> if lvl' == 1 then 2 else lvl'
495 _ -> lvl'
496 put (ist { brace_stack = Just lvl : brace_stack ist })
497 <?> "start of block"
499-- | Parses an end of block
500closeBlock :: IdrisParser ()
501closeBlock = do ist <- get
502 bs <- case brace_stack ist of
503 [] -> [] <$ P.eof
504 Nothing : xs -> lchar '}' >> return xs <?> "end of block"
505 Just lvl : xs -> (do i <- indent
506 isParen <- lookAheadMatches (char ')')
507 isIn <- lookAheadMatches (reserved "in")
508 if i >= lvl && not (isParen || isIn)
509 then fail "not end of block"
510 else return xs)
511 <|> (do notOpenBraces
512 P.eof
513 return [])
514 put (ist { brace_stack = bs })
516-- | Parses a terminator
517terminator :: IdrisParser ()
518terminator = do lchar ';'; popIndent
519 <|> do c <- indent; l <- lastIndent
520 if c <= l then popIndent else fail "not a terminator"
521 <|> do isParen <- lookAheadMatches (P.oneOf ")}")
522 if isParen then popIndent else fail "not a terminator"
523 <|> P.lookAhead P.eof
525-- | Parses and keeps a terminator
526keepTerminator :: IdrisParser ()
527keepTerminator = () <$ lchar ';'
528 <|> do c <- indent; l <- lastIndent
529 unless (c <= l) $ fail "not a terminator"
530 <|> do isParen <- lookAheadMatches (P.oneOf ")}|")
531 isIn <- lookAheadMatches (reserved "in")
532 unless (isIn || isParen) $ fail "not a terminator"
533 <|> P.lookAhead P.eof
535-- | Checks if application expression does not end
536notEndApp :: IdrisParser ()
537notEndApp = do c <- indent; l <- lastIndent
538 when (c <= l) (fail "terminator")
540-- | Checks that it is not end of block
541notEndBlock :: IdrisParser ()
542notEndBlock = do ist <- get
543 case brace_stack ist of
544 Just lvl : xs -> do i <- indent
545 isParen <- lookAheadMatches (P.char ')')
546 when (i < lvl || isParen) (fail "end of block")
547 _ -> return ()
549indentGt :: IdrisParser ()
550indentGt = do
551 li <- lastIndent
552 i <- indent
553 when (i <= li) $ fail "Wrong indention: should be greater than context indentation"
555-- | Checks that there are no braces that are not closed
556notOpenBraces :: IdrisParser ()
557notOpenBraces = do ist <- get
558 when (hasNothing $ brace_stack ist) $ fail "end of input"
559 where hasNothing :: [Maybe a] -> Bool
560 hasNothing = any isNothing
562{- | Parses an accessibilty modifier (e.g. public, private) -}
563accessibility' :: IdrisParser Accessibility
564accessibility'
565 = do reserved "public";
566 gotexp <- optional (reserved "export")
567 case gotexp of
568 Just _ -> return ()
569 Nothing -> do
570 ist <- get
571 fc <- getFC
572 put ist { parserWarnings =
573 (fc, Msg "'public' is deprecated. Use 'public export' instead.")
574 : parserWarnings ist }
575 return Public
576 <|> do reserved "abstract";
577 ist <- get
578 fc <- getFC
579 put ist { parserWarnings =
580 (fc, Msg "The 'abstract' keyword is deprecated. Use 'export' instead.")
581 : parserWarnings ist }
582 return Frozen
583 <|> do reserved "export"; return Frozen
584 <|> do reserved "private"; return Private
585 <?> "accessibility modifier"
587accessibility :: IdrisParser Accessibility
588accessibility = do acc <- optional accessibility'
589 case acc of
590 Just a -> return a
591 Nothing -> do ist <- get
592 return (default_access ist)
594-- | Adds accessibility option for function
595addAcc :: Name -> Accessibility -> IdrisParser ()
596addAcc n a = do i <- get
597 put (i { hide_list = addDef n a (hide_list i) })
599{- | Add accessbility option for data declarations
600 (works for interfaces too - 'abstract' means the data/interface is visible but members not) -}
601accData :: Accessibility -> Name -> [Name] -> IdrisParser ()
602accData Frozen n ns = do addAcc n Public -- so that it can be used in public definitions
603 mapM_ (\n -> addAcc n Private) ns -- so that they are invisible
604accData a n ns = do addAcc n a
605 mapM_ (`addAcc` a) ns
608{- * Error reporting helpers -}
609{- | Error message with possible fixes list -}
610fixErrorMsg :: String -> [String] -> String
611fixErrorMsg msg fixes = msg ++ ", possible fixes:\n" ++ (concat $ intersperse "\n\nor\n\n" fixes)
613-- | Collect 'PClauses' with the same function name
614collect :: [PDecl] -> [PDecl]
615collect (c@(PClauses _ o _ _) : ds)
616 = clauses (cname c) [] (c : ds)
617 where clauses :: Maybe Name -> [PClause] -> [PDecl] -> [PDecl]
618 clauses j@(Just n) acc (PClauses fc _ _ [PClause fc' n' l ws r w] : ds)
619 | n == n' = clauses j (PClause fc' n' l ws r (collect w) : acc) ds
620 clauses j@(Just n) acc (PClauses fc _ _ [PWith fc' n' l ws r pn w] : ds)
621 | n == n' = clauses j (PWith fc' n' l ws r pn (collect w) : acc) ds
622 clauses (Just n) acc xs = PClauses (fcOf c) o n (reverse acc) : collect xs
623 clauses Nothing acc (x:xs) = collect xs
624 clauses Nothing acc [] = []
626 cname :: PDecl -> Maybe Name
627 cname (PClauses fc _ _ [PClause _ n _ _ _ _]) = Just n
628 cname (PClauses fc _ _ [PWith _ n _ _ _ _ _]) = Just n
629 cname (PClauses fc _ _ [PClauseR _ _ _ _]) = Nothing
630 cname (PClauses fc _ _ [PWithR _ _ _ _ _]) = Nothing
631 fcOf :: PDecl -> FC
632 fcOf (PClauses fc _ _ _) = fc
633collect (PParams f ns ps : ds) = PParams f ns (collect ps) : collect ds
634collect (POpenInterfaces f ns ps : ds) = POpenInterfaces f ns (collect ps) : collect ds
635collect (PMutual f ms : ds) = PMutual f (collect ms) : collect ds
636collect (PNamespace ns fc ps : ds) = PNamespace ns fc (collect ps) : collect ds
637collect (PInterface doc f s cs n nfc ps pdocs fds ds cn cd : ds')
638 = PInterface doc f s cs n nfc ps pdocs fds (collect ds) cn cd : collect ds'
639collect (PImplementation doc argDocs f s cs pnames acc opts n nfc ps pextra t en ds : ds')
640 = PImplementation doc argDocs f s cs pnames acc opts n nfc ps pextra t en (collect ds) : collect ds'
641collect (d : ds) = d : collect ds
642collect [] = []