Added types to all the cases where the monomorhpism restriction applied
This commit is contained in:
parent
16d4320909
commit
bdda623d7e
|
@ -337,6 +337,7 @@ testArraySubscript = TestList
|
|||
|
||||
]
|
||||
where
|
||||
stateTrans :: CSM m => m ()
|
||||
stateTrans = defineName (simpleName "foo") $ simpleDefDecl "foo" (A.Array [A.Dimension 7,A.Dimension 8,A.Dimension 8] A.Int)
|
||||
m = "\"" ++ show emptyMeta ++ "\""
|
||||
|
||||
|
@ -398,7 +399,9 @@ testOverArray = TestList $ map testOverArray'
|
|||
"for\\(int ([[:alnum:]_]+)=0;\\2<foo" ++ sz 1 ++ ";\\2\\+\\+)\\{" ++
|
||||
"for\\(int ([[:alnum:]_]+)=0;\\3<foo" ++ sz 2 ++ ";\\3\\+\\+)\\{" ++
|
||||
"foo" ++ (f' [("\\1",[1,2]),("\\2",[2]),("\\3",[])]) ++ suff ++ ";\\}\\}\\}$"
|
||||
state1 :: CSM m => m ()
|
||||
state1 = defineName (simpleName "foo") $ simpleDefDecl "foo" (A.Array [A.Dimension 7] A.Int)
|
||||
state3 :: CSM m => m ()
|
||||
state3 = defineName (simpleName "foo") $ simpleDefDecl "foo" (A.Array [A.Dimension 7, A.Dimension 8, A.Dimension 9] A.Int)
|
||||
|
||||
testReplicator :: Test
|
||||
|
@ -1046,6 +1049,7 @@ testOutput = TestList
|
|||
|
||||
chan = simpleName "c"
|
||||
chanOut = simpleName "cOut"
|
||||
state :: CSM m => m ()
|
||||
state = do defineName chan $ simpleDefDecl "c" (A.Chan A.DirUnknown (A.ChanAttributes False False) $ A.UserProtocol foo)
|
||||
defineName chanOut $ simpleDefDecl "cOut" (A.Chan A.DirOutput (A.ChanAttributes False False) $ A.UserProtocol foo)
|
||||
overOutput ops = ops {genOutput = override2 caret}
|
||||
|
|
|
@ -61,6 +61,7 @@ dieIO (Just m@(Meta (Just fn) line column),s) = liftIO $
|
|||
putStrLn ""
|
||||
printError $ (show m) ++ " " ++ s
|
||||
where
|
||||
contextLines :: Int
|
||||
contextLines = 5
|
||||
-- start is unit-based, so we need to convert to zero-based
|
||||
getLines :: String -> Int -> Int -> [String]
|
||||
|
|
|
@ -511,6 +511,7 @@ genProcess n = nextIdT >>* makeMeta' >>= \m -> (flip oneofLS) n
|
|||
genGraph :: A.Structured -> FlowGraph Identity ()
|
||||
genGraph s = either (\e -> error $ "QuickCheck graph did not build properly: " ++ e ++ ", from: " ++ pshow s) id $ runIdentity $ buildFlowGraph funcs s
|
||||
where
|
||||
empty :: a -> Identity ()
|
||||
empty = const (return ())
|
||||
funcs = GLF empty empty empty empty empty empty
|
||||
|
||||
|
|
|
@ -370,6 +370,7 @@ matchType et rt
|
|||
else bad
|
||||
_ -> if rt == et then return () else bad
|
||||
where
|
||||
bad :: OccParser ()
|
||||
bad = die $ "type mismatch (got " ++ showOccam rt ++ "; expected " ++ showOccam et ++ ")"
|
||||
|
||||
-- | Check that two lists of types match (for example, for parallel assignment).
|
||||
|
@ -1462,7 +1463,9 @@ formalArgSet
|
|||
<|> formalItem (aa channelSpecifier) newChannelName
|
||||
<|> formalItem (aa timerSpecifier) newTimerName
|
||||
<|> formalItem (aa portSpecifier) newPortName
|
||||
where aa = liftM (\t -> (A.Abbrev, t))
|
||||
where
|
||||
aa :: OccParser A.Type -> OccParser (A.AbbrevMode, A.Type)
|
||||
aa = liftM (\t -> (A.Abbrev, t))
|
||||
|
||||
formalVariableType :: OccParser (A.AbbrevMode, A.Type)
|
||||
formalVariableType
|
||||
|
|
|
@ -64,6 +64,7 @@ structureOccam ts = analyse 1 firstLine ts (emptyMeta, EndOfLine)
|
|||
_ -> False
|
||||
|
||||
-- A new line -- look to see what's going on with the indentation.
|
||||
newLine :: [Token] -> PassM [Token]
|
||||
newLine rest
|
||||
| col == prevCol + 2 = withEOL $ (m, Indent) : rest
|
||||
-- FIXME: If col > prevCol, then look to see if there's a VALOF
|
||||
|
@ -76,6 +77,7 @@ structureOccam ts = analyse 1 firstLine ts (emptyMeta, EndOfLine)
|
|||
| otherwise = bad
|
||||
where
|
||||
steps = (prevCol - col) `div` 2
|
||||
bad :: PassM [Token]
|
||||
bad = dieP m "Invalid indentation"
|
||||
-- This is actually the position at which the new line starts
|
||||
-- rather than the end of the previous line.
|
||||
|
|
|
@ -531,7 +531,7 @@ getIneqs (low, high) = concatMap getLH
|
|||
|
||||
getLH :: EqualityConstraintEquation -> [InequalityConstraintEquation]
|
||||
getLH eq = [eq `addEq` (amap negate low),high `addEq` amap negate eq]
|
||||
|
||||
addEq :: EqualityConstraintEquation -> EqualityConstraintEquation -> EqualityConstraintEquation
|
||||
addEq = arrayZipWith' 0 (+)
|
||||
|
||||
-- | Given an expression, forms equations (and accompanying additional equation-sets) and returns it
|
||||
|
@ -662,4 +662,3 @@ squareEquations (eqs,ineqs) = uncurry transformPair (mkPair $ map $ makeSize (0,
|
|||
|
||||
where
|
||||
highest = maximum $ 0 : (concatMap indices $ eqs ++ ineqs)
|
||||
|
||||
|
|
|
@ -187,7 +187,8 @@ makeConsistent eqs ineqs = (map ensure eqs', map ensure ineqs')
|
|||
where
|
||||
eqs' = map (\(Eq e) -> e) eqs
|
||||
ineqs' = map (\(Ineq e) -> e) ineqs
|
||||
|
||||
|
||||
ensure :: [(CoeffIndex, Integer)] -> EqualityConstraintEquation
|
||||
ensure = accumArray (+) 0 (0, largestIndex)
|
||||
largestIndex = maximum $ map (maximum . map fst) $ [[(0,0)]] ++ eqs' ++ ineqs'
|
||||
|
||||
|
@ -374,9 +375,13 @@ testMakeEquations = TestList
|
|||
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 $ (variable "i",0)) 1
|
||||
ij_mapping :: VarMap
|
||||
ij_mapping = Map.fromList [(Scale 1 $ (variable "i",0),1),(Scale 1 $ (variable "j",0),2)]
|
||||
i_mod_mapping :: Integer -> VarMap
|
||||
i_mod_mapping n = Map.fromList [(Scale 1 $ (variable "i",0),1),(Modulo (Set.singleton $ Scale 1 $ (variable "i",0)) (Set.singleton $ Const n),2)]
|
||||
i_mod_j_mapping :: VarMap
|
||||
i_mod_j_mapping = Map.fromList [(Scale 1 $ (variable "i",0),1),(Scale 1 $ (variable "j",0),2),
|
||||
(Modulo (Set.singleton $ Scale 1 $ (variable "i",0)) (Set.singleton $ Scale 1 $ (variable "j",0)),3)]
|
||||
_3i_2j_mod_mapping n = Map.fromList [(Scale 1 $ (variable "i",0),1),(Scale 1 $ (variable "j",0),2),
|
||||
|
@ -387,7 +392,9 @@ testMakeEquations = TestList
|
|||
,(Modulo (Set.fromList [Scale 1 $ (variable "i",0), Const 1]) (Set.singleton $ Const n),3)
|
||||
]
|
||||
|
||||
rep_i_mapping :: VarMap
|
||||
rep_i_mapping = Map.fromList [((Scale 1 (variable "i",0)),1), ((Scale 1 (variable "i",1)),2)]
|
||||
rep_i_mapping' :: VarMap
|
||||
rep_i_mapping' = Map.fromList [((Scale 1 (variable "i",0)),2), ((Scale 1 (variable "i",1)),1)]
|
||||
|
||||
both_rep_i = joinMapping [rep_i_mapping, rep_i_mapping']
|
||||
|
@ -507,6 +514,7 @@ testIndexes = TestList
|
|||
isMod var@[(ind,1)] alpha divisor = ([alpha_minus_div_sigma === var], leq [con 0, alpha_minus_div_sigma, con $ divisor - 1])
|
||||
where
|
||||
alpha_minus_div_sigma = alpha ++ (negate divisor) ** sigma
|
||||
sigma :: [(Int, Integer)]
|
||||
sigma = [(ind+1,1)]
|
||||
|
||||
-- | Adds both k and m to the equation!
|
||||
|
|
|
@ -352,6 +352,7 @@ pruneIneq ineq = do let (opps,others) = splitEither $ groupOpposites $ map prune
|
|||
numVariables :: InequalityProblem -> Int
|
||||
numVariables ineq = length (nub $ concatMap findVars ineq)
|
||||
where
|
||||
findVars :: InequalityConstraintEquation -> [CoeffIndex]
|
||||
findVars = map fst . filter ((/= 0) . snd) . tail . assocs
|
||||
|
||||
-- | Adds a constant value to an equation:
|
||||
|
|
|
@ -451,9 +451,11 @@ testInputCase = TestList
|
|||
a0 = simpleName "a0"
|
||||
b2 = simpleName "b2"
|
||||
c1 = simpleName "c1"
|
||||
defineMyProtocol :: CSM m => m ()
|
||||
defineMyProtocol = defineName (simpleName "prot") $ A.NameDef emptyMeta "prot" "prot" A.ProtocolName
|
||||
(A.ProtocolCase emptyMeta [(a0,[]),(b2,[A.Int,A.Int]),(c1,[A.Int])])
|
||||
A.Original A.Unplaced
|
||||
defineC :: CSM m => m ()
|
||||
defineC = defineName (simpleName "c") $ simpleDefDecl "c" (A.Chan A.DirUnknown (A.ChanAttributes False False) (A.UserProtocol $ simpleName "prot"))
|
||||
|
||||
specInt s = A.Spec emptyMeta (A.Specification emptyMeta (simpleName s) $ A.Declaration emptyMeta A.Int Nothing)
|
||||
|
|
|
@ -66,6 +66,7 @@ a_eq_not_b = A.Assign m [vA] $ A.ExpressionList m [A.Monadic m A.MonadicNot (A.E
|
|||
testGetVarProc :: Test
|
||||
testGetVarProc = TestList (map doTest tests)
|
||||
where
|
||||
tests :: [(Int,[Var],[Var],[Var],[Var],A.Process)]
|
||||
tests =
|
||||
[
|
||||
--TODO test channel reads and writes (incl. reads in alts)
|
||||
|
|
|
@ -33,6 +33,7 @@ import Utils
|
|||
simplifyComms :: Pass
|
||||
simplifyComms = runPasses passes
|
||||
where
|
||||
passes :: [(String, Pass)]
|
||||
passes =
|
||||
[ ("Define temporary variables for outputting expressions", outExprs)
|
||||
,("Transform ? CASE statements/guards into plain CASE", transformInputCase)
|
||||
|
|
|
@ -33,6 +33,7 @@ import Types
|
|||
simplifyExprs :: Pass
|
||||
simplifyExprs = runPasses passes
|
||||
where
|
||||
passes :: [(String, Pass)]
|
||||
passes =
|
||||
[ ("Convert FUNCTIONs to PROCs", functionsToProcs)
|
||||
, ("Convert AFTER to MINUS", removeAfter)
|
||||
|
|
|
@ -31,6 +31,7 @@ import Pass
|
|||
simplifyProcs :: Pass
|
||||
simplifyProcs = runPasses passes
|
||||
where
|
||||
passes :: [(String, Pass)]
|
||||
passes =
|
||||
[ ("Wrap PAR subprocesses in PROCs", parsToProcs)
|
||||
, ("Remove parallel assignment", removeParAssign)
|
||||
|
|
|
@ -29,6 +29,7 @@ import Types
|
|||
simplifyTypes :: Pass
|
||||
simplifyTypes = runPasses passes
|
||||
where
|
||||
passes :: [(String,Pass)]
|
||||
passes =
|
||||
[ ("Resolve types in AST", resolveNamedTypes)
|
||||
, ("Resolve types in state", rntState)
|
||||
|
|
Loading…
Reference in New Issue
Block a user