Changed the channel-output code generation so that it knows the desired type being sent

This commit is contained in:
Neil Brown 2009-03-20 11:37:52 +00:00
parent 65550b705e
commit 56cd7d73c4
4 changed files with 25 additions and 21 deletions

View File

@ -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 ()

View File

@ -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 (),

View File

@ -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.

View File

@ -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