From d98c5079ca52943eecc435d5db4e8977c859ff6e Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Tue, 19 May 2009 09:05:38 +0000 Subject: [PATCH] Cleaned up all the warnings in Tock's code (most unused modules, or unused functions) --- Main.hs | 3 -- alloy/Data/Generics/Alloy.hs | 2 - alloy/Data/Generics/Alloy/GenInstances.hs | 8 +--- backends/BackendPasses.hs | 2 - backends/BackendPassesTest.hs | 5 +++ backends/GenerateC.hs | 6 +-- backends/GenerateCHP.hs | 4 +- backends/GenerateCPPCSP.hs | 15 +------ backends/GenerateCTest.hs | 8 ++-- checks/ArrayUsageCheckTest.hs | 26 +++--------- checks/Check.hs | 7 ++-- checks/CheckFramework.hs | 19 --------- checks/CheckTest.hs | 1 - checks/UsageCheckAlgorithms.hs | 1 - checks/UsageCheckTest.hs | 7 +--- common/CommonTest.hs | 5 +-- common/EvalConstants.hs | 2 - common/EvalLiterals.hs | 1 - common/PrettyShow.hs | 2 - common/ShowCode.hs | 4 -- common/Types.hs | 1 - flow/FlowGraphTest.hs | 1 + frontends/OccamInferTypes.hs | 13 ------ frontends/OccamPasses.hs | 1 - frontends/OccamPassesTest.hs | 1 - frontends/OccamTypesTest.hs | 1 - frontends/ParseOccam.hs | 51 +++++++++-------------- frontends/ParseRainTest.hs | 8 ++-- frontends/RainPasses.hs | 1 - frontends/RainPassesTest.hs | 4 +- frontends/RainTypes.hs | 2 - frontends/RainTypesTest.hs | 42 +++++++++---------- frontends/StructureOccam.hs | 1 - frontends/TypeUnification.hs | 3 +- pass/PassList.hs | 1 - pregen/GenTagAST.hs | 1 - transformations/ImplicitMobility.hs | 22 ---------- transformations/SimplifyAbbrevs.hs | 1 - transformations/SimplifyAbbrevsTest.hs | 1 - transformations/SimplifyProcs.hs | 1 - transformations/SimplifyTypes.hs | 3 -- transformations/SimplifyTypesTest.hs | 8 ---- transformations/Unnest.hs | 9 ---- 43 files changed, 75 insertions(+), 230 deletions(-) diff --git a/Main.hs b/Main.hs index 6cdab2d..74260ab 100644 --- a/Main.hs +++ b/Main.hs @@ -20,11 +20,9 @@ with this program. If not, see . module Main (main) where import Control.Monad.Error -import Control.Monad.Identity import Control.Monad.State import Control.Monad.Writer import Data.Either -import Data.Generics (Data) import Data.List import qualified Data.Map as Map import Data.Maybe @@ -41,7 +39,6 @@ import qualified AST as A import CompilerCommands import CompState import Errors -import FlowGraph import GenerateC import GenerateCHP import GenerateCPPCSP diff --git a/alloy/Data/Generics/Alloy.hs b/alloy/Data/Generics/Alloy.hs index 5b52961..62c4c5a 100644 --- a/alloy/Data/Generics/Alloy.hs +++ b/alloy/Data/Generics/Alloy.hs @@ -135,8 +135,6 @@ module Data.Generics.Alloy (AlloyARoute(..), AlloyA(..), Alloy(..), import Control.Applicative import Control.Monad.Identity -import Data.Maybe -import Data.Tree import Data.Generics.Alloy.Route diff --git a/alloy/Data/Generics/Alloy/GenInstances.hs b/alloy/Data/Generics/Alloy/GenInstances.hs index 38d7f74..1cfc433 100644 --- a/alloy/Data/Generics/Alloy/GenInstances.hs +++ b/alloy/Data/Generics/Alloy/GenInstances.hs @@ -100,9 +100,9 @@ genInstance = GenInstance . findTypesIn data Witness = Plain { witness :: DataBox } | Detailed { witness :: DataBox - , directlyContains :: [DataBox] + , _directlyContains :: [DataBox] -- First is funcSameType, second is funcNewType: - , processChildrenMod :: (Bool -> String, Bool -> String) -> [String] + , _processChildrenMod :: (Bool -> String, Bool -> String) -> [String] } -- The Eq instance is based on the inner type. @@ -519,10 +519,6 @@ findTypesIn start = doType start where args = gmapQ DataBox (asTypeOf (fromConstr ctr) x) --- | Reduce a 'TypeMap' to only the types in a particular module. -filterModule :: String -> TypeMap -> TypeMap -filterModule prefix = Map.filter (((prefix ++ ".") `isPrefixOf`) . fst) - -- | Reduce a 'TypeMap' to a list of 'Witness'es, sorted by name. justBoxes :: TypeMap -> [Witness] justBoxes = map snd . sortBy (comparing fst) . Map.elems diff --git a/backends/BackendPasses.hs b/backends/BackendPasses.hs index 1114582..cade0db 100644 --- a/backends/BackendPasses.hs +++ b/backends/BackendPasses.hs @@ -22,7 +22,6 @@ module BackendPasses (backendPasses, transformWaitFor, declareSizesArray) where import Control.Monad.Error import Control.Monad.State import Data.Generics (Data) -import Data.Generics.Alloy import Data.List import qualified Data.Map as Map import Data.Maybe @@ -33,7 +32,6 @@ import Errors import EvalConstants import Metadata import Pass -import PrettyShow import qualified Properties as Prop import ShowCode import Traversal diff --git a/backends/BackendPassesTest.hs b/backends/BackendPassesTest.hs index e5d4387..a617739 100644 --- a/backends/BackendPassesTest.hs +++ b/backends/BackendPassesTest.hs @@ -178,17 +178,20 @@ testTransformWaitFor5 = TestCase $ testPass "testTransformWaitFor5" exp transfor newtype PosInts = PosInts [Int] deriving (Show) instance Arbitrary PosInts where + coarbitrary = error "coarbitrary" arbitrary = do len <- choose (1, 10) replicateM len (choose (1,1000)) >>* PosInts newtype PosInt = PosInt Int deriving (Show) instance Arbitrary PosInt where + coarbitrary = error "coarbitrary" arbitrary = choose (1,20) >>* PosInt newtype StaticTypeList = StaticTypeList [A.Type] deriving (Show) instance Arbitrary StaticTypeList where + coarbitrary = error "coarbitrary" arbitrary = do len <- choose (1,10) tl <- replicateM len $ frequency [ (10, return A.Int) @@ -203,6 +206,7 @@ instance Arbitrary StaticTypeList where newtype DynTypeList = DynTypeList [A.Type] deriving (Show) instance Arbitrary DynTypeList where + coarbitrary = error "coarbitrary" arbitrary = do len <- choose (1,10) tl <- replicateM len $ frequency [ (10, return A.Int) @@ -220,6 +224,7 @@ instance Arbitrary DynTypeList where newtype AbbrevTypesIs = AbbrevTypesIs ([A.Dimension], [A.Dimension], [A.Subscript]) deriving (Show) instance Arbitrary AbbrevTypesIs where + coarbitrary = error "coarbitrary" arbitrary = do lenSrc <- choose (1,10) lenDest <- choose (1, lenSrc) srcDims <- replicateM lenSrc $ oneof [return A.UnknownDimension, choose (1,1000) >>* dimension] diff --git a/backends/GenerateC.hs b/backends/GenerateC.hs index aecfb46..3297175 100644 --- a/backends/GenerateC.hs +++ b/backends/GenerateC.hs @@ -125,6 +125,7 @@ cgenOps = GenOps { genOutputItem = cgenOutputItem, genOverArray = cgenOverArray, genPar = cgenPar, + genPoison = error "genPoison", genProcCall = cgenProcCall, genProcess = cgenProcess, genRecordTypeSpec = cgenRecordTypeSpec, @@ -1825,8 +1826,6 @@ cgenAssign m [vA, vB] (A.AllocChannelBundle _ n) tell ["="] call genVariable' vA A.Original (const $ Pointer $ Plain "mt_cb_t") tell [";"] - where - el e = A.ExpressionList m [e] cgenAssign m _ _ = call genMissing "Cannot perform assignment with multiple destinations or multiple sources" isPOD :: A.Type -> Bool @@ -2132,7 +2131,8 @@ cgenProcCall n as (A.Proc _ _ fs _) <- specTypeOfName n when (length fs /= length as) $ dieP (A.nameMeta n) "Mismatched number of arguments to external call" - let inbetween = tell ["),(int)("] >> return (return ()) + let inbetween :: CGen (CGen ()) + inbetween = tell ["),(int)("] >> return (return ()) afters <- flip evalStateT 0 $ sequence $ intersperse (lift inbetween) $ map (uncurry $ genExternalActual (inbetween >> return ())) diff --git a/backends/GenerateCHP.hs b/backends/GenerateCHP.hs index 3b7fbc5..b826cf7 100644 --- a/backends/GenerateCHP.hs +++ b/backends/GenerateCHP.hs @@ -49,8 +49,6 @@ import System.IO import Text.Printf import qualified AST as A -import CompState -import Errors import EvalLiterals import Metadata import Pass @@ -93,7 +91,7 @@ genName n = let unders = [if c == '.' then '_' else c | c <- A.nameName n] in then tell ["_",unders] else tell [unders] - +genMissing :: String -> CGen () genMissing = flip genMissing' () genMissing' :: Data a => String -> a -> CGen() diff --git a/backends/GenerateCPPCSP.hs b/backends/GenerateCPPCSP.hs index b2a7abd..e11d3ee 100644 --- a/backends/GenerateCPPCSP.hs +++ b/backends/GenerateCPPCSP.hs @@ -32,7 +32,6 @@ module GenerateCPPCSP (cppcspPrereq, cppgenOps, generateCPPCSP, genCPPCSPPasses) import Control.Monad.State import Data.Char -import Data.Generics (Data) import Data.List import Data.Maybe import qualified Data.Set as Set @@ -373,23 +372,11 @@ cppgenOutputItem _ chan item genPoint v tell ["));"] -byteArrayChan :: A.Type -> Bool -byteArrayChan (A.Chan _ (A.UserProtocol _)) = True -byteArrayChan (A.Chan _ A.Any) = True -byteArrayChan (A.Chan _ (A.Counted _ _)) = True -byteArrayChan (A.ChanEnd _ _ (A.UserProtocol _)) = True -byteArrayChan (A.ChanEnd _ _ A.Any) = True -byteArrayChan (A.ChanEnd _ _ (A.Counted _ _)) = True -byteArrayChan _ = False - genPoint :: A.Variable -> CGen() genPoint v = do t <- astTypeOf v when (not $ isPoint t) $ tell ["&"] call genVariable v A.Original -genNonPoint :: A.Variable -> CGen() -genNonPoint v = do t <- astTypeOf v - when (isPoint t) $ tell ["*"] - call genVariable v A.Original + isPoint :: A.Type -> Bool isPoint (A.Record _) = True isPoint (A.Array _ _) = True diff --git a/backends/GenerateCTest.hs b/backends/GenerateCTest.hs index 8555eaa..5fbaaa9 100644 --- a/backends/GenerateCTest.hs +++ b/backends/GenerateCTest.hs @@ -31,7 +31,6 @@ with this program. If not, see . -- do a similar trick. module GenerateCTest (tests) where -import Control.Monad.Error import Control.Monad.State import Control.Monad.Reader import Control.Monad.Writer hiding (tell) @@ -186,11 +185,11 @@ testBothSame a b c = testBothSameS a b c (return ()) -- | These functions are here for a historical reason, and are all defined -- to be call. -tcall, tcall2, tcall3, tcall4, tcall5 :: CGenCall a => (GenOps -> a) -> a +tcall, tcall2, tcall3, _tcall4, tcall5 :: CGenCall a => (GenOps -> a) -> a tcall = call tcall2 = call tcall3 = call -tcall4 = call +_tcall4 = call tcall5 = call type Override = CGen () -> CGen () @@ -1191,9 +1190,8 @@ testOutput = TestList state = do defineName chan $ simpleDefDecl "c" (A.Chan (A.ChanAttributes A.Unshared A.Unshared) $ A.UserProtocol foo) defineName chanOut $ simpleDefDecl "cOut" (A.ChanEnd A.DirOutput A.Unshared $ A.UserProtocol foo) defineName foo $ simpleDef "foo" $ A.ProtocolCase emptyMeta [(simpleName "bar", [])] - overOutput, overOutputItem, over :: Override + overOutput, over :: Override overOutput = local $ \ops -> ops {genOutput = override2 caret} - overOutputItem = local $ \ops -> ops {genOutputItem = override3 caret} over = local $ \ops -> ops {genBytesIn = override3 caret} testBytesIn :: Test diff --git a/checks/ArrayUsageCheckTest.hs b/checks/ArrayUsageCheckTest.hs index a7462cc..2b14e4e 100644 --- a/checks/ArrayUsageCheckTest.hs +++ b/checks/ArrayUsageCheckTest.hs @@ -149,13 +149,13 @@ negateVars = map (transformPair id negate) n ** var = map (transformPair id (* n)) var con :: Integer -> [(Int,Integer)] con c = [(0,c)] -i,j,k,m,n,p :: [(Int, Integer)] +i,j,k,m,n,_p :: [(Int, Integer)] i = [(1,1)] j = [(2,1)] k = [(3,1)] m = [(4,1)] n = [(5,1)] -p = [(6,1)] +_p = [(6,1)] -- Turns a list like [(i,3),(j,4)] into proper answers answers :: [([(Int, Integer)],Integer)] -> Map.Map CoeffIndex Integer @@ -483,11 +483,6 @@ testMakeEquations = TestLabel "testMakeEquations" $ TestList makeParItems [Map.fromList [(UsageCheckUtils.Var $ variable "i", [RepBoundsIncl (variable "i") repFrom (subOneInt $ addExprsInt repFrom repFor)])]] exprs) upperBound) - pairLatterTwo (l,a,b,c) = (l,a,(b,c)) - - joinMapping :: [VarMap] -> ([HandyEq],[HandyIneq]) -> [(VarMap,[HandyEq],[HandyIneq])] - joinMapping vms (eq,ineq) = map (\vm -> (vm,eq,ineq)) vms - i_mapping :: VarMap i_mapping = Map.singleton (Scale 1 $ (exprVariable "i",0)) 1 ij_mapping :: VarMap @@ -509,10 +504,6 @@ testMakeEquations = TestLabel "testMakeEquations" $ TestList rep_i_mapping :: VarMap rep_i_mapping = Map.fromList [((Scale 1 (exprVariable "i",0)),1), ((Scale 1 (exprVariable "i",1)),2)] - rep_i_mapping' :: VarMap - rep_i_mapping' = Map.fromList [((Scale 1 (exprVariable "i",0)),2), ((Scale 1 (exprVariable "i",1)),1)] - - both_rep_i = joinMapping [rep_i_mapping, rep_i_mapping'] rep_i_mod_mapping :: Integer -> VarMap rep_i_mod_mapping n = Map.fromList [((Scale 1 (exprVariable "i",0)),1), ((Scale 1 (exprVariable "i",1)),2) @@ -552,6 +543,7 @@ instance Show MakeEquationInput where show = const "" instance Arbitrary MakeEquationInput where + coarbitrary = error "coarbitrary" arbitrary = generateEquationInput >>* MEI frequency' :: [(Int, StateT s Gen a)] -> StateT s Gen a @@ -938,9 +930,6 @@ assertEquivalentProblems title exp act showLabel :: (A.Expression, [ModuloCase]) -> String showLabel = showPairCustom showOccam show - showFunc :: (Int, [(EqualityProblem, InequalityProblem)]) -> String - showFunc = showPairCustom show $ showListCustom $ showProblem - fst3 :: (a,b,c) -> a fst3 (a,_,_) = a @@ -969,13 +958,6 @@ assertEquivalentProblems title exp act resize :: [Array CoeffIndex Integer] -> [Array CoeffIndex Integer] resize = map (makeArraySize (0, size) 0) - - - pairPairs (xa,ya) (xb,yb) = ((xa,xb), (ya,yb)) - - sortProblem :: [(EqualityProblem, InequalityProblem)] -> [(EqualityProblem, InequalityProblem)] - sortProblem = sort - -- QuickCheck tests for Omega Test: -- The idea is to begin with a random list of integers, representing answers. -- Combine this with a randomly generated matrix of coefficients for equalities @@ -1072,6 +1054,7 @@ generateProblem = choose (1,10) >>= (\n -> replicateM n $ choose (-20,20)) >>= makeAns = Map.fromList instance Arbitrary OmegaTestInput where + coarbitrary = error "coarbitrary" arbitrary = generateProblem >>* OMI qcOmegaEquality :: [LabelledQuickCheckTest] @@ -1157,6 +1140,7 @@ normaliseEquality eq = case listToMaybe $ filter (/= 0) $ elems eq of newtype OmegaPruneInput = OPI MutatedProblem deriving (Show) instance Arbitrary OmegaPruneInput where + coarbitrary = error "coarbitrary" arbitrary = ((generateProblem >>* snd) >>= (return . snd) >>= mutateEquations) >>* OPI qcOmegaPrune :: [LabelledQuickCheckTest] diff --git a/checks/Check.hs b/checks/Check.hs index faa4959..357d191 100644 --- a/checks/Check.hs +++ b/checks/Check.hs @@ -22,7 +22,6 @@ with this program. If not, see . -- the control-flow graph means that we only need to concentrate on each node that isn't nested. module Check (checkInitVarPass, usageCheckPass, checkUnusedVar) where -import Control.Monad.Identity import Control.Monad.State import Control.Monad.Trans import Data.Generics (Data) @@ -178,7 +177,7 @@ addBK mp mp2 g nid n -- no information about A even if the branch is taken). We do know that -- if the branch is not taken, A cannot be true, but that's dealt with -- because a negated OR ends up as an AND, see above. - | fn == bop "OR" = let f = liftM deAnd . g in + | fn == bop "OR" = do lhs' <- g lhs >>* deAnd rhs' <- g rhs >>* deAnd return $ And $ map (\(x,y) -> x `mappend` y) $ product2 (lhs', rhs') @@ -302,8 +301,8 @@ filterPlain' Everything = return Everything filterPlain' (NormalSet s) = filterPlain >>* flip Set.filter s >>* NormalSet data VarsBK = VarsBK { - readVarsBK :: Map.Map Var BK - ,writtenVarsBK :: Map.Map Var ([A.Expression], BK) + _readVarsBK :: Map.Map Var BK + ,_writtenVarsBK :: Map.Map Var ([A.Expression], BK) } -- | Unions all the maps into one, with possible BK for read, and possible BK for written. diff --git a/checks/CheckFramework.hs b/checks/CheckFramework.hs index 7e058eb..5370ab1 100644 --- a/checks/CheckFramework.hs +++ b/checks/CheckFramework.hs @@ -31,7 +31,6 @@ import Data.Graph.Inductive hiding (apply) import Data.List import qualified Data.Map as Map import Data.Maybe -import Data.Monoid import qualified Data.Set as Set import qualified AST as A @@ -47,9 +46,6 @@ import Traversal import UsageCheckUtils import Utils --- Temp: -todo = error "TODO" - -- Each data analysis only works on a connected sub-graph. For forward data flow -- this begins at the root node (the one with no predecessors, and thus is the -- direct or indirect predecessor of all nodes it is connected to), for backwards @@ -253,11 +249,6 @@ getFlowMeta = CheckOptFlowM $ Nothing -> return emptyMeta Just l -> return $ getNodeMeta l - - -forAnyParItems :: (ParItems a -> CheckOptM ()) -> CheckOptM () -forAnyParItems = undefined - -- | This function currently only supports one type forAnyASTTopDown :: forall a. (AlloyARoute A.AST (a :-@ BaseOpMRoute) BaseOpMRoute @@ -388,10 +379,6 @@ forAnyASTStructBottomUpAccum origF = CheckOptM $ do CheckOptASTM' [b] (A.Structured ()) ())) :-@ baseOpMRoute -type TransFunc a = (a, Route a A.AST) -> RestartT CheckOptM (Either a a) -type TransFuncAcc acc a = (a, Route a A.AST, acc) -> StateT acc (RestartT CheckOptM) (Either a a) -type TransFuncS acc b a = (a, Route a b) -> StateT acc (RestartT CheckOptM) a - -- | Given a TypeSet, a function to apply to everything of type a, a route -- location to begin at and an AST, transforms the tree. Handles any restarts -- that are requested. @@ -461,12 +448,6 @@ runChecksPass c = pass "" [] [] (runChecks c) --getParItems :: CheckOptM (ParItems ()) --getParItems = CheckOptM (\d -> Right (d, fromMaybe (generateParItems $ ast d) (parItems d))) -getParItems' :: CheckOptASTM t (ParItems ()) -getParItems' = todo - -generateParItems :: A.AST -> ParItems () -generateParItems = todo - -- | Performs the given action for the given child. [0] is the first argument -- of the current node's constructor, [2,1] is the second argument of the constructor -- of the third argument of this constructor. Issuing substitute inside this function diff --git a/checks/CheckTest.hs b/checks/CheckTest.hs index 6a5298d..b76cc4f 100644 --- a/checks/CheckTest.hs +++ b/checks/CheckTest.hs @@ -25,7 +25,6 @@ import qualified AST as A import Check import CheckFramework import CompState -import Metadata import OccamEDSL import TestHarness import TestUtils diff --git a/checks/UsageCheckAlgorithms.hs b/checks/UsageCheckAlgorithms.hs index 67f1219..6ac6497 100644 --- a/checks/UsageCheckAlgorithms.hs +++ b/checks/UsageCheckAlgorithms.hs @@ -19,7 +19,6 @@ with this program. If not, see . module UsageCheckAlgorithms (checkPar, findConstraints, findReachDef, joinCheckParFunctions) where import Control.Monad -import Data.Generics (Data) import Data.Graph.Inductive import Data.List import qualified Data.Map as Map diff --git a/checks/UsageCheckTest.hs b/checks/UsageCheckTest.hs index f012ae2..537a3f7 100644 --- a/checks/UsageCheckTest.hs +++ b/checks/UsageCheckTest.hs @@ -22,7 +22,6 @@ import Control.Monad.Error import Control.Monad.Reader import Data.Graph.Inductive import qualified Data.Map as Map -import qualified Data.Set as Set import Prelude hiding (fail) import Test.HUnit @@ -36,9 +35,7 @@ import OccamEDSL import TestFramework import TestUtils hiding (Var) import Types -import UsageCheckAlgorithms import UsageCheckUtils -import Utils --Shorthands for some variables to simplify the list of tests in this file @@ -132,8 +129,8 @@ type TestM = ReaderT CompState (Either String) instance Warn TestM where warnReport (_,_,s) = throwError s -buildTestFlowGraph :: [(Int, [Var], [Var])] -> [(Int, Int, EdgeLabel)] -> Int -> Int -> String -> FlowGraph TestM UsageLabel -buildTestFlowGraph ns es start end v +_buildTestFlowGraph :: [(Int, [Var], [Var])] -> [(Int, Int, EdgeLabel)] -> Int -> Int -> String -> FlowGraph TestM UsageLabel +_buildTestFlowGraph ns es start end v = mkGraph ([(-1,makeTestNode emptyMeta $ Usage Nothing (Just $ ScopeIn False v) Nothing emptyVars),(-2,makeTestNode emptyMeta $ Usage Nothing (Just $ ScopeOut v) Nothing diff --git a/common/CommonTest.hs b/common/CommonTest.hs index 6545f6e..0da1dc5 100644 --- a/common/CommonTest.hs +++ b/common/CommonTest.hs @@ -21,7 +21,7 @@ with this program. If not, see . -- | A module with tests for various miscellaneous things in the common directory. module CommonTest (tests) where -import Data.Generics (Constr, Data, Typeable) +import Data.Generics (Constr, Data) import Test.HUnit hiding (State) import qualified AST as A @@ -121,9 +121,6 @@ testDecomp = TestList doTest :: (Eq a, Show a) => Int -> Maybe a -> Maybe a -> Test doTest n exp act = TestCase $ assertEqual ("testDecomp " ++ show n) exp act -data NotPartOfAST = NotPartOfAST Int - deriving (Show, Typeable, Data) - --Returns the list of tests: tests :: Test tests = TestLabel "CommonTest" $ TestList diff --git a/common/EvalConstants.hs b/common/EvalConstants.hs index 5c74a36..7088a2a 100644 --- a/common/EvalConstants.hs +++ b/common/EvalConstants.hs @@ -26,9 +26,7 @@ module EvalConstants import Control.Monad.Error import Control.Monad.State -import Data.Bits import Data.Char -import Data.Int import Data.Maybe import Foreign import Numeric diff --git a/common/EvalLiterals.hs b/common/EvalLiterals.hs index 9ac21aa..b2de0da 100644 --- a/common/EvalLiterals.hs +++ b/common/EvalLiterals.hs @@ -20,7 +20,6 @@ with this program. If not, see . module EvalLiterals where import Control.Monad.Error -import Control.Monad.Identity import Control.Monad.State import Data.Char import Data.Generics (Data, Typeable) diff --git a/common/PrettyShow.hs b/common/PrettyShow.hs index 3305d26..1a9b41e 100644 --- a/common/PrettyShow.hs +++ b/common/PrettyShow.hs @@ -31,7 +31,6 @@ with this program. If not, see . -- language based on the 'csFrontend' in 'CompState', it is inside the CSM monad. module PrettyShow (pshow) where -import Control.Monad.State import Data.Generics import qualified Data.Map as Map import qualified Data.Set as Set @@ -41,7 +40,6 @@ import qualified AST as A import CompState hiding (CSM) -- everything here is read-only import Metadata import Pattern -import ShowCode -- This is ugly -- but it looks like you can't easily define a generic function -- even for a single tuple type, since it has to parameterise over multiple Data diff --git a/common/ShowCode.hs b/common/ShowCode.hs index df5c351..26f5a30 100644 --- a/common/ShowCode.hs +++ b/common/ShowCode.hs @@ -40,7 +40,6 @@ import Control.Monad.Writer import Data.Generics (Data, gshow) import Data.List import qualified Data.Map as Map -import Text.PrettyPrint.HughesPJ hiding (space, colon, semi) import Text.Regex import qualified AST as A @@ -305,9 +304,6 @@ instance ShowRain A.Type where = case dir of A.DirInput -> tell [if attr == A.Shared then "shared" else "", " ?"] >> showRainM t A.DirOutput -> tell [if attr == A.Shared then "shared" else "", " !"] >> showRainM t - where - ao :: Bool -> String - ao b = if b then "any" else "one" showRainM A.Time = tell ["time"] -- Mobility is not explicit in Rain, but we should indicate it: showRainM (A.Mobile t) = tell [""] >> showRainM t diff --git a/common/Types.hs b/common/Types.hs index 1aaa268..808690f 100644 --- a/common/Types.hs +++ b/common/Types.hs @@ -57,7 +57,6 @@ import Metadata import Operators import PrettyShow import ShowCode -import Traversal import TypeSizes import Utils diff --git a/flow/FlowGraphTest.hs b/flow/FlowGraphTest.hs index 8156b37..7b20324 100644 --- a/flow/FlowGraphTest.hs +++ b/flow/FlowGraphTest.hs @@ -558,6 +558,7 @@ enforceSize1 f = sized $ \n -> if n == 0 then resize 1 f else f -- | An instance of Arbitrary for A.Structured that wraps the "genStructured" function. instance Arbitrary (QC (A.Process, Map.Map [Meta] A.Process)) where + coarbitrary = error "coarbitrary" arbitrary = enforceSize1 $ sized $ \n -> evalStateT (genProcess n) (Id 0) >>* findEmpty >>* QC where -- Copies the value for the empty-list key into the first element of the tuple: diff --git a/frontends/OccamInferTypes.hs b/frontends/OccamInferTypes.hs index 6ac5db9..a5cda10 100644 --- a/frontends/OccamInferTypes.hs +++ b/frontends/OccamInferTypes.hs @@ -74,19 +74,6 @@ inTypeContext ctx body noTypeContext :: InferTypeM a -> InferTypeM a noTypeContext = inTypeContext Nothing --- | Run an operation in the type context that results from subscripting --- the current type context. --- If the current type context is 'Nothing', the resulting one will be too. -inSubscriptedContext :: Meta -> InferTypeM a -> InferTypeM a -inSubscriptedContext m body - = do ctx <- getTypeContext - subCtx <- case ctx of - Just t@(A.Array _ _) -> - trivialSubscriptType m t >>* Just - Just t -> diePC m $ formatCode "Attempting to subscript non-array type %" t - Nothing -> return Nothing - inTypeContext subCtx body - --}}} addDirections :: PassOn2 A.Process A.Alternative diff --git a/frontends/OccamPasses.hs b/frontends/OccamPasses.hs index 5336b86..9358423 100644 --- a/frontends/OccamPasses.hs +++ b/frontends/OccamPasses.hs @@ -21,7 +21,6 @@ module OccamPasses (occamPasses, foldConstants, checkConstants, CheckConstantsOp -- The ops are exported to make testing easier import Control.Monad.State -import Data.Generics (Data) import Data.List import qualified Data.Sequence as Seq import qualified Data.Foldable as F diff --git a/frontends/OccamPassesTest.hs b/frontends/OccamPassesTest.hs index 7aa9b40..1a01fa0 100644 --- a/frontends/OccamPassesTest.hs +++ b/frontends/OccamPassesTest.hs @@ -30,7 +30,6 @@ import qualified AST as A import CompState import Metadata import qualified OccamPasses -import Pass import TestUtils import Traversal import Types diff --git a/frontends/OccamTypesTest.hs b/frontends/OccamTypesTest.hs index ca74a15..9c0e333 100644 --- a/frontends/OccamTypesTest.hs +++ b/frontends/OccamTypesTest.hs @@ -29,7 +29,6 @@ import qualified AST as A import CompState import Metadata import qualified OccamCheckTypes as OccamTypes -import Pass import TestHarness import TestUtils import Traversal diff --git a/frontends/ParseOccam.hs b/frontends/ParseOccam.hs index d5cb7b2..61ddf8c 100644 --- a/frontends/ParseOccam.hs +++ b/frontends/ParseOccam.hs @@ -20,7 +20,7 @@ with this program. If not, see . module ParseOccam (parseOccamProgram) where import Control.Monad (join, liftM, when) -import Control.Monad.State (MonadState, modify, get, put) +import Control.Monad.State (MonadState, get, put) import Data.Char import Data.List import qualified Data.Map as Map @@ -147,24 +147,19 @@ sSemi = reserved ";" --}}} --{{{ keywords -sAFTER, sALT, sAND, sANY, sAT, sBITAND, sBITNOT, sBITOR, sBOOL, sBYTE, - sBYTESIN, sCASE, sCHAN, sCLAIM, sCLONE, sDATA, sDEFINED, sELSE, sFALSE, - sFOR, sFORK, sFORKING, sFROM, sFUNCTION, sIF, sINLINE, sIN, sINITIAL, sINT, - sINT16, sINT32, sINT64, sIS, sMINUS, sMOBILE, sMOSTNEG, sMOSTPOS, sNOT, sOF, - sOFFSETOF, sOR, sPACKED, sPAR, sPLACE, sPLACED, sPLUS, sPORT, sPRI, sPROC, - sPROCESSOR, sPROTOCOL, sREAL32, sREAL64, sRECORD, sREC_RECURSIVE, sREM, - sRESHAPES, sRESULT, sRETYPES, sROUND, sSEQ, sSHARED, sSIZE, sSKIP, sSTEP, - sSTOP, sTIMER, sTIMES, sTRUE, sTRUNC, sTYPE, sVAL, sVALOF, sWHILE, +sAFTER, sALT, sANY, sAT, sBOOL, sBYTE, sBYTESIN, sCASE, sCHAN, sCLAIM, sCLONE, + sDATA, sDEFINED, sELSE, sFALSE, sFOR, sFORK, sFORKING, sFROM, sFUNCTION, + sIF, sINLINE, sIN, sINITIAL, sINT, sINT16, sINT32, sINT64, sIS, sMOBILE, + sMOSTNEG, sMOSTPOS, sOF, sOFFSETOF, sPACKED, sPAR, sPLACE, sPLACED, sPORT, + sPRI, sPROC, sPROCESSOR, sPROTOCOL, sREAL32, sREAL64, sRECORD, + sREC_RECURSIVE, sRESHAPES, sRESULT, sRETYPES, sROUND, sSEQ, sSHARED, sSIZE, + sSKIP, sSTEP, sSTOP, sTIMER, sTRUE, sTRUNC, sTYPE, sVAL, sVALOF, sWHILE, sWORKSPACE, sVECSPACE :: OccParser () sAFTER = reserved "AFTER" sALT = reserved "ALT" -sAND = reserved "AND" sANY = reserved "ANY" sAT = reserved "AT" -sBITAND = reserved "BITAND" -sBITNOT = reserved "BITNOT" -sBITOR = reserved "BITOR" sBOOL = reserved "BOOL" sBYTE = reserved "BYTE" sBYTESIN = reserved "BYTESIN" @@ -190,19 +185,15 @@ sINT16 = reserved "INT16" sINT32 = reserved "INT32" sINT64 = reserved "INT64" sIS = reserved "IS" -sMINUS = reserved "MINUS" sMOBILE = reserved "MOBILE" sMOSTNEG = reserved "MOSTNEG" sMOSTPOS = reserved "MOSTPOS" -sNOT = reserved "NOT" sOF = reserved "OF" sOFFSETOF = reserved "OFFSETOF" -sOR = reserved "OR" sPACKED = reserved "PACKED" sPAR = reserved "PAR" sPLACE = reserved "PLACE" sPLACED = reserved "PLACED" -sPLUS = reserved "PLUS" sPORT = reserved "PORT" sPRI = reserved "PRI" sPROC = reserved "PROC" @@ -212,7 +203,6 @@ sREAL32 = reserved "REAL32" sREAL64 = reserved "REAL64" sREC_RECURSIVE = reserved "REC" <|> reserved "RECURSIVE" sRECORD = reserved "RECORD" -sREM = reserved "REM" sRESHAPES = reserved "RESHAPES" sRESULT = reserved "RESULT" sRETYPES = reserved "RETYPES" @@ -224,7 +214,6 @@ sSKIP = reserved "SKIP" sSTEP = reserved "STEP" sSTOP = reserved "STOP" sTIMER = reserved "TIMER" -sTIMES = reserved "TIMES" sTRUE = reserved "TRUE" sTRUNC = reserved "TRUNC" sTYPE = reserved "TYPE" @@ -281,8 +270,8 @@ tryXVV a b c = try (do { a; bv <- b; cv <- c; return (bv, cv) }) tryVXX :: OccParser a -> OccParser b -> OccParser c -> OccParser a tryVXX a b c = try (do { av <- a; b; c; return av }) -tryVXV :: OccParser a -> OccParser b -> OccParser c -> OccParser (a, c) -tryVXV a b c = try (do { av <- a; b; cv <- c; return (av, cv) }) +_tryVXV :: OccParser a -> OccParser b -> OccParser c -> OccParser (a, c) +_tryVXV a b c = try (do { av <- a; b; cv <- c; return (av, cv) }) tryVVX :: OccParser a -> OccParser b -> OccParser c -> OccParser (a, b) tryVVX a b c = try (do { av <- a; bv <- b; c; return (av, bv) }) @@ -293,17 +282,17 @@ tryXXX a b c = try (do { a; b; c; return () }) tryXVXV :: OccParser a -> OccParser b -> OccParser c -> OccParser d -> OccParser (b, d) tryXVXV a b c d = try (do { a; bv <- b; c; dv <- d; return (bv, dv) }) -tryXVVX :: OccParser a -> OccParser b -> OccParser c -> OccParser d -> OccParser (b, c) -tryXVVX a b c d = try (do { a; bv <- b; cv <- c; d; return (bv, cv) }) +_tryXVVX :: OccParser a -> OccParser b -> OccParser c -> OccParser d -> OccParser (b, c) +_tryXVVX a b c d = try (do { a; bv <- b; cv <- c; d; return (bv, cv) }) -tryVXXV :: OccParser a -> OccParser b -> OccParser c -> OccParser d -> OccParser (a, d) -tryVXXV a b c d = try (do { av <- a; b; c; dv <- d; return (av, dv) }) +_tryVXXV :: OccParser a -> OccParser b -> OccParser c -> OccParser d -> OccParser (a, d) +_tryVXXV a b c d = try (do { av <- a; b; c; dv <- d; return (av, dv) }) tryVXVX :: OccParser a -> OccParser b -> OccParser c -> OccParser d -> OccParser (a, c) tryVXVX a b c d = try (do { av <- a; b; cv <- c; d; return (av, cv) }) -tryVVXX :: OccParser a -> OccParser b -> OccParser c -> OccParser d -> OccParser (a, b) -tryVVXX a b c d = try (do { av <- a; bv <- b; c; d; return (av, bv) }) +_tryVVXX :: OccParser a -> OccParser b -> OccParser c -> OccParser d -> OccParser (a, b) +_tryVVXX a b c d = try (do { av <- a; bv <- b; c; d; return (av, bv) }) tryVVXV :: OccParser a -> OccParser b -> OccParser c -> OccParser d -> OccParser (a, b, d) tryVVXV a b c d = try (do { av <- a; bv <- b; c; dv <- d; return (av, bv, dv) }) @@ -530,8 +519,8 @@ recordName = name RecordName timerName = name TimerName variableName = name VariableName -newChannelName, newChanBundleName, newDataTypeName, newFunctionName, newPortName, - newProcName, newProtocolName, newRecordName, newTimerName, newUDOName, +newChannelName, newChanBundleName, newDataTypeName, newFunctionName, _newPortName, + newProcName, newProtocolName, newRecordName, _newTimerName, newUDOName, newVariableName :: OccParser A.Name @@ -539,11 +528,11 @@ newChannelName = newName ChannelName newChanBundleName = newName ChanBundleName newDataTypeName = newName DataTypeName newFunctionName = newName FunctionName -newPortName = newName PortName +_newPortName = newName PortName newProcName = newName ProcName newProtocolName = newName ProtocolName newRecordName = newName RecordName -newTimerName = newName TimerName +_newTimerName = newName TimerName newVariableName = newName VariableName newUDOName = do m <- md diff --git a/frontends/ParseRainTest.hs b/frontends/ParseRainTest.hs index b418d14..cf9b749 100644 --- a/frontends/ParseRainTest.hs +++ b/frontends/ParseRainTest.hs @@ -35,6 +35,9 @@ with this program. If not, see . -- and then turn these into Patterns where any Meta tag that is "m" is ignored during the comparison. module ParseRainTest (tests) where +import Test.HUnit + +{- import Data.Generics (Data) import Prelude hiding (fail) import Test.HUnit @@ -137,7 +140,6 @@ emptyBlock = A.Seq m emptySeveral --subExpr' ::= exprItem | monadicArithOp subExpr' | "(" expression ")" -{- testExprs :: [ParseTest A.Expression] testExprs = [ @@ -784,11 +786,11 @@ tests = TestLabel "ParseRainTest" $ TestList -- functions -- typedefs - +{- where parseTest :: Show a => ParseTest a -> Test parseTest (ExpPass test) = TestCase (testParsePass test) parseTest (ExpFail test) = TestCase (testParseFail test) parseTests :: Show a => [ParseTest a] -> Test parseTests tests = TestList (map parseTest tests) - +-} diff --git a/frontends/RainPasses.hs b/frontends/RainPasses.hs index ece4a0b..1857c4a 100644 --- a/frontends/RainPasses.hs +++ b/frontends/RainPasses.hs @@ -27,7 +27,6 @@ import Data.Maybe import qualified AST as A import CompState -import Errors import ImplicitMobility import Metadata import Pass diff --git a/frontends/RainPassesTest.hs b/frontends/RainPassesTest.hs index 8b11f45..defe6b5 100644 --- a/frontends/RainPassesTest.hs +++ b/frontends/RainPassesTest.hs @@ -31,7 +31,7 @@ module RainPassesTest (tests) where import Control.Monad.State import Control.Monad.Identity -import Data.Generics (Data, Typeable) +import Data.Generics (Typeable) import qualified Data.Map as Map import Test.HUnit hiding (State) @@ -219,7 +219,7 @@ testUnique4 = TestCase $ testPassWithItemsStateCheck "testUnique4" exp uniquifyA --Easy way to string two passes together; creates a pass-like function that applies the left-hand pass then the right-hand pass. Associative. (>>>) :: Pass t -> Pass t -> Pass t -(>>>) f0 f1 = Pass {passCode = passCode f1 <.< passCode f0} +(>>>) f0 f1 = f0 {passCode = passCode f1 <.< passCode f0} --Normally, process names in Rain are not mangled. And this should be fine in all cases - but not for the main process (which would --result in a function called main. Therefore we must mangle main. Ideally into a nonce, but for now into ____main diff --git a/frontends/RainTypes.hs b/frontends/RainTypes.hs index 424e457..e4685bd 100644 --- a/frontends/RainTypes.hs +++ b/frontends/RainTypes.hs @@ -59,8 +59,6 @@ startState = RainTypeState { type RainTypeM = StateT RainTypeState PassM -type RainTypePassType = forall t. t -> StateT RainTypeState PassM t - type RainTypeCheckOn a = forall t. AlloyA t (OneOpM a) BaseOpM => t -> RainTypeM () diff --git a/frontends/RainTypesTest.hs b/frontends/RainTypesTest.hs index a2d7592..4ad3c6a 100644 --- a/frontends/RainTypesTest.hs +++ b/frontends/RainTypesTest.hs @@ -19,30 +19,28 @@ with this program. If not, see . -- | A module testing things from the RainTypes module. module RainTypesTest (vioTests) where -import Control.Monad.State -import Control.Monad.Error +--import Control.Monad.Error import Control.Monad.Writer -import Data.Generics (Data) -import qualified Data.Map as Map +--import Data.Generics (Data) +--import qualified Data.Map as Map import Test.HUnit hiding (State) -import qualified AST as A -import CompState -import Errors -import Metadata -import Pass -import Pattern -import RainTypes -import TagAST -import TestHarness -import TestUtils -import TreeUtils -import Types -import TypeUnification -import Utils -m :: Meta -m = emptyMeta +--import qualified AST as A +import CompState +--import Errors +--import Metadata +--import Pass +--import Pattern +--import RainTypes +--import TagAST +import TestHarness +--import TestUtils +--import TreeUtils +--import Types +--import TypeUnification +--import Utils + -- | Tests that constants in expressions are folded properly. TODO these tests could do with a lot of expanding. -- It may even be easiest to use QuickCheck for the testing. @@ -57,7 +55,7 @@ constantFoldTest = TestList [] {- ,foldCon 102 (lit (- two63)) (Dy (lit $ two63 - 1) A.Plus (lit 1)) ,foldCon 110 (Dy (Var "x") A.Plus (lit 2)) (Dy (Var "x") A.Plus (Dy (lit 1) A.Plus (lit 1))) - ] -} + ] where two63 :: Integer two63 = 9223372036854775808 @@ -73,7 +71,7 @@ constantFoldTest = TestList [] {- lit :: Integer -> ExprHelper lit n = Lit $ int64Literal n - +-} testUnify :: Test testUnify = TestList [] {- [pass [] [] [] diff --git a/frontends/StructureOccam.hs b/frontends/StructureOccam.hs index 1c58d91..913b77b 100644 --- a/frontends/StructureOccam.hs +++ b/frontends/StructureOccam.hs @@ -22,7 +22,6 @@ module StructureOccam (structureOccam) where import Errors import LexOccam import Metadata -import Pass -- | Reserved words that, if found at the end of a line, indicate the next -- line is a continuation. diff --git a/frontends/TypeUnification.hs b/frontends/TypeUnification.hs index 2a318c0..eafde05 100644 --- a/frontends/TypeUnification.hs +++ b/frontends/TypeUnification.hs @@ -18,10 +18,9 @@ with this program. If not, see . module TypeUnification where -import Control.Monad import Control.Monad.State import Control.Monad.Trans -import Data.Generics (Data, Typeable) +import Data.Generics (Typeable) import qualified Data.Map as Map import Data.Maybe import Data.IORef diff --git a/pass/PassList.hs b/pass/PassList.hs index f3cb307..a9fbbe3 100644 --- a/pass/PassList.hs +++ b/pass/PassList.hs @@ -28,7 +28,6 @@ import qualified Data.Set as Set import qualified AST as A import BackendPasses import Check -import CheckFramework import CompState import Errors import GenerateC diff --git a/pregen/GenTagAST.hs b/pregen/GenTagAST.hs index eac1b3d..d91c8c0 100644 --- a/pregen/GenTagAST.hs +++ b/pregen/GenTagAST.hs @@ -24,7 +24,6 @@ module GenTagAST where import Data.Char import Data.Generics -import Data.List (intersperse) import PregenUtils import Utils diff --git a/transformations/ImplicitMobility.hs b/transformations/ImplicitMobility.hs index 0fb2569..f6d2fc9 100644 --- a/transformations/ImplicitMobility.hs +++ b/transformations/ImplicitMobility.hs @@ -20,7 +20,6 @@ module ImplicitMobility (implicitMobility, mobiliseArrays, inferDeref) where import Control.Monad import Control.Monad.Trans -import Data.Generics (Data) import Data.Graph.Inductive import Data.Graph.Inductive.Query.DFS import qualified Data.Map as Map @@ -48,27 +47,6 @@ effectDecision :: Var -> Decision -> AlterAST PassM () -> A.AST -> PassM A.AST effectDecision _ Move _ = return -- Move is the default effectDecision targetVar (Copy _) (AlterProcess wrapper) = routeModify wrapper alterProc where - derefExp :: A.Expression -> PassM A.Expression - derefExp e - = do t <- astTypeOf e - {-case t of - A.Mobile (A.List _) -> return () - A.List _ -> return () - _ -> dieP (findMeta e) $ - "Cannot dereference a non-list assignment RHS: " ++ show t -} - case e of - A.ExprVariable m' v -> - if (Var v == targetVar) - then return $ A.CloneMobile m' $ A.ExprVariable m' v - else return e - -- TODO handle concat expressions with repeated vars - {- - A.Dyadic m A.Concat lhs rhs -> - do lhs' <- derefExp lhs - rhs' <- derefExp rhs - return $ A.Dyadic m A.Concat lhs' rhs' - -} - _ -> return e alterProc :: A.Process -> PassM A.Process alterProc (A.Assign m lhs (A.ExpressionList m' [e])) = return $ A.Assign m lhs $ A.ExpressionList m' [A.CloneMobile m' e] diff --git a/transformations/SimplifyAbbrevs.hs b/transformations/SimplifyAbbrevs.hs index c8fc60c..0ece467 100644 --- a/transformations/SimplifyAbbrevs.hs +++ b/transformations/SimplifyAbbrevs.hs @@ -31,7 +31,6 @@ import qualified Data.Set as Set import qualified AST as A import CompState -import Errors import Metadata import OrdAST() import Pass diff --git a/transformations/SimplifyAbbrevsTest.hs b/transformations/SimplifyAbbrevsTest.hs index 3efdf7f..ca60f70 100644 --- a/transformations/SimplifyAbbrevsTest.hs +++ b/transformations/SimplifyAbbrevsTest.hs @@ -26,7 +26,6 @@ import Test.HUnit hiding (State) import CompState import qualified AST as A import Metadata -import Pass import Pattern import SimplifyAbbrevs import TagAST diff --git a/transformations/SimplifyProcs.hs b/transformations/SimplifyProcs.hs index ccc6a46..dd46556 100644 --- a/transformations/SimplifyProcs.hs +++ b/transformations/SimplifyProcs.hs @@ -23,7 +23,6 @@ import Control.Monad.State import Data.Generics (Data) import qualified Data.Map as Map import Data.Maybe -import qualified Data.Set as Set import qualified AST as A import CompState diff --git a/transformations/SimplifyTypes.hs b/transformations/SimplifyTypes.hs index 3008311..bbde7ac 100644 --- a/transformations/SimplifyTypes.hs +++ b/transformations/SimplifyTypes.hs @@ -23,16 +23,13 @@ module SimplifyTypes ( ) where import Control.Monad.State -import qualified Data.Traversable as T import qualified AST as A -import CompState import Metadata import Pass import qualified Properties as Prop import Traversal import Types -import Utils simplifyTypes :: [Pass A.AST] simplifyTypes diff --git a/transformations/SimplifyTypesTest.hs b/transformations/SimplifyTypesTest.hs index 7bf4f0a..814b77d 100644 --- a/transformations/SimplifyTypesTest.hs +++ b/transformations/SimplifyTypesTest.hs @@ -25,17 +25,9 @@ import Test.HUnit hiding (State) import CompState import qualified AST as A -import Metadata -import Pass -import Pattern import SimplifyTypes -import TagAST import TestUtils import Traversal -import TreeUtils - -m :: Meta -m = emptyMeta setupState :: State CompState () setupState diff --git a/transformations/Unnest.hs b/transformations/Unnest.hs index 728dbda..0932063 100644 --- a/transformations/Unnest.hs +++ b/transformations/Unnest.hs @@ -19,19 +19,16 @@ with this program. If not, see . -- | Flatten nested declarations. module Unnest (unnest, removeNesting) where -import Control.Monad.Identity import Control.Monad.State import Data.Generics (Data) import Data.List import qualified Data.Map as Map import Data.Maybe -import Data.Tree import qualified AST as A import CompState import Errors import EvalConstants -import Metadata import Pass import qualified Properties as Prop import Traversal @@ -54,9 +51,6 @@ type FreeNameOps = A.SpecType :-* A.Name :-* ExtOpMS BaseOpM freeNamesIn :: AlloyA t FreeNameOps BaseOpM => t -> NameMap freeNamesIn = flip execState Map.empty . recurse where - flattenTree :: Tree (Maybe NameMap) -> NameMap - flattenTree = foldl Map.union Map.empty . catMaybes . flatten - ops :: FreeNameOps FreeNameM ops = doSpecType :-* doName :-* opMS (ops, doStructured) @@ -65,9 +59,6 @@ freeNamesIn = flip execState Map.empty . recurse descend :: DescendA FreeNameM FreeNameOps descend = makeDescendM ops - ignore :: t -> NameMap - ignore s = Map.empty - doName :: A.Name -> FreeNameM A.Name doName n = modify (Map.insert (A.nameName n) n) >> return n