Added support for transforming ALT guards to the input-case -> case pass

transformations/PassTest.hs

@@ -398,6 +398,37 @@ testInputCase = TestList
      (defineMyProtocol >> defineC)
      
      --TODO test alt guards
+
+   -- Input that only involves tags:
+   {-
+   The idea is to transform:
+     ALT
+       c ? CASE
+         a0
+           --Process p0
+   into:
+     ALT
+       INT tag:
+       c ? tag
+         CASE tag
+           a0
+             --Process p0
+   -}
+   ,TestCase $ testPass "testInputCase 100"
+       (tag3 A.Alt DontCare False $ 
+          tag3 A.Spec DontCare (tag3 A.Specification DontCare (Named "tag" DontCare) $ tag2 A.Declaration DontCare A.Int) $
+          tag2 A.OnlyA DontCare $ tag4 A.Alternative DontCare c
+            (tag2 A.InputSimple DontCare [tag2 A.InVariable DontCare $ tag2 A.Variable DontCare (Named "tag" DontCare)]) $
+          tag3 A.Case DontCare (tag2 A.ExprVariable DontCare $ tag2 A.Variable DontCare (Named "tag" DontCare)) $
+           tag2 A.OnlyO DontCare $ tag3 A.Option DontCare [intLiteralPattern 0] p0
+     )
+     (transformInputCase $ 
+       A.Alt emptyMeta False $ A.OnlyA emptyMeta $ A.Alternative emptyMeta c 
+        (A.InputCase emptyMeta $ A.OnlyV emptyMeta $ A.Variant emptyMeta a0 [] p0)
+        (A.Skip emptyMeta)
+     )
+     (defineMyProtocol >> defineC)
+
   ]
   where
     -- Various distinct simple processes:

transformations/SimplifyComms.hs

@@ -144,9 +144,13 @@ transformInputCase = doGeneric `extM` doProcess
            return $ A.Seq m $ A.Spec m' spec $ A.Several m'
              [A.OnlyP m $ A.Input m v (A.InputSimple m [A.InVariable m (A.Variable m n)])
              ,A.OnlyP m' $ A.Case m' (A.ExprVariable m $ A.Variable m n) s']
+    doProcess (A.Alt m pri s)
+      = do s' <- doStructured undefined s
+           return (A.Alt m pri s')
     doProcess p = doGeneric p
     
     doStructured :: A.Variable -> A.Structured -> PassM A.Structured
+    -- These entries all just burrow deeper into the structured:
     doStructured v (A.ProcThen m p s)
       = do s' <- doStructured v s
            p' <- doProcess p
@@ -157,6 +161,11 @@ transformInputCase = doGeneric `extM` doProcess
     doStructured v (A.Several m ss)
       = do ss' <- mapM (doStructured v) ss
            return (A.Several m ss')
+    doStructured v (A.Rep m rep s)
+      = do s' <- doStructured v s
+           return (A.Rep m rep s')
+           
+    -- Transform variant options:
     doStructured chanVar (A.OnlyV m (A.Variant m' n iis p))
       = do (Right items) <- protocolItems chanVar
            let (Just idx) = elemIndex n (fst $ unzip items)
@@ -167,3 +176,20 @@ transformInputCase = doGeneric `extM` doProcess
                else A.Seq m' $ A.Several m'
                       [A.OnlyP m' $ A.Input m' chanVar (A.InputSimple m' iis)
                       ,A.OnlyP (findMeta p') p']
+                      
+    -- Transform alt guards:
+    -- The processes that are the body of input-case guards are always skip, so we can discard them:
+    doStructured _ (A.OnlyA m (A.Alternative m' v (A.InputCase m'' s) _))
+      = do spec@(A.Specification _ n _) <- defineNonce m "input_tag" (A.Declaration m' A.Int) A.VariableName A.Original
+           s' <- doStructured v s
+           return $ A.Spec m' spec $ A.OnlyA m $ 
+             A.Alternative m' v (A.InputSimple m [A.InVariable m (A.Variable m n)]) $
+             A.Case m'' (A.ExprVariable m'' $ A.Variable m n) s'
+    doStructured _ (A.OnlyA m (A.AlternativeCond m' e v (A.InputCase m'' s) _))
+      = do spec@(A.Specification _ n _) <- defineNonce m "input_tag" (A.Declaration m' A.Int) A.VariableName A.Original
+           s' <- doStructured v s
+           return $ A.Spec m' spec $ A.OnlyA m $ 
+             A.AlternativeCond m' e v (A.InputSimple m [A.InVariable m (A.Variable m n)]) $
+             A.Case m'' (A.ExprVariable m'' $ A.Variable m n) s'
+    -- Leave other guards untouched:
+    doStructured _ a@(A.OnlyA {}) = return a