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)

2007-10-14 00:01:44 +00:00 · 2007-10-14 00:01:44 +00:00 · e9dbfbab3c
commit e9dbfbab3c
parent d98cb21415
4 changed files with 3 additions and 103 deletions
--- 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
--- 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
--- 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
--- 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