From 3ce0eaf4521ef6eae9d10653497caab061b7edb6 Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Sat, 16 Feb 2008 10:19:14 +0000 Subject: [PATCH] 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 --- backends/BackendPasses.hs | 2 +- backends/GenerateC.hs | 4 ++-- backends/GenerateCPPCSP.hs | 4 ++-- checks/Check.hs | 2 +- common/Pass.hs | 41 +++++++++++++++++++++++++------- common/PassList.hs | 18 +++++++------- frontends/RainPasses.hs | 4 ++-- transformations/SimplifyComms.hs | 7 ++---- transformations/SimplifyExprs.hs | 7 ++---- transformations/SimplifyProcs.hs | 7 ++---- transformations/SimplifyTypes.hs | 7 ++---- transformations/Unnest.hs | 7 ++---- 12 files changed, 60 insertions(+), 50 deletions(-) diff --git a/backends/BackendPasses.hs b/backends/BackendPasses.hs index 45f09ac..ef2154d 100644 --- a/backends/BackendPasses.hs +++ b/backends/BackendPasses.hs @@ -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 diff --git a/backends/GenerateC.hs b/backends/GenerateC.hs index ff1cf96..544e7c0 100644 --- a/backends/GenerateC.hs +++ b/backends/GenerateC.hs @@ -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) ] diff --git a/backends/GenerateCPPCSP.hs b/backends/GenerateCPPCSP.hs index ad1969c..2e1a60b 100644 --- a/backends/GenerateCPPCSP.hs +++ b/backends/GenerateCPPCSP.hs @@ -133,8 +133,8 @@ cppgenOps = cgenOps { } --}}} -genCPPCSPPasses :: [(String, Pass)] -genCPPCSPPasses = +genCPPCSPPasses :: [Pass] +genCPPCSPPasses = makePasses [ ("Transform channels to ANY", chansToAny) ] diff --git a/checks/Check.hs b/checks/Check.hs index dbffe7d..b965be7 100644 --- a/checks/Check.hs +++ b/checks/Check.hs @@ -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 diff --git a/common/Pass.hs b/common/Pass.hs index 3191385..d6a18bc 100644 --- a/common/Pass.hs +++ b/common/Pass.hs @@ -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 diff --git a/common/PassList.hs b/common/PassList.hs index 4268f77..b56a269 100644 --- a/common/PassList.hs +++ b/common/PassList.hs @@ -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 [] diff --git a/frontends/RainPasses.hs b/frontends/RainPasses.hs index bc58691..96267d1 100644 --- a/frontends/RainPasses.hs +++ b/frontends/RainPasses.hs @@ -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 diff --git a/transformations/SimplifyComms.hs b/transformations/SimplifyComms.hs index 5c217cb..980c7cf 100644 --- a/transformations/SimplifyComms.hs +++ b/transformations/SimplifyComms.hs @@ -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) ] diff --git a/transformations/SimplifyExprs.hs b/transformations/SimplifyExprs.hs index d686473..0ed2bb4 100644 --- a/transformations/SimplifyExprs.hs +++ b/transformations/SimplifyExprs.hs @@ -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) diff --git a/transformations/SimplifyProcs.hs b/transformations/SimplifyProcs.hs index 5044f2a..f3d3c53 100644 --- a/transformations/SimplifyProcs.hs +++ b/transformations/SimplifyProcs.hs @@ -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) diff --git a/transformations/SimplifyTypes.hs b/transformations/SimplifyTypes.hs index a0ab7bb..eeb06da 100644 --- a/transformations/SimplifyTypes.hs +++ b/transformations/SimplifyTypes.hs @@ -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) ] diff --git a/transformations/Unnest.hs b/transformations/Unnest.hs index 19f2c83..4dd071a 100644 --- a/transformations/Unnest.hs +++ b/transformations/Unnest.hs @@ -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) ]