diff --git a/backends/GenerateC.hs b/backends/GenerateC.hs index 1c06bd5..5cf34f8 100644 --- a/backends/GenerateC.hs +++ b/backends/GenerateC.hs @@ -1105,9 +1105,10 @@ cgenInputItem c (A.InVariable m v) call genBytesIn m t (Right v) tell [");"] -cgenOutputItem :: A.Variable -> A.OutputItem -> CGen () -cgenOutputItem c (A.OutCounted m ce ae) - = do call genOutputItem c (A.OutExpression m ce) +cgenOutputItem :: A.Type -> A.Variable -> A.OutputItem -> CGen () +cgenOutputItem _ c (A.OutCounted m ce ae) + = do tce <- astTypeOf ce + call genOutputItem tce c (A.OutExpression m ce) t <- astTypeOf ae case ae of A.ExprVariable m v -> @@ -1121,12 +1122,8 @@ cgenOutputItem c (A.OutCounted m ce ae) tell ["*"] call genBytesIn m subT (Right v) tell [");"] -cgenOutputItem c (A.OutExpression m e) - = do t <- astTypeOf c - let innerT = case t of - A.Chan _ t' -> t' - A.ChanEnd _ _ t' -> t' - case (innerT, e) of +cgenOutputItem innerT c (A.OutExpression m e) + = case (innerT, e) of (A.Int, _) -> do tell ["ChanOutInt(wptr,"] call genVariable c @@ -1564,7 +1561,9 @@ cgenProcess :: A.Process -> CGen () cgenProcess p = case p of A.Assign m vs es -> call genAssign m vs es A.Input m c im -> call genInput c im - A.Output m c ois -> call genOutput c ois + A.Output m c ois -> + do Left ts <- protocolItems c + call genOutput c $ zip ts ois A.OutputCase m c t ois -> call genOutputCase c t ois A.Skip m -> tell ["/* skip */\n"] A.Stop m -> call genStop m "STOP process" @@ -1641,8 +1640,8 @@ cgenGetTime v --}}} --{{{ output -cgenOutput :: A.Variable -> [A.OutputItem] -> CGen () -cgenOutput c ois = sequence_ $ map (call genOutputItem c) ois +cgenOutput :: A.Variable -> [(A.Type, A.OutputItem)] -> CGen () +cgenOutput c tois = sequence_ [call genOutputItem t c oi | (t, oi) <- tois] cgenOutputCase :: A.Variable -> A.Name -> [A.OutputItem] -> CGen () cgenOutputCase c tag ois @@ -1657,7 +1656,10 @@ cgenOutputCase c tag ois tell ["_"] genName proto tell [");"] - call genOutput c ois + Right ps <- protocolItems c + let ts = fromMaybe (error "genOutputCase unknown tag") + $ lookup tag ps + call genOutput c $ zip ts ois --}}} --{{{ stop cgenStop :: Meta -> String -> CGen () diff --git a/backends/GenerateCBased.hs b/backends/GenerateCBased.hs index a04a325..4af98d7 100644 --- a/backends/GenerateCBased.hs +++ b/backends/GenerateCBased.hs @@ -145,11 +145,11 @@ data GenOps = GenOps { genMissingC :: CGen String -> CGen (), genMonadic :: Meta -> A.MonadicOp -> A.Expression -> CGen (), -- | Generates an output statement. - genOutput :: A.Variable -> [A.OutputItem] -> CGen (), + genOutput :: A.Variable -> [(A.Type, A.OutputItem)] -> CGen (), -- | Generates an output statement for a tagged protocol. genOutputCase :: A.Variable -> A.Name -> [A.OutputItem] -> CGen (), -- | Generates an output for an individual item. - genOutputItem :: A.Variable -> A.OutputItem -> CGen (), + genOutputItem :: A.Type -> A.Variable -> A.OutputItem -> CGen (), -- | Generates a loop that maps over every element in a (potentially multi-dimensional) array genOverArray :: Meta -> A.Variable -> (SubscripterFunction -> Maybe (CGen ())) -> CGen (), genPar :: A.ParMode -> A.Structured A.Process -> CGen (), diff --git a/backends/GenerateCPPCSP.hs b/backends/GenerateCPPCSP.hs index 9741655..81e43f9 100644 --- a/backends/GenerateCPPCSP.hs +++ b/backends/GenerateCPPCSP.hs @@ -322,8 +322,8 @@ cppgenInputItem c dest genPoint v tell ["));"] -cppgenOutputItem :: A.Variable -> A.OutputItem -> CGen () -cppgenOutputItem chan item +cppgenOutputItem :: A.Type -> A.Variable -> A.OutputItem -> CGen () +cppgenOutputItem _ chan item = case item of (A.OutCounted m (A.ExprVariable _ cv) (A.ExprVariable _ av)) -> (sendBytes cv) >> (sendBytes av) (A.OutExpression _ (A.ExprVariable _ sv)) -> @@ -380,7 +380,7 @@ cppgenOutputCase c tag ois tell ["_"] genName proto tell [");"] - call genOutput c ois + call genOutput c $ zip (repeat undefined) ois -- | We use the process wrappers here, in order to execute the functions in parallel. diff --git a/backends/GenerateCTest.hs b/backends/GenerateCTest.hs index fae1a9a..4aca917 100644 --- a/backends/GenerateCTest.hs +++ b/backends/GenerateCTest.hs @@ -1144,9 +1144,11 @@ testOutput = TestList testOutputItem' :: Int -> String -> String -> A.OutputItem -> A.Type -> A.Type -> Test testOutputItem' n eC eCPP oi t ct = TestList [ - testBothS ("testOutput " ++ show n) (hashIs "(&c)" eC) (hashIs "(&c)->writer()" eCPP) (over (tcall2 genOutputItem (A.Variable emptyMeta $ simpleName "c") oi)) + testBothS ("testOutput " ++ show n) (hashIs "(&c)" eC) (hashIs "(&c)->writer()" eCPP) + (over (tcall3 genOutputItem A.Int64 (A.Variable emptyMeta $ simpleName "c") oi)) (state $ A.Chan) - ,testBothS ("testOutput [out] " ++ show n) (hashIs "c" eC) (hashIs "c" eCPP) (over (tcall2 genOutputItem (A.Variable emptyMeta $ simpleName "c") oi)) + ,testBothS ("testOutput [out] " ++ show n) (hashIs "c" eC) (hashIs "c" eCPP) + (over (tcall3 genOutputItem A.Int64 (A.Variable emptyMeta $ simpleName "c") oi)) (state $ A.ChanEnd A.DirOutput) ] where @@ -1167,7 +1169,7 @@ testOutput = TestList defineName chanOut $ simpleDefDecl "cOut" (A.ChanEnd A.DirOutput (A.ChanAttributes False False) $ A.UserProtocol foo) overOutput, overOutputItem, over :: Override overOutput = local $ \ops -> ops {genOutput = override2 caret} - overOutputItem = local $ \ops -> ops {genOutputItem = override2 caret} + overOutputItem = local $ \ops -> ops {genOutputItem = override3 caret} over = local $ \ops -> ops {genBytesIn = override3 caret} testBytesIn :: Test