module Tip.Pass.Pipeline where
import Tip.Lint
import Tip.Types (Theory)
import Tip.Utils
import Tip.Fresh
import Data.List (intercalate)
import Data.Either (partitionEithers)
import Control.Monad ((>=>))
import Options.Applicative
class Pass p where
runPass :: Name a => p -> Theory a -> Fresh (Theory a)
passName :: p -> String
parsePass :: Parser p
unitPass :: Pass p => p -> Mod FlagFields () -> Parser p
unitPass p mod = flag' () (long (flagify (passName p)) <> mod) *> pure p
runPassLinted :: (Pass p, Name a) => p -> Theory a -> Fresh (Theory a)
runPassLinted p = runPass p >=> lintM (passName p)
data Choice a b = First a | Second b
deriving (Eq,Ord,Show)
choice :: (a -> c) -> (b -> c) -> Choice a b -> c
choice f _ (First x) = f x
choice _ g (Second y) = g y
instance (Pass a, Pass b) => Pass (Choice a b) where
passName = choice passName passName
runPass = choice runPass runPass
parsePass = (First <$> parsePass) <|> (Second <$> parsePass)
runPasses :: (Pass p,Name a) => [p] -> Theory a -> Fresh (Theory a)
runPasses = go []
where
go _ [] = return
go past (p:ps) =
runPass p
>=> lintM (passName p ++ "(and " ++ intercalate "," past ++ ")")
>=> go (passName p:past) ps
parsePasses :: Pass p => Parser [p]
parsePasses = many parsePass