Cleaned up all the warnings in Tock's code (most unused modules, or unused functions)
This commit is contained in:
parent
48e50938f7
commit
d98c5079ca
3
Main.hs
3
Main.hs
|
@ -20,11 +20,9 @@ with this program. If not, see <http://www.gnu.org/licenses/>.
|
|||
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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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]
|
||||
|
|
|
@ -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 ()))
|
||||
|
|
|
@ -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()
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -31,7 +31,6 @@ with this program. If not, see <http://www.gnu.org/licenses/>.
|
|||
-- 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
|
||||
|
|
|
@ -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]
|
||||
|
|
|
@ -22,7 +22,6 @@ with this program. If not, see <http://www.gnu.org/licenses/>.
|
|||
-- 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.
|
||||
|
|
|
@ -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 "<Check>" [] [] (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
|
||||
|
|
|
@ -25,7 +25,6 @@ import qualified AST as A
|
|||
import Check
|
||||
import CheckFramework
|
||||
import CompState
|
||||
import Metadata
|
||||
import OccamEDSL
|
||||
import TestHarness
|
||||
import TestUtils
|
||||
|
|
|
@ -19,7 +19,6 @@ with this program. If not, see <http://www.gnu.org/licenses/>.
|
|||
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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -21,7 +21,7 @@ with this program. If not, see <http://www.gnu.org/licenses/>.
|
|||
-- | 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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -20,7 +20,6 @@ with this program. If not, see <http://www.gnu.org/licenses/>.
|
|||
module EvalLiterals where
|
||||
|
||||
import Control.Monad.Error
|
||||
import Control.Monad.Identity
|
||||
import Control.Monad.State
|
||||
import Data.Char
|
||||
import Data.Generics (Data, Typeable)
|
||||
|
|
|
@ -31,7 +31,6 @@ with this program. If not, see <http://www.gnu.org/licenses/>.
|
|||
-- 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
|
||||
|
|
|
@ -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 ["<mobile>"] >> showRainM t
|
||||
|
|
|
@ -57,7 +57,6 @@ import Metadata
|
|||
import Operators
|
||||
import PrettyShow
|
||||
import ShowCode
|
||||
import Traversal
|
||||
import TypeSizes
|
||||
import Utils
|
||||
|
||||
|
|
|
@ -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:
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -30,7 +30,6 @@ import qualified AST as A
|
|||
import CompState
|
||||
import Metadata
|
||||
import qualified OccamPasses
|
||||
import Pass
|
||||
import TestUtils
|
||||
import Traversal
|
||||
import Types
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -20,7 +20,7 @@ with this program. If not, see <http://www.gnu.org/licenses/>.
|
|||
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
|
||||
|
|
|
@ -35,6 +35,9 @@ with this program. If not, see <http://www.gnu.org/licenses/>.
|
|||
-- 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)
|
||||
|
||||
-}
|
||||
|
|
|
@ -27,7 +27,6 @@ import Data.Maybe
|
|||
|
||||
import qualified AST as A
|
||||
import CompState
|
||||
import Errors
|
||||
import ImplicitMobility
|
||||
import Metadata
|
||||
import Pass
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ()
|
||||
|
||||
|
|
|
@ -19,30 +19,28 @@ with this program. If not, see <http://www.gnu.org/licenses/>.
|
|||
-- | 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 [] [] []
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -18,10 +18,9 @@ with this program. If not, see <http://www.gnu.org/licenses/>.
|
|||
|
||||
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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -24,7 +24,6 @@ module GenTagAST where
|
|||
|
||||
import Data.Char
|
||||
import Data.Generics
|
||||
import Data.List (intersperse)
|
||||
|
||||
import PregenUtils
|
||||
import Utils
|
||||
|
|
|
@ -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]
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -19,19 +19,16 @@ with this program. If not, see <http://www.gnu.org/licenses/>.
|
|||
-- | 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
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user