Removed all the PassR and PassMR stuff, now we just have Pass and PassM
This commit is contained in:
parent
21329287e2
commit
9066d4112b
|
@ -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
|
||||
|
|
34
pass/Pass.hs
34
pass/Pass.hs
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue
Block a user