From a72b01ff029c23333fac21264b7fa63dd6bef3e0 Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Tue, 10 Feb 2009 17:11:24 +0000 Subject: [PATCH] Merged the latest changes from my usage checking into the polyplate branch --- checks/Check.hs | 2 +- flow/FlowGraph.hs | 4 +-- frontends/OccamPasses.hs | 4 +-- pregen/GenNavAST.hs | 9 ++++-- transformations/SimplifyAbbrevs.hs | 50 ++++++++++-------------------- transformations/SimplifyProcs.hs | 4 +-- 6 files changed, 29 insertions(+), 44 deletions(-) diff --git a/checks/Check.hs b/checks/Check.hs index ded4c82..6f768fc 100644 --- a/checks/Check.hs +++ b/checks/Check.hs @@ -37,12 +37,12 @@ import ArrayUsageCheck import qualified AST as A import CheckFramework import CompState +import Data.Generics.Polyplate.Route import Errors import ExSet import FlowAlgorithms import FlowGraph import FlowUtils -import GenericUtils import Metadata import Pass import ShowCode diff --git a/flow/FlowGraph.hs b/flow/FlowGraph.hs index fda51b4..a0dfdd6 100644 --- a/flow/FlowGraph.hs +++ b/flow/FlowGraph.hs @@ -421,7 +421,7 @@ buildFlowGraph :: forall mLabel mAlter label. (Monad mLabel, Monad mAlter) => A.AST -> mLabel (Either String (FlowGraph' mAlter label (), [Node], [Node])) buildFlowGraph funcs s - = do res <- flip runStateT (0, 0, ([],[]), [], []) $ flip runReaderT funcs $ runErrorT $ buildStructuredAST s routeIdentity + = do res <- flip runStateT (GraphMakerState 0 0 ([],[]) [] [] []) $ flip runReaderT funcs $ runErrorT $ buildStructuredAST s identityRoute return $ case res of (Left err,_) -> Left err (Right _,GraphMakerState _ _ (nodes, edges) roots terminators _) @@ -432,7 +432,7 @@ buildFlowGraphP :: forall mLabel mAlter label. (Monad mLabel, Monad mAlter) => A.Structured A.Process -> mLabel (Either String (FlowGraph' mAlter label A.Process, [Node], [Node])) buildFlowGraphP funcs s - = do res <- flip runStateT (0, 0, ([],[]), [], []) $ flip runReaderT funcs $ runErrorT $ buildStructuredSeq s routeIdentity + = do res <- flip runStateT (GraphMakerState 0 0 ([],[]) [] [] []) $ flip runReaderT funcs $ runErrorT $ buildStructuredSeq s identityRoute return $ case res of (Left err,_) -> Left err (Right (root,_),GraphMakerState _ _ (nodes, edges) roots terminators _) diff --git a/frontends/OccamPasses.hs b/frontends/OccamPasses.hs index 38de331..d8f0917 100644 --- a/frontends/OccamPasses.hs +++ b/frontends/OccamPasses.hs @@ -228,10 +228,10 @@ checkConstants = occamOnlyPass "Check mandatory constants" -- | Turns things like cs[0]? into cs?[0], which helps later on in the usage checking -- (as we can consider cs? a different array than cs!). -pushUpDirections :: Pass +pushUpDirections :: PassOn A.Variable pushUpDirections = occamOnlyPass "Push up direction specifiers on arrays" [] [] - (applyDepthM doVariable) + (applyBottomUpM doVariable) where doVariable :: Transform A.Variable doVariable origV@(A.DirectedVariable m dir v) diff --git a/pregen/GenNavAST.hs b/pregen/GenNavAST.hs index 8a7dca1..e74d762 100644 --- a/pregen/GenNavAST.hs +++ b/pregen/GenNavAST.hs @@ -21,6 +21,7 @@ module GenNavAST where import Data.List import System.Environment +import qualified Data.Set as Set import Data.Generics.Polyplate.GenInstances @@ -153,7 +154,7 @@ instancesFrom w main :: IO () main = do [instFileName, spineInstFileName] <- getArgs - writeInstancesToSep GenWithoutOverlapped GenClassPerType + writeInstancesToSep GenWithOverlapped GenClassPerType [ genInstance (undefined :: AST.AST) , genInstance (undefined :: CompState.CompState) -- All the maps that are in CompState: @@ -162,10 +163,12 @@ main = do , genMapInstance (undefined :: String) (undefined :: String) , genMapInstance (undefined :: String) (undefined :: [AST.Type]) , genMapInstance (undefined :: String) (undefined :: [AST.Actual]) - -- All the maps that are in CompState: + , genMapInstance (undefined :: String) (undefined :: Set.Set CompState.NameAttr) + -- All the sets that are in CompState: , genSetInstance (undefined :: Errors.WarningType) , genSetInstance (undefined :: String) , genSetInstance (undefined :: AST.Name) + , genSetInstance (undefined :: CompState.NameAttr) ] (header False (findModuleName instFileName), header True (findModuleName spineInstFileName)) (instFileName, spineInstFileName) @@ -177,7 +180,7 @@ main = do = (reverse . takeWhile (/= '/') . drop 3 . reverse) $ moduleFileName header isSpine moduleName = - ["{-# OPTIONS_GHC -Werror -fwarn-overlapping-patterns -fwarn-unused-matches -fwarn-unused-binds #-}" + ["{-# OPTIONS_GHC -fallow-overlapping-instances -fwarn-overlapping-patterns -fwarn-unused-matches -fwarn-unused-binds #-}" ,"-- | This module is auto-generated by Polyplate. DO NOT EDIT." ,"module " ++ moduleName ++ " where" ,"" diff --git a/transformations/SimplifyAbbrevs.hs b/transformations/SimplifyAbbrevs.hs index 3521b15..cda877b 100644 --- a/transformations/SimplifyAbbrevs.hs +++ b/transformations/SimplifyAbbrevs.hs @@ -190,24 +190,21 @@ updateAbbrevsInState doAbbrevMode A.ResultAbbrev = A.Abbrev doAbbrevMode s = s - -- Until Polyplate is merged, this fixes updating the abbreviation modes in - -- the csNames map - doNameAbbrevs :: CompState -> CompState - doNameAbbrevs cs = cs { csNames = flip Map.map (csNames cs) $ - \nd -> nd { A.ndAbbrevMode = doAbbrevMode (A.ndAbbrevMode nd) } } - abbrevCheckPass :: Pass abbrevCheckPass = pass "Abbreviation checking" [] [] - (passOnlyOnAST "abbrevCheck" $ flip evalStateT [Map.empty] . recurse) + ({-passOnlyOnAST "abbrevCheck" $ -} flip evalStateT [Map.empty] . recurse) where - ops = baseOp `extOpS` doStructured `extOp` doVariable - `extOp` doProcess `extOp` doInputItem + ops :: AbbrevCheckOps + ops = baseOp `extOpMS` (ops, doStructured) `extOpM` doVariable + `extOpM` doProcess `extOpM` doInputItem - descend, recurse :: Data a => a -> StateT [Map.Map Var Bool] PassM a - descend = makeDescend ops - recurse = makeRecurse ops + descend :: DescendM AbbrevCheckM AbbrevCheckOps + descend = makeDescendM ops + recurse :: RecurseM AbbrevCheckM AbbrevCheckOps + recurse = makeRecurseM ops + pushRecurse :: (PolyplateM a AbbrevCheckOps () AbbrevCheckM) => a -> AbbrevCheckM a pushRecurse x = modify (Map.empty:) >> recurse x pop :: StateT [Map.Map Var Bool] PassM () pop = modify $ \st -> case st of @@ -216,17 +213,6 @@ abbrevCheckPass record b v = modify (\(m:ms) -> (Map.insertWith (||) (Var v) b m : ms)) - nameIsNonce :: A.Name -> StateT [Map.Map Var Bool] PassM Bool - nameIsNonce n - = do names <- lift getCompState >>* csNames - case fmap A.ndNameSource $ Map.lookup (A.nameName n) names of - Just A.NameNonce -> return True - _ -> return False - - -- Judging by the cgtests (cgtest18, line 232), we should turn off usage checking - -- on an abbreviation if either the RHS *or* the LHS is exempt by a PERMITALIASEs - -- pragma - doStructured :: Data a => A.Structured a -> StateT [Map.Map Var Bool] PassM (A.Structured a) doStructured s@(A.Spec _ (A.Specification _ n (A.Is _ A.Abbrev _ (A.ActualVariable v))) scope) @@ -249,16 +235,12 @@ abbrevCheckPass pop return s doStructured s@(A.Spec _ (A.Specification m n (A.Is _ A.ValAbbrev _ (A.ActualExpression e))) scope) - = do nonce <- nameIsNonce n - ex <- isNameExempt n - if nonce || ex - then descend s >> return () - else do pushRecurse scope - checkNotWritten (A.Variable m n) "VAL-abbreviated variable % written-to inside the scope of the abbreviation" - sequence_ [checkNotWritten v - "Abbreviated variable % used inside the scope of the abbreviation" - | A.ExprVariable _ v <- fastListify (const True) e] - pop + = do pushRecurse scope + checkNotWritten (A.Variable m n) "VAL-abbreviated variable % written-to inside the scope of the abbreviation" + sequence_ [checkNotWritten v + "Abbreviated variable % used inside the scope of the abbreviation" + | A.ExprVariable _ v <- fastListify (const True) e] + pop return s doStructured s = descend s @@ -282,7 +264,7 @@ abbrevCheckPass checkAbbreved v@(A.Variable {}) msg = checkNone v msg checkAbbreved v@(A.DirectedVariable {}) msg = checkNone v msg checkAbbreved (A.SubscriptedVariable _ sub v) msg - = sequence_ [checkNotWritten subV msg | subV <- fastListify (const True) sub] + = sequence_ [checkNotWritten subV msg | subV <- listifyDepth (const True) sub] checkNone :: A.Variable -> String -> StateT [Map.Map Var Bool] PassM () checkNone v msg diff --git a/transformations/SimplifyProcs.hs b/transformations/SimplifyProcs.hs index 9d948b3..54837ae 100644 --- a/transformations/SimplifyProcs.hs +++ b/transformations/SimplifyProcs.hs @@ -193,9 +193,9 @@ flattenAssign = pass "Flatten assignment" -- This pass is primarily to make sure that PAR replicators with 0 or 1 counts -- pass the usage checking, but it doesn't hurt to remove any redundant code (or -- simplify code) in the other replicators. -fixLowReplicators :: Pass +fixLowReplicators :: PassOn A.Process fixLowReplicators = pass "Fix low-count (0, 1) replicators" [] [] - (applyDepthM doProcess) + (applyBottomUpM doProcess) where doProcess :: Transform A.Process doProcess (A.Seq m s) = doStructured s >>* A.Seq m