Made the first adjustment to the Pass system, ready to introduce properties and a dependency graph. For now passes are still executed in list order

This commit is contained in:
Neil Brown 2008-02-16 10:19:14 +00:00
parent 21a3619d81
commit 3ce0eaf452
12 changed files with 60 additions and 50 deletions

View File

@ -28,7 +28,7 @@ import CompState
import Pass
-- | Identify processes that we'll need to compute the stack size of.
identifyParProcs :: Pass
identifyParProcs :: Data t => t -> PassM t
identifyParProcs = everywhereM (mkM doProcess)
where
doProcess :: A.Process -> PassM A.Process

View File

@ -45,8 +45,8 @@ import Types
import Utils
--{{{ passes related to C generation
genCPasses :: [(String, Pass)]
genCPasses =
genCPasses :: [Pass]
genCPasses = makePasses
[ ("Identify parallel processes", identifyParProcs)
,("Transform wait for guards into wait until guards", transformWaitFor)
]

View File

@ -133,8 +133,8 @@ cppgenOps = cgenOps {
}
--}}}
genCPPCSPPasses :: [(String, Pass)]
genCPPCSPPasses =
genCPPCSPPasses :: [Pass]
genCPPCSPPasses = makePasses
[ ("Transform channels to ANY", chansToAny)
]

View File

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

View File

@ -25,6 +25,7 @@ import Control.Monad.State
import Control.Monad.Writer
import Data.Generics
import Data.List
import qualified Data.Set as Set
import System.IO
import qualified AST as A
@ -51,10 +52,28 @@ instance Warn PassMR where
warnReport w = tell [w]
-- | The type of an AST-mangling pass.
type Pass = A.AST -> PassM A.AST
type PassR = A.AST -> PassMR A.AST
data Monad m => Pass_ m = Pass {
passCode :: A.AST -> m A.AST
,passName :: String
,passPre :: Set.Set Property
,passPost :: Set.Set Property
}
type Pass = Pass_ PassM
type PassR = Pass_ PassMR
runPassR :: PassR -> Pass
data Property = Property {
propName :: String
,propCheck :: A.AST -> PassMR ()
}
instance Eq Property where
x == y = propName x == propName y
instance Ord Property where
compare x y = compare (propName x) (propName y)
runPassR :: (A.AST -> PassMR A.AST) -> (A.AST -> PassM A.AST)
runPassR p t
= do st <- get
(r,w) <- liftIO $ runWriterT $ runReaderT (runErrorT (p t)) st
@ -62,17 +81,23 @@ runPassR p t
Left err -> throwError err
Right result -> tell w >> return result
makePasses :: [(String, A.AST -> PassM A.AST)] -> [Pass]
makePasses = map (\(s, p) -> Pass p s Set.empty Set.empty)
-- | Compose a list of passes into a single pass.
runPasses :: [(String, Pass)] -> Pass
-- TODO this needs to examine dependencies rather than running them in order!
runPasses :: [Pass] -> (A.AST -> PassM A.AST)
runPasses [] ast = return ast
runPasses ((s, p):ps) ast
= do debug $ "{{{ " ++ s
progress $ "- " ++ s
ast' <- p ast
runPasses (p:ps) ast
= do debug $ "{{{ " ++ passName p
progress $ "- " ++ passName p
ast' <- passCode p ast
debugAST ast'
debug $ "}}}"
runPasses ps ast'
-- | Print a message if above the given verbosity level.
verboseMessage :: (CSM m, MonadIO m) => Int -> String -> m ()
verboseMessage n s

View File

@ -31,18 +31,18 @@ import SimplifyProcs
import SimplifyTypes
import Unnest
commonPasses :: CompState -> [(String, Pass)]
commonPasses opts =
[ ("Simplify types", simplifyTypes)
] ++ (if csUsageChecking opts then [("Usage checks", runPassR usageCheckPass)] else []) ++
[ ("Simplify expressions", simplifyExprs)
, ("Simplify processes", simplifyProcs)
, ("Flatten nested declarations", unnest)
, ("Simplify communications", simplifyComms)
commonPasses :: CompState -> [Pass]
commonPasses opts = concat $
[ simplifyTypes
] ++ (if csUsageChecking opts then [makePasses [("Usage checking", runPassR usageCheckPass)]] else []) ++
[ simplifyExprs
, simplifyProcs
, unnest
, simplifyComms
]
getPassList :: CompState -> [(String, Pass)]
getPassList :: CompState -> [Pass]
getPassList optsPS = concat [ if csFrontend optsPS == FrontendRain
then rainPasses
else []

View File

@ -35,8 +35,8 @@ import TreeUtils
import Types
-- | An ordered list of the Rain-specific passes to be run.
rainPasses :: [(String,Pass)]
rainPasses =
rainPasses :: [Pass]
rainPasses = makePasses
[ ("AST Validity check, Rain #1", excludeNonRainFeatures)
,("Resolve Int -> Int64",transformInt)
,("Uniquify variable declarations, record declared types and resolve variable names",uniquifyAndResolveVars) --depends on transformInt

View File

@ -30,11 +30,8 @@ import Pass
import Types
import Utils
simplifyComms :: Pass
simplifyComms = runPasses passes
where
passes :: [(String, Pass)]
passes =
simplifyComms :: [Pass]
simplifyComms = makePasses
[ ("Define temporary variables for outputting expressions", outExprs)
,("Transform ? CASE statements/guards into plain CASE", transformInputCase)
]

View File

@ -30,11 +30,8 @@ import Metadata
import Pass
import Types
simplifyExprs :: Pass
simplifyExprs = runPasses passes
where
passes :: [(String, Pass)]
passes =
simplifyExprs :: [Pass]
simplifyExprs = makePasses
[ ("Convert FUNCTIONs to PROCs", functionsToProcs)
, ("Convert AFTER to MINUS", removeAfter)
, ("Expand array literals", expandArrayLiterals)

View File

@ -28,11 +28,8 @@ import Metadata
import Types
import Pass
simplifyProcs :: Pass
simplifyProcs = runPasses passes
where
passes :: [(String, Pass)]
passes =
simplifyProcs :: [Pass]
simplifyProcs = makePasses
[ ("Wrap PAR subprocesses in PROCs", parsToProcs)
, ("Remove parallel assignment", removeParAssign)
, ("Flatten assignment", flattenAssign)

View File

@ -27,11 +27,8 @@ import Metadata
import Pass
import Types
simplifyTypes :: Pass
simplifyTypes = runPasses passes
where
passes :: [(String,Pass)]
passes =
simplifyTypes :: [Pass]
simplifyTypes = makePasses
[ ("Resolve types in AST", resolveNamedTypes)
, ("Resolve types in state", rntState)
]

View File

@ -32,11 +32,8 @@ import Metadata
import Pass
import Types
unnest :: Pass
unnest = runPasses passes
where
passes :: [(String, Pass)]
passes =
unnest :: [Pass]
unnest = makePasses
[ ("Convert free names to arguments", removeFreeNames)
, ("Pull nested definitions to top level", removeNesting)
]