diff --git a/backends/GenerateC.hs b/backends/GenerateC.hs index dcbf797..6891630 100644 --- a/backends/GenerateC.hs +++ b/backends/GenerateC.hs @@ -114,7 +114,6 @@ data GenOps = GenOps { -- | Generates an IF statement (which can have replicators, specifications and such things inside it). genIf :: GenOps -> Meta -> A.Structured -> CGen (), genInput :: GenOps -> A.Variable -> A.InputMode -> CGen (), - genInputCase :: GenOps -> Meta -> A.Variable -> A.Structured -> CGen (), genInputItem :: GenOps -> A.Variable -> A.InputItem -> CGen (), genIntrinsicFunction :: GenOps -> Meta -> String -> [A.Expression] -> CGen (), genIntrinsicProc :: GenOps -> Meta -> String -> [A.Actual] -> CGen (), @@ -212,7 +211,6 @@ cgenOps = GenOps { genGetTime = cgenGetTime, genIf = cgenIf, genInput = cgenInput, - genInputCase = cgenInputCase, genInputItem = cgenInputItem, genIntrinsicFunction = cgenIntrinsicFunction, genIntrinsicProc = cgenIntrinsicProc, @@ -1530,44 +1528,8 @@ cgenInput ops c im A.InputTimerRead m (A.InVariable m' v) -> call genTimerRead ops c v A.InputTimerAfter m e -> call genTimerWait ops e A.InputSimple m is -> sequence_ $ map (call genInputItem ops c) is - A.InputCase m s -> call genInputCase ops m c s _ -> call genMissing ops $ "genInput " ++ show im -cgenInputCase :: GenOps -> Meta -> A.Variable -> A.Structured -> CGen () -cgenInputCase ops m c s - = do t <- typeOfVariable c - let proto = case t of A.Chan _ _ (A.UserProtocol n) -> n - tag <- makeNonce "case_tag" - genName proto - tell [" ", tag, ";\n"] - tell ["ChanInInt ("] - call genVariable ops c - tell [", &", tag, ");\n"] - tell ["switch (", tag, ") {\n"] - genInputCaseBody proto c (return ()) s - tell ["default:\n"] - call genStop ops m "unhandled variant in CASE input" - tell ["}\n"] - where - -- This handles specs in a slightly odd way, because we can't insert specs into - -- the body of a switch. - genInputCaseBody :: A.Name -> A.Variable -> CGen () -> A.Structured -> CGen () - genInputCaseBody proto c coll (A.Spec _ spec s) - = genInputCaseBody proto c (call genSpec ops spec coll) s - genInputCaseBody proto c coll (A.OnlyV _ (A.Variant _ n iis p)) - = do tell ["case "] - genName n - tell ["_"] - genName proto - tell [": {\n"] - coll - sequence_ $ map (call genInputItem ops c) iis - call genProcess ops p - tell ["break;\n"] - tell ["}\n"] - genInputCaseBody proto c coll (A.Several _ ss) - = sequence_ $ map (genInputCaseBody proto c coll) ss - cgenTimerRead :: GenOps -> A.Variable -> A.Variable -> CGen () cgenTimerRead ops c v = do tell ["ProcTime (&"] @@ -1660,7 +1622,6 @@ cgenCase ops m e s call genStop ops m "no option matched in CASE process" tell ["}"] where - -- FIXME -- can this be made common with genInputCaseBody above? genCaseBody :: CGen () -> A.Structured -> CGen Bool genCaseBody coll (A.Spec _ spec s) = genCaseBody (call genSpec ops spec coll) s diff --git a/backends/GenerateCPPCSP.hs b/backends/GenerateCPPCSP.hs index dbef095..7284690 100644 --- a/backends/GenerateCPPCSP.hs +++ b/backends/GenerateCPPCSP.hs @@ -107,7 +107,6 @@ cppgenOps = cgenOps { genForwardDeclaration = cppgenForwardDeclaration, genGetTime = cppgenGetTime, genIf = cppgenIf, - genInputCase = cppgenInputCase, genInputItem = cppgenInputItem, genOutputCase = cppgenOutputCase, genOutputItem = cppgenOutputItem, @@ -199,65 +198,9 @@ cppgenInput ops c im = do case im of A.InputTimerRead m (A.InVariable m' v) -> call genTimerRead ops c v A.InputTimerAfter m e -> call genTimerWait ops e - A.InputSimple m is -> - do t <- typeOfVariable c - case t of - A.Chan _ _ (A.UserProtocol innerType) -> - --We read from the channel into a temporary var, then deal with the var afterwards - do inputVar <- makeNonce "proto_var" - genProtocolName innerType - tell [" ",inputVar, " ; "] - genCPPCSPChannelInput ops c - tell [" >> ",inputVar," ; "] - cases <- casesOfProtocol innerType - genInputTupleAssign ops ((length cases) /= 0) inputVar is - _ -> sequence_ $ map (call genInputItem ops c) is - A.InputCase m s -> call genInputCase ops m c s + A.InputSimple m is -> mapM_ (call genInputItem ops c) is _ -> call genMissing ops $ "genInput " ++ show im -cppgenInputCase :: GenOps -> Meta -> A.Variable -> A.Structured -> CGen () -cppgenInputCase ops m c s - = do t <- typeOfVariable c - --We have to do complex things with the which() function of the variant (which may be a chained variant) - --to actually get the real index of the item we have received. - let proto = case t of A.Chan _ _ (A.UserProtocol n) -> n - tag <- makeNonce "case_tag" - which <- makeNonce "which_val" - genProtocolName proto - tell [" ", tag, " ; "] - tell ["unsigned ", which, " ; "] - genCPPCSPChannelInput ops c - tell [" >> ", tag, " ; "] - whichExpr proto which tag 0 (genProtocolName proto) - tell [" switch ( ", which, " ) { "] - genInputCaseBody proto tag (return ()) s - tell ["default:"] - call genStop ops m "unhandled variant in CASE input" - tell [" } "] - where - -- This handles specs in a slightly odd way, because we can't insert specs into - -- the body of a switch. - genInputCaseBody :: A.Name -> String -> CGen () -> A.Structured -> CGen () - genInputCaseBody proto var coll (A.Spec _ spec s) - = genInputCaseBody proto var (call genSpec ops spec coll) s - genInputCaseBody proto var coll (A.OnlyV _ (A.Variant _ n iis p)) - = do protoType <- specTypeOfName proto - tell ["case ",show (index protoType)," : {"] - coll - case iis of - [] -> return() - _ -> - do caseVar <- genVariantGet proto n var (genProtocolName proto) - genInputTupleAssign ops True caseVar iis - call genProcess ops p - tell ["break;\n"] - tell ["}\n"] - where - typeList protoType = case protoType of A.ProtocolCase _ types -> types - index protoType = indexOfTag (typeList protoType) n - genInputCaseBody proto var coll (A.Several _ ss) - = sequence_ $ map (genInputCaseBody proto var coll) ss - -- | This function processes (potentially chained) variants to get the real index of the data item inside the variant whichExpr :: A.Name -> String -> String -> Int -> CGen() -> CGen() whichExpr proto which variant offset protoGen diff --git a/backends/GenerateCTest.hs b/backends/GenerateCTest.hs index 2ba20a4..33830e4 100644 --- a/backends/GenerateCTest.hs +++ b/backends/GenerateCTest.hs @@ -835,7 +835,6 @@ testInput = TestList testBothSame "testInput 0" "" ((tcall2 genInput undefined $ A.InputSimple undefined []) . overInputItemCase) ,testBothSame "testInput 1" "^" ((tcall2 genInput undefined $ A.InputSimple undefined [undefined]) . overInputItemCase) ,testBothSame "testInput 2" "^^^" ((tcall2 genInput undefined $ A.InputSimple undefined [undefined, undefined, undefined]) . overInputItemCase) - ,testBothSame "testInput 3" "$" ((tcall2 genInput undefined $ A.InputCase undefined undefined) . overInputItemCase) -- Reading an integer (special case in the C backend): ,testInputItem 100 "ChanInInt(#,&x);" "#>>x;" (A.InVariable emptyMeta $ variable "x") A.Int @@ -877,10 +876,6 @@ testInput = TestList "tockRecvArrayOfBytes(#,tockSendableArrayOfBytes(^,&x));tockRecvArrayOfBytes(#,tockSendableArrayOfBytes(x*^,xs));" (A.InCounted emptyMeta (variable "x") (variable "xs")) (A.Counted A.Int8 A.Int8) - - -- TODO write tests for genInputCase - - ] where sub0 = A.SubscriptedVariable emptyMeta (A.Subscript emptyMeta (intLiteral 0)) @@ -914,7 +909,7 @@ testInput = TestList -- state = do defineName chan $ simpleDefDecl "c" (A.Chan A.DirUnknown (A.ChanAttributes False False) $ A.UserProtocol foo) -- defineName chanOut $ simpleDefDecl "cIn" (A.Chan A.DirInput (A.ChanAttributes False False) $ A.UserProtocol foo) - overInputItemCase ops = ops {genInputItem = override2 caret, genInputCase = override3 dollar} + overInputItemCase ops = ops {genInputItem = override2 caret} over ops = ops {genBytesIn = override2 caret, genArraySubscript = override3 dollar} testOutput :: Test diff --git a/transformations/SimplifyComms.hs b/transformations/SimplifyComms.hs index e9bf388..29a2c43 100644 --- a/transformations/SimplifyComms.hs +++ b/transformations/SimplifyComms.hs @@ -34,6 +34,7 @@ simplifyComms = runPasses passes where passes = [ ("Define temporary variables for outputting expressions", outExprs) + ,("Transform ? CASE statements/guards into plain CASE", transformInputCase) ] outExprs :: Data t => t -> PassM t