diff --git a/checks/UsageCheckUtils.hs b/checks/UsageCheckUtils.hs index 0b29002..9afa4c2 100644 --- a/checks/UsageCheckUtils.hs +++ b/checks/UsageCheckUtils.hs @@ -216,11 +216,13 @@ annotateVars :: A.ExpressionList -> [A.Variable] -> [(A.Variable, Maybe A.Expres annotateVars (A.FunctionCallList {}) vs = zip vs (repeat Nothing) annotateVars (A.IntrinsicFunctionCallList {}) vs = zip vs (repeat Nothing) annotateVars (A.ExpressionList _ es) vs = zip vs (map Just es ++ repeat Nothing) +annotateVars (A.AllocChannelBundle {}) vs = zip vs (repeat Nothing) getVarExpList :: A.ExpressionList -> Vars getVarExpList (A.ExpressionList _ es) = foldUnionVars $ map getVarExp es getVarExpList (A.FunctionCallList _ _ es) = foldUnionVars $ map getVarExp es --TODO record stuff in passed as well? getVarExpList (A.IntrinsicFunctionCallList _ _ es) = foldUnionVars $ map getVarExp es --TODO record stuff in passed as well? +getVarExpList (A.AllocChannelBundle {}) = emptyVars getVarExp :: A.Expression -> Vars getVarExp = everything unionVars (emptyVars `mkQ` getVarExp') diff --git a/data/AST.hs b/data/AST.hs index 828fad1..ab6855e 100644 --- a/data/AST.hs +++ b/data/AST.hs @@ -303,6 +303,8 @@ data ExpressionList = | IntrinsicFunctionCallList Meta String [Expression] -- | A list of expressions resulting from, well, a list of expressions. | ExpressionList Meta [Expression] + -- | A pair of expressions resulting from allocating a mobile channel bundle. + | AllocChannelBundle Meta Name deriving (Show, Eq, Typeable, Data) -- | A monadic (unary) operator. diff --git a/frontends/OccamTypes.hs b/frontends/OccamTypes.hs index 739f27a..6ff53d7 100644 --- a/frontends/OccamTypes.hs +++ b/frontends/OccamTypes.hs @@ -520,6 +520,18 @@ checkExpressionList ets el sequence_ [do rt <- astTypeOf e checkType (findMeta e) et rt | (e, et) <- zip es ets] + A.AllocChannelBundle m n + -> case ets of + [A.ChanDataType A.DirInput shA nA + ,A.ChanDataType A.DirOutput shB nB] + | A.nameName nA == A.nameName nB && A.nameName nA == A.nameName n + -> return () + [A.ChanDataType A.DirOutput shA nA + ,A.ChanDataType A.DirInput shB nB] + | A.nameName nA == A.nameName nB && A.nameName nA == A.nameName n + -> return () + _ -> dieP m $ "Wrong number of arguments, mismatched directions, or mismatched bundle types" + -- | Check a set of names are distinct. checkNamesDistinct :: Meta -> [A.Name] -> PassM () @@ -801,6 +813,7 @@ inferTypes = occamOnlyPass "Infer types" | (t, e) <- zip ts es] es'' <- mapM (uncurry $ inferAllocMobile m) $ zip ts es' return $ A.ExpressionList m es'' + A.AllocChannelBundle {} -> return el doReplicator :: Transform A.Replicator doReplicator rep @@ -1358,6 +1371,8 @@ checkSpecTypes = checkDepthM doSpecType _ -> dieP m "Expected 1D channel array type" doSpecType (A.DataType m t) = checkDataType m t + doSpecType (A.ChanBundleType m _ fts) + = when (null fts) $ dieP m "Channel bundles cannot be empty" doSpecType (A.RecordType m _ nts) = do sequence_ [checkDataType (findMeta n) t | (n, t) <- nts] diff --git a/frontends/ParseOccam.hs b/frontends/ParseOccam.hs index 5438a25..a9d0996 100644 --- a/frontends/ParseOccam.hs +++ b/frontends/ParseOccam.hs @@ -709,6 +709,9 @@ expressionList es <- sepBy1 expression sComma return $ A.ExpressionList m es -- XXX: Value processes are not supported (because nobody uses them and they're hard to parse) + <|> do m <- md + n <- tryXV sMOBILE chanBundleName + return $ A.AllocChannelBundle m n "expression list" expression :: OccParser A.Expression @@ -721,8 +724,6 @@ expression <|> do { m <- md; sMOSTNEG; t <- dataType; return $ A.MostNeg m t } <|> do { m <- md; sCLONE; e <- expression; return $ A.CloneMobile m e } <|> do { m <- md; t <- tryXV sMOBILE dataType ; return $ A.AllocMobile m (A.Mobile t) Nothing } - <|> do { m <- md; n <- tryXV sMOBILE chanBundleName ; - return $ A.AllocMobile m (A.Mobile $ A.ChanDataType A.DirInput A.Unshared n) Nothing } <|> do { m <- md; sDEFINED; e <- expression; return $ A.IsDefined m e } <|> sizeExpr <|> do m <- md