Removed all the PassR and PassMR stuff, now we just have Pass and PassM

This commit is contained in:
Neil Brown 2008-06-03 16:30:10 +00:00
parent 21329287e2
commit 9066d4112b
3 changed files with 12 additions and 30 deletions

View File

@ -44,7 +44,7 @@ import UsageCheckAlgorithms
import UsageCheckUtils
import Utils
usageCheckPass :: A.AST -> PassMR A.AST
usageCheckPass :: A.AST -> PassM A.AST
usageCheckPass t = do g' <- buildFlowGraph labelFunctions t
(g, roots) <- case g' of
Left err -> dieP (findMeta t) err

View File

@ -20,11 +20,11 @@ with this program. If not, see <http://www.gnu.org/licenses/>.
module Pass where
import Control.Monad.Error
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Writer
import Data.Generics
import Data.List
import Data.Ord
import qualified Data.Set as Set
import System.IO
@ -38,20 +38,13 @@ import Utils
-- | The monad in which AST-mangling passes operate.
type PassM = ErrorT ErrorReport (StateT CompState (StateT [WarningReport] IO))
type PassMR = ErrorT ErrorReport (ReaderT CompState (StateT [WarningReport] IO))
instance Die PassM where
dieReport = throwError
instance Die PassMR where
dieReport = throwError
instance Warn PassM where
warnReport w = lift $ lift $ modify (++ [w])
instance Warn PassMR where
warnReport w = lift $ lift $ modify (++ [w])
-- | The type of a pass function.
-- This is as generic as possible. Passes are used on 'A.AST' in normal use,
-- but for explicit descent and testing it's useful to be able to run them
@ -59,46 +52,35 @@ instance Warn PassMR where
type PassType = (forall s. Data s => s -> PassM s)
-- | A description of an AST-mangling pass.
data Monad m => Pass_ m = Pass {
data Pass = Pass {
passCode :: PassType
, passName :: String
, passPre :: Set.Set Property
, passPost :: Set.Set Property
, passEnabled :: CompState -> Bool
}
}
instance Monad m => Eq (Pass_ m) where
instance Eq Pass where
x == y = passName x == passName y
instance Monad m => Ord (Pass_ m) where
compare x y = compare (passName x) (passName y)
type Pass = Pass_ PassM
type PassR = Pass_ PassMR
instance Ord Pass where
compare = comparing passName
-- | A property that can be asserted and tested against the AST.
data Property = Property {
propName :: String
, propCheck :: A.AST -> PassMR ()
, propCheck :: A.AST -> PassM ()
}
instance Eq Property where
x == y = propName x == propName y
instance Ord Property where
compare x y = compare (propName x) (propName y)
compare = comparing propName
instance Show Property where
show = propName
runPassR :: (A.AST -> PassMR A.AST) -> (A.AST -> PassM A.AST)
runPassR p t
= do st <- get
(r, w) <- liftIO $ flip runStateT [] $ runReaderT (runErrorT (p t)) st
case r of
Left err -> throwError err
Right result -> mapM_ warnReport w >> return result
runPassM :: CompState -> PassM a -> IO (Either ErrorReport a, CompState, [WarningReport])
runPassM cs pass
= liftM flatten $ flip runStateT [] $ flip runStateT cs $ runErrorT pass

View File

@ -51,7 +51,7 @@ commonPasses opts = concat $
[ enablePassesWhen ((== FrontendOccam) . csFrontend) simplifyTypes
, enablePassesWhen csUsageChecking
[pass "Usage checking" Prop.agg_namesDone [Prop.parUsageChecked]
(passOnlyOnAST "usageCheckPass" $ runPassR usageCheckPass)]
(passOnlyOnAST "usageCheckPass" usageCheckPass)]
-- If usage checking is turned off, the pass list will break unless we insert this dummy item:
, enablePassesWhen (not . csUsageChecking)
[pass "Usage checking turned OFF" Prop.agg_namesDone [Prop.parUsageChecked]
@ -122,10 +122,10 @@ calculatePassList
checks = [pass ("[" ++ propName prop ++ "]")
[]
[]
(passOnlyOnAST "prop" $ runPassR $ checkProp prop)
(passOnlyOnAST "prop" $ checkProp prop)
| prop <- Set.toList props]
checkProp :: Property -> A.AST -> PassMR A.AST
checkProp :: Property -> A.AST -> PassM A.AST
checkProp prop ast = propCheck prop ast >> return ast
-- | If something isn't right, it gives back a list containing a single pass