Changed the channel-output code generation so that it knows the desired type being sent
This commit is contained in:
parent
65550b705e
commit
56cd7d73c4
|
@ -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 ()
|
||||
|
|
|
@ -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 (),
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue
Block a user