Merged the latest changes from my usage checking into the polyplate branch

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

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 _)

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)

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"
       ,""

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

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