suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fixed the TLP mechanisms to work with the new channel-end system

Browse Source
This commit is contained in:
Neil Brown 2009-01-20 17:35:31 +00:00
parent 766cb09dcf
commit 0b75720e2e
1 changed files with 12 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
backends/TLP.hs
View File

@ -36,7 +36,7 @@ data TLPChannel = TLPIn | TLPOut | TLPError
-- | Get the name of the TLP and the channels it uses. -- | Get the name of the TLP and the channels it uses.
-- Fail if the process isn't using a valid interface. -- Fail if the process isn't using a valid interface.
tlpInterface :: (CSMR m, Die m) => m (A.Name, [(A.Direction, TLPChannel)]) tlpInterface :: (CSMR m, Die m) => m (A.Name, [(Maybe A.Direction, TLPChannel)])
tlpInterface tlpInterface
= do mainLocals <- getCompState >>* csMainLocals = do mainLocals <- getCompState >>* csMainLocals
when (null mainLocals) $ when (null mainLocals) $
@ -53,16 +53,23 @@ tlpInterface
dieP (findMeta mainName) "Channels used more than once in TLP" dieP (findMeta mainName) "Channels used more than once in TLP"
return (mainName, chans) return (mainName, chans)
where where
tlpChannel :: (CSMR m, Die m) => Meta -> A.Formal -> m (A.Direction, TLPChannel) tlpChannel :: (CSMR m, Die m) => Meta -> A.Formal -> m (Maybe A.Direction, TLPChannel)
tlpChannel m (A.Formal _ (A.Chan dir _ _) n) tlpChannel m (A.Formal _ (A.ChanEnd dir _ _) n)
= do def <- lookupName n = do def <- lookupName n
let origN = A.ndOrigName def let origN = A.ndOrigName def
case lookup origN tlpChanNames of case lookup origN tlpChanNames of
Just c -> Just c ->
if (dir == A.DirUnknown || dir == (tlpDir c)) if dir == (tlpDir c)
then return (dir, c) then return (Just dir, c)
else dieP m $ "TLP formal " ++ show n ++ " has wrong direction for its name" else dieP m $ "TLP formal " ++ show n ++ " has wrong direction for its name"
_ -> dieP m $ "TLP formal " ++ show n ++ " has unrecognised name" _ -> dieP m $ "TLP formal " ++ show n ++ " has unrecognised name"
tlpChannel m (A.Formal _ (A.Chan _ _) n)
= do def <- lookupName n
let origN = A.ndOrigName def
case lookup origN tlpChanNames of
Just c ->
return (Nothing, c)
_ -> dieP m $ "TLP formal " ++ show n ++ " has unrecognised name"
tlpChannel m (A.Formal _ _ n) tlpChannel m (A.Formal _ _ n)
= dieP m $ "TLP formal " ++ show n ++ " has unrecognised type" = dieP m $ "TLP formal " ++ show n ++ " has unrecognised type"