Added the input-case to case pass to the pass-list, and therefore removed all code dealing with input-case statements in the C and C++ backends (and corresponding tests)

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

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 -> 
+            A.InputSimple m is -> mapM_ (call genInputItem ops c) 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
             _ -> 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

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

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