diff options
Diffstat (limited to 'src/Language/Fiddle/Parser.hs')
| -rw-r--r-- | src/Language/Fiddle/Parser.hs | 69 |
1 files changed, 32 insertions, 37 deletions
diff --git a/src/Language/Fiddle/Parser.hs b/src/Language/Fiddle/Parser.hs index a1c7a0e..00cce27 100644 --- a/src/Language/Fiddle/Parser.hs +++ b/src/Language/Fiddle/Parser.hs @@ -12,8 +12,6 @@ import Data.Functor.Identity import Data.Kind (Type) import Data.List.NonEmpty (NonEmpty (..)) import Data.Text (Text) -import qualified Data.Text -import Debug.Trace import Language.Fiddle.Ast import Language.Fiddle.Tokenizer import Language.Fiddle.Types @@ -54,12 +52,12 @@ stripTrailingComments = reverse . dropWhile isComment . reverse directedP :: (Annotated (t Parsed)) => Pa t -> PaS (Directed t 'Parsed) directedP subparser = withMetaLeaveComments $ do - comments <- many commentP - Directed <$> many directiveP <*> pushComments comments subparser + coms <- many commentP + Directed <$> many directiveP <*> pushComments coms subparser pushComments :: (Annotated t) => [Comment] -> PaS t -> PaS t -pushComments comments subparse = do - setAnnot (\(Commented coms a) -> Commented (comments ++ coms) a) <$> subparse +pushComments coms subparse = do + setAnnot (\(Commented coms' a) -> Commented (coms ++ coms') a) <$> subparse directiveP :: PaS Directive directiveP = @@ -75,18 +73,18 @@ directiveElementP = withMeta $ do identifier1 <- nextTextP choice [ do - tok TokColon + tok_ TokColon let backend = identifier1 key <- nextTextP choice [ do - tok TokEq + tok_ TokEq DirectiveElementKeyValue (Just backend) key <$> directiveExpressionP, do return (DirectiveElementKey (Just backend) key) ], do - tok TokEq + tok_ TokEq let key = identifier1 DirectiveElementKeyValue Nothing key <$> directiveExpressionP, return $ DirectiveElementKey Nothing identifier1 @@ -122,7 +120,7 @@ stringTokenP = importListP :: PaS ImportList importListP = withMeta $ do - tok TokLParen + tok_ TokLParen ImportList <$> many (ident <* (tok TokComma <|> lookAhead (tok TokRParen))) <* tok TokRParen @@ -150,7 +148,7 @@ fiddleDeclP = do ObjTypeDecl () <$> ident <*> ( do - tok TokColon + tok_ TokColon bt <- bodyTypeP defer body (objTypeBodyP bt) ) @@ -199,11 +197,11 @@ objTypeDeclP :: Pa ObjTypeDecl objTypeDeclP = withMeta $ ( do - tok KWAssertPos + tok_ KWAssertPos AssertPosStatement (Witness ()) <$> exprInParenP ) <|> ( do - tok KWReserved + tok_ KWReserved ReservedDecl <$> exprInParenP ) <|> ( do @@ -211,9 +209,9 @@ objTypeDeclP = TypeSubStructure <$> defer body (objTypeBodyP bt) <*> optionMaybe ident ) <|> ( do - mod <- optionMaybe modifierP - tok KWReg - RegisterDecl mod + modifier <- optionMaybe modifierP + tok_ KWReg + RegisterDecl modifier <$> optionMaybe ident <*> exprInParenP <*> optionMaybe (tok TokColon *> registerBodyP) @@ -285,7 +283,7 @@ registerBitsTypeRefP = do anonymousBitsTypeP :: Pa AnonymousBitsType anonymousBitsTypeP = withMeta $ do - tok KWEnum + tok_ KWEnum AnonymousEnumBody <$> exprInParenP <*> defer body enumBodyP bitTypeP :: Pa BitType @@ -293,7 +291,7 @@ bitTypeP = withMeta $ rawBits <|> enumType where rawBits = RawBits <$> (tok TokLParen *> expressionP <* tok TokRParen) enumType = do - tok KWEnum + tok_ KWEnum expr <- exprInParenP EnumBitType expr <$> defer body enumBodyP @@ -323,9 +321,9 @@ body = do directiveBodyTokens :: P [Token SourceSpan] directiveBodyTokens = do - tokKeepComment TokDirectiveStart + _ <- tokKeepComment TokDirectiveStart ret <- concat <$> manyTill ((: []) <$> anyToken) (lookAhead $ tokKeepComment TokDirectiveEnd) - tokKeepComment TokDirectiveEnd + _ <- tokKeepComment TokDirectiveEnd return ret body' :: P (Token SourceSpan, [Token SourceSpan], Token SourceSpan) @@ -339,7 +337,7 @@ body' = do (lookAhead $ tokKeepComment TokRBrace) r <- tokKeepComment TokRBrace - next <- lookAhead anyToken + _ <- lookAhead anyToken return (l, stripTrailingComments ret, r) @@ -373,24 +371,18 @@ packageBodyP = ) ) -printNext :: P () -printNext = do - t <- lookAhead anyToken - traceM $ "NextToken: " ++ show t - return () - ident :: PaS Identifier ident = withMeta $ token $ \case - (TokIdent id) -> Just (Identifier id) + (TokIdent identTok) -> Just (Identifier identTok) _ -> Nothing name :: PaS Name name = withMeta $ do i <- ident is <- many $ do - tok TokDot + tok_ TokDot ident return $ Name (i :| is) @@ -398,11 +390,11 @@ name = withMeta $ do -- and after and sets the positions and adds it to the annotation. withMeta :: P (Commented SourceSpan -> b) -> P b withMeta p = do - comments <- many commentP + comments' <- many commentP start <- getPosition fn <- p end <- getPosition - return $ fn (Commented comments (SourceSpan start end)) + return $ fn (Commented comments' (SourceSpan start end)) -- Takes a some parsable thing p and automatically parses the comments before -- and after and sets the positions and adds it to the annotation. @@ -425,22 +417,25 @@ tokKeepComment t' = do Text.Parsec.token (\(Token t _) -> show t) (\(Token _ (SourceSpan s1 _)) -> s1) - (\tok@(Token t _) -> if t == t' then Just tok else Nothing) + (\aToken@(Token t _) -> if t == t' then Just aToken else Nothing) + +tok_ :: T -> P () +tok_ = void . tok tok :: T -> P (Token SourceSpan) tok t' = do - many commentP + _ <- many commentP Text.Parsec.token (\(Token t _) -> show t) (\(Token _ (SourceSpan s1 _)) -> s1) - (\tok@(Token t _) -> if t == t' then Just tok else Nothing) + (\tt@(Token t _) -> if t == t' then Just tt else Nothing) parseFiddleText :: String -> Text -> F (FiddleUnit 'Parsed F (Commented SourceSpan)) -parseFiddleText sourceName txt = +parseFiddleText srcName txt = runIdentity . Text.Parsec.runParserT (fiddleUnit <* eof) () - sourceName + srcName . stripTrailingComments - =<< tokenize sourceName txt + =<< tokenize srcName txt |