-- | This module contains the parser for custom pragmas. -- -- All custom pragmas have the format @{-\# FreeC ... \#-}@ (see -- 'customPragmaPattern'). -- -- The following custom pragmas are supported: -- -- * @{-\# FreeC <function> DECREASES ON <argument> \#-}@ -- annotates the decreasing argument of a function declared in -- the current module. module FreeC.Frontend.IR.PragmaParser ( parseCustomPragmas ) where import Control.Applicative ( (<|>) ) import Control.Monad ( forM, msum ) import Control.Monad.Extra ( mapMaybeM ) import Text.RegexPR import FreeC.IR.SrcSpan import qualified FreeC.IR.Syntax as IR import FreeC.Monad.Reporter -- | Type alias for a function that creates a pragma AST node -- from the capturing groups of a regular expression. -- -- The given source span is the source span of the comment that -- declares the pragma. type CustomPragmaBuilder = SrcSpan -> [(Int, String)] -> Reporter IR.Pragma -- | A regular expression for custom pragmas. customPragmaPattern :: String customPragmaPattern = "^#\\s*" ++ IR.customPragmaPrefix ++ "\\s+((\\S+(\\s*\\S)?)*)\\s*#$" -- | Regular expressions and functions that create the pragma AST node -- from the capturing groups of the match. customPragmas :: [(String, CustomPragmaBuilder)] customPragmas = [(decArgPattern, parseDecArgPragma)] ------------------------------------------------------------------------------- -- Decreasing Arguments -- ------------------------------------------------------------------------------- -- | A regular expression for a decreasing argument pragma. decArgPattern :: String decArgPattern = "^(\\S+)\\s+DECREASES\\s+ON\\s+((\\S+)|ARGUMENT\\s+(\\d+))$" -- | Creates a decreasing argument pragma from the given capturing -- groups for 'decArgPattern'. parseDecArgPragma :: CustomPragmaBuilder parseDecArgPragma srcSpan groups = do let Just funcName = IR.UnQual . IR.Ident <$> lookup 1 groups Just decArg = (Left <$> lookup 3 groups) <|> (Right . read <$> lookup 4 groups) return (IR.DecArgPragma srcSpan funcName decArg) ------------------------------------------------------------------------------- -- Parser -- ------------------------------------------------------------------------------- -- | Parses custom pragmas (i.e., 'IR.DecArgPragma') from the comments of a -- module. parseCustomPragmas :: [IR.Comment] -> Reporter [IR.Pragma] parseCustomPragmas = mapMaybeM parseCustomPragma -- | Parses a pragma from the given comment. -- -- Returns @Nothing@ if the given comment is not a pragma or an -- unrecognized pragma. parseCustomPragma :: IR.Comment -> Reporter (Maybe IR.Pragma) parseCustomPragma (IR.LineComment _ _) = return Nothing parseCustomPragma (IR.BlockComment srcSpan text) = -- Test whether this comment is a custom pragma. case matchRegexPR customPragmaPattern text of Nothing -> return Nothing Just (_, groups) -> do let Just text' = lookup 1 groups -- Try to match the contents of the pragma with the pattern -- of each custom pragma and return the result of the builder -- associated with the first matching pattern. fmap msum $ forM customPragmas $ \(regex, action) -> case matchRegexPR regex text' of Nothing -> do report $ Message srcSpan Warning $ "Unrecognized pragma" return Nothing Just (_, groups') -> do pragma <- action srcSpan groups' return (Just pragma)