Cleaned up all the warnings in Tock's code (most unused modules, or unused functions)

This commit is contained in:
Neil Brown 2009-05-19 09:05:38 +00:00
parent 48e50938f7
commit d98c5079ca
43 changed files with 75 additions and 230 deletions

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -25,7 +25,6 @@ import qualified AST as A
import Check
import CheckFramework
import CompState
import Metadata
import OccamEDSL
import TestHarness
import TestUtils

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -57,7 +57,6 @@ import Metadata
import Operators
import PrettyShow
import ShowCode
import Traversal
import TypeSizes
import Utils

View File

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

View File

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

View File

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

View File

@ -30,7 +30,6 @@ import qualified AST as A
import CompState
import Metadata
import qualified OccamPasses
import Pass
import TestUtils
import Traversal
import Types

View File

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

View File

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

View File

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

View File

@ -27,7 +27,6 @@ import Data.Maybe
import qualified AST as A
import CompState
import Errors
import ImplicitMobility
import Metadata
import Pass

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -24,7 +24,6 @@ module GenTagAST where
import Data.Char
import Data.Generics
import Data.List (intersperse)
import PregenUtils
import Utils

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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