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

@@ -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

backends/GenerateC.hs

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

backends/GenerateCPPCSP.hs

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

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

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
+data Monad m => Pass_ m = Pass {
-type PassR = A.AST -> PassMR A.AST
+  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
+runPasses (p:ps) ast
-    =  do debug $ "{{{ " ++ s
+    =  do debug $ "{{{ " ++ passName p
-          progress $ "- " ++ s 
+          progress $ "- " ++ passName p
-          ast' <- p ast
+          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

common/PassList.hs

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

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 :: [Pass]
-rainPasses = 
+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

transformations/SimplifyComms.hs

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

transformations/SimplifyExprs.hs

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

transformations/SimplifyProcs.hs

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

transformations/SimplifyTypes.hs

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

transformations/Unnest.hs

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