Added support for extended rendezvous throughout the compiler

backends/GenerateC.hs

@@ -1044,11 +1044,24 @@ genDest f v = call genVariable' v A.Original (f . Pointer . stripPointers)
 genChan :: A.Variable -> CGen ()
 genChan c = call genVariable' c A.Original (const $ Pointer $ Plain "Channel")
  
-cgenInputItem :: A.Variable -> A.InputItem -> CGen ()
+cgenInputItem :: A.Variable -> A.InputItem -> Maybe A.Process -> CGen ()
-cgenInputItem c (A.InCounted m cv av)
+cgenInputItem c (A.InCounted m cv av) mp
-    =  do call genInputItem c (A.InVariable m cv)
+    =  do call genInputItem c (A.InVariable m cv) Nothing
-          t <- astTypeOf av
+          case mp of
-          tell ["ChanIn(wptr,"]
+            Nothing -> cgenInputItem' ""
+            Just p ->
+                do tell ["ChanXAble(wptr,"]
+                   genChan c
+                   tell [");"]
+                   cgenInputItem' "X"
+                   call genProcess p
+                   tell ["ChanXEnd(wptr,"]
+                   genChan c
+                   tell [");"]
+  where
+    cgenInputItem' x
+     = do t <- astTypeOf av
+          tell ["Chan", x, "In(wptr,"]
           genChan c
           tell [","]
           genDest id av
@@ -1058,7 +1071,19 @@ cgenInputItem c (A.InCounted m cv av)
           tell ["*"]
           call genBytesIn m subT (Right av)
           tell [");"]
-cgenInputItem c (A.InVariable m v)
+cgenInputItem c (A.InVariable m v) mp
+  = case mp of
+      Nothing -> cgenInputItem' ""
+      Just p -> do tell ["ChanXAble(wptr,"]
+                   genChan c
+                   tell [");"]
+                   cgenInputItem' "X"
+                   call genProcess p
+                   tell ["ChanXEnd(wptr,"]
+                   genChan c
+                   tell [");"]
+ where
+  cgenInputItem' x
     =  do case v of
             -- If we are reading into a dereferenced mobile, we must make sure
             -- that something is in that mobile first:
@@ -1075,22 +1100,16 @@ cgenInputItem c (A.InVariable m v)
           t <- astTypeOf v
           isMobile <- isMobileType t
           let rhs = genDest (if isMobile then Pointer else id) v
-          case (t, isMobile) of
+          if isMobile
-            (A.Int, _) ->
+            then
-              do tell ["ChanInInt(wptr,"]
-                 genChan c
-                 tell [","]
-                 rhs
-                 tell [");"]
-            (_, True) ->
               do call genClearMobile m v -- TODO insert this via a pass
-                 tell ["MTChanIn(wptr,"]
+                 tell ["MTChan", x, "In(wptr,"]
                  genChan c
                  tell [",(void**)"]
                  rhs
                  tell [");"]
-            _ ->
+            else
-              do tell ["ChanIn(wptr,"]
+              do tell ["Chan", x, "In(wptr,"]
                  genChan c
                  tell [","]
                  rhs
@@ -1815,7 +1834,7 @@ cgenInput c im
     =  do case im of
             A.InputTimerRead m (A.InVariable m' v) -> call genTimerRead c v
             A.InputTimerAfter m e -> call genTimerWait e
-            A.InputSimple m is -> sequence_ $ map (call genInputItem c) is
+            A.InputSimple m [ii] mp -> call genInputItem c ii mp
             _ -> call genMissing $ "genInput " ++ show im
 
 cgenTimerRead :: A.Variable -> A.Variable -> CGen ()

backends/GenerateCBased.hs

@@ -166,7 +166,7 @@ data GenOps = GenOps {
     -- | Generates an IF statement (which can have replicators, specifications and such things inside it).
     genIf :: Meta -> A.Structured A.Choice -> CGen (),
     genInput :: A.Variable -> A.InputMode -> CGen (),
-    genInputItem :: A.Variable -> A.InputItem -> CGen (),
+    genInputItem :: A.Variable -> A.InputItem -> Maybe A.Process -> CGen (),
     genIntrinsicFunction :: Meta -> String -> [A.Expression] -> CGen (),
     genIntrinsicProc :: Meta -> String -> [A.Actual] -> CGen (),
     genListAssign :: A.Variable -> A.Expression -> CGen (),

backends/GenerateCPPCSP.hs

@@ -329,11 +329,11 @@ cppgenTimerWait e
           time <- genCPPCSPTime e
           tell ["csp::SleepUntil(",time,");"]
 
-cppgenInputItem :: A.Variable -> A.InputItem -> CGen ()
+cppgenInputItem :: A.Variable -> A.InputItem -> Maybe A.Process -> CGen ()
-cppgenInputItem c dest
+cppgenInputItem c dest Nothing
   = case dest of
       (A.InCounted m cv av) -> 
-        do call genInputItem c (A.InVariable m cv)
+        do call genInputItem c (A.InVariable m cv) Nothing
            recvBytes av (
              do call genVariable cv A.Original
                 tell ["*"]

checks/UsageCheckUtils.hs

@@ -163,7 +163,7 @@ getVarProc (A.Output _ chanVar outItems)
     getVarOutputItem :: A.OutputItem -> Vars
     getVarOutputItem (A.OutExpression _ e) = getVarExp e
     getVarOutputItem (A.OutCounted _ ce ae) = (getVarExp ce) `unionVars` (getVarExp ae)
-getVarProc (A.Input _ chanVar (A.InputSimple _ iis))
+getVarProc (A.Input _ chanVar (A.InputSimple _ iis _))
     = return $ (processVarUsed chanVar)
                `unionVars` (mapUnionVars getVarInputItem iis)
   where

common/ShowCode.hs

@@ -557,9 +557,9 @@ showProtocolItem (n,ts) = sequence_ $ intersperse (tell [" ; "]) $
   showName n : (map showOccamM ts)
   
 instance ShowOccam A.Variant where
-  showOccamM (A.Variant _ n iis p)
+  showOccamM (A.Variant _ n iis p mp)
     = (showOccamLine (sequence_ $ intersperse (tell [" ; "]) $ [showName n] ++ (map showOccamM iis)))
-      >> occamIndent >> showOccamM p >> occamOutdent
+      >> occamIndent >> showOccamM p >> doMaybe (fmap showOccamM mp) >> occamOutdent
            
 instance ShowOccam A.Actual where
   showOccamM (A.ActualVariable v) = showOccamM v
@@ -579,10 +579,19 @@ instance ShowOccam A.InputItem where
   showOccamM (A.InCounted _ cv av) = showOccamM cv >> tell [" :: "] >> showOccamM av
   
 instance ShowOccam A.InputMode where
-  showOccamM (A.InputSimple _ iis)
+  showOccamM (A.InputSimple _ iis Nothing)
     = showOccamLine $ getTempItem >> tell [" ? "] >> (showWithSemis iis)
-  showOccamM (A.InputCase _ str)
+  showOccamM (A.InputSimple _ iis (Just p))
-    = (showOccamLine $ getTempItem >> tell [" ? CASE"]) >> occamIndent >> showOccamM str >> occamOutdent
+    = do showOccamLine $ getTempItem >> tell [" ?? "] >> (showWithSemis iis)
+         occamIndent
+         showOccamM p
+         occamOutdent
+  showOccamM (A.InputCase _ ty str)
+    = (showOccamLine $ getTempItem >> tell [op, "CASE"]) >> occamIndent >> showOccamM str >> occamOutdent
+    where
+      op = case ty of
+             A.InputCaseNormal -> " ? "
+             A.InputCaseExtended -> " ?? "
   showOccamM (A.InputTimerRead _ ii)
     = showOccamLine $ getTempItem >> tell [" ? "] >> showOccamM ii
   showOccamM (A.InputTimerAfter _ e)

data/AST.hs

@@ -360,7 +360,12 @@ data Option =
 -- | An option in a @? CASE@ process.
 -- The name is the protocol tag, followed by zero or more input items, followed
 -- by the process to be executed if that option is matched.
-data Variant = Variant Meta Name [InputItem] Process
+--
+-- If this is part of a normal input, the first process is the process to execute,
+-- and the Maybe item is ignored.  If it is an extended input, the first process
+-- is the one to execute during the extended rendezvous and the Maybe item is the
+-- optional process to execute afterwards
+data Variant = Variant Meta Name [InputItem] Process (Maybe Process)
   deriving (Show, Eq, Typeable, Data)
 
 -- | This represents something that can contain local replicators and
@@ -410,12 +415,16 @@ instance Data a => Data (Structured a) where
   dataTypeOf _ = _struct_DataType
   dataCast1 f  = gcast1 f
 
+data InputCaseType
+  = InputCaseNormal | InputCaseExtended
+    deriving (Eq, Show, Typeable, Data)
+
 -- | The mode in which an input operates.
 data InputMode =
-  -- | A plain input from a channel.
+  -- | A plain input from a channel, with a possible extended action.
-  InputSimple Meta [InputItem]
+  InputSimple Meta [InputItem] (Maybe Process)
   -- | A variant input from a channel.
-  | InputCase Meta (Structured Variant)
+  | InputCase Meta InputCaseType (Structured Variant)
   -- | Read the value of a timer.
   | InputTimerRead Meta InputItem
   -- | Wait for a particular time to go past on a timer.

frontends/OccamCheckTypes.hs

@@ -336,15 +336,15 @@ checkProcesses x = checkDepthM doProcess x >> return x
     doChoice (A.Choice _ e _) = checkExpressionBool e
 
     doInput :: A.Variable -> A.InputMode -> PassM ()
-    doInput c (A.InputSimple m iis)
+    doInput c (A.InputSimple m iis _)
         =  do t <- checkChannel A.DirInput c
               checkProtocol m t Nothing iis doInputItem
-    doInput c (A.InputCase _ s)
+    doInput c (A.InputCase _ _ s)
         =  do t <- checkChannel A.DirInput c
               checkStructured (doVariant t) s
       where
         doVariant :: A.Type -> A.Variant -> PassM ()
-        doVariant t (A.Variant m tag iis _)
+        doVariant t (A.Variant m tag iis _ _)
             = checkProtocol m t (Just tag) iis doInputItem
     doInput c (A.InputTimerRead m ii)
         =  do t <- checkTimer c

frontends/OccamInferTypes.hs

@@ -416,14 +416,15 @@ inferTypes = occamOnlyPass "Infer types"
            return $ A.AlternativeSkip m pre' p'
 
     doInputMode :: A.Variable -> Infer A.InputMode
-    doInputMode v (A.InputSimple m iis)
+    doInputMode v (A.InputSimple m iis mp)
       = do ts <- protocolItems m v >>* either id (const [])
            iis' <- sequence [doInputItem t ii
                             | (t, ii) <- zip ts iis]
-           return $ A.InputSimple m iis'
+           mp' <- recurse mp
-    doInputMode v (A.InputCase m sv)
+           return $ A.InputSimple m iis' mp'
+    doInputMode v (A.InputCase m ty sv)
       = do ct <- astTypeOf v
-           inTypeContext (Just ct) (recurse sv) >>* A.InputCase m
+           inTypeContext (Just ct) (recurse sv) >>* A.InputCase m ty
     doInputMode _ (A.InputTimerRead m ii)
       = doInputItem A.Int ii >>* A.InputTimerRead m
     doInputMode _ im = inTypeContext (Just A.Int) $ descend im
@@ -441,7 +442,7 @@ inferTypes = occamOnlyPass "Infer types"
            return $ A.InCounted m cv' av'
 
     doVariant :: Infer A.Variant
-    doVariant (A.Variant m n iis p)
+    doVariant (A.Variant m n iis p mp)
       = do ctx <- getTypeContext
            ets <- case ctx of
              Just x -> protocolItems m x
@@ -454,7 +455,8 @@ inferTypes = occamOnlyPass "Infer types"
                Just ts -> do iis' <- sequence [doInputItem t ii
                                               | (t, ii) <- zip ts iis]
                              p' <- recurse p
-                             return $ A.Variant m n iis' p'
+                             mp' <- recurse mp
+                             return $ A.Variant m n iis' p' mp'
 
     doStructured :: ( PolyplateM (A.Structured t) InferTypeOps () InferTypeM
                     , PolyplateM (A.Structured t) () InferTypeOps InferTypeM

frontends/ParseOccam.hs

@@ -19,7 +19,7 @@ with this program.  If not, see <http://www.gnu.org/licenses/>.
 -- | Parse occam code into an AST.
 module ParseOccam (parseOccamProgram) where
 
-import Control.Monad (join, liftM)
+import Control.Monad (join, liftM, when)
 import Control.Monad.State (MonadState, modify, get, put)
 import Data.Char
 import Data.List
@@ -125,7 +125,7 @@ plainToken t = genToken test
     test (Token _ t') = if t == t' then Just () else Nothing
 --}}}
 --{{{ symbols
-sAmp, sAssign, sBang, sBar, sColon, sColons, sComma, sEq, sLeft, sLeftR,
+sAmp, sAssign, sBang, sBar, sColon, sColons, sComma, sDoubleQuest, sEq, sLeft, sLeftR,
   sQuest, sRight, sRightR, sSemi
     :: OccParser ()
 
@@ -136,6 +136,7 @@ sBar = reserved "|"
 sColon = reserved ":"
 sColons = reserved "::"
 sComma = reserved ","
+sDoubleQuest = reserved "??"
 sEq = reserved "="
 sLeft = reserved "["
 sLeftR = reserved "("
@@ -1106,7 +1107,7 @@ specification
     =   do m <- md
            (ns, d, nt) <- declaration
            return ([(A.Specification m n d, nt, normalName) | n <- ns], return ())
-    <|> do { a <- abbreviation; return ([a], return ()) }
+    <|> do { a <- abbreviation; return (a, return ()) }
     <|> do { d <- definition; return ([d], return ()) }
     <|> do { n <- pragma ; return (maybeToList n, return ()) }
     <?> "specification"
@@ -1668,37 +1669,60 @@ assignment
 inputProcess :: OccParser A.Process
 inputProcess
     =   do m <- md
-           (c, i) <- input
+           (c, i, mp) <- input False
-           return $ A.Input m c i
+           return $ case mp of
+             Nothing -> A.Input m c i
+             Just p -> A.Seq m $ A.Several m $ map (A.Only m) [A.Input m c i, p]
     <?> "input process"
 
-input :: OccParser (A.Variable, A.InputMode)
+-- True for in-ALT, False for normal
-input
+input :: Bool ->OccParser (A.Variable, A.InputMode, Maybe A.Process)
-    =   channelInput
+input inAlt
-    <|> timerInput
+    =   channelInput inAlt
+    <|> (timerInput >>* (\(a, b) -> (a, b, Nothing)))
     <|> do m <- md
            p <- tryVX port sQuest
            v <- variable
            eol
-           return (p, A.InputSimple m [A.InVariable m v])
+           return (p, A.InputSimple m [A.InVariable m v] Nothing, Nothing)
     <?> "input"
 
-channelInput :: OccParser (A.Variable, A.InputMode)
+channelInput :: Bool -> OccParser (A.Variable, A.InputMode, Maybe A.Process)
-channelInput
+channelInput inAlt
     =   do m <- md
-           c <- tryVX channel sQuest
+           (    do c <- tryVX channel sQuest
                    caseInput m c <|> plainInput m c
+            <|> do c <- tryVX channel sDoubleQuest
+                   extCaseInput m c <|> extInput m c
+            )
     <?> "channel input"
   where
     caseInput m c
         = do sCASE
              tl <- taggedList
              eol
-             return (c, A.InputCase m (A.Only m (tl (A.Skip m))))
+             return (c, A.InputCase m A.InputCaseNormal (A.Only m (tl (A.Skip m) Nothing)), Nothing)
     plainInput m c
         = do is <- sepBy1 inputItem sSemi
              eol
-             return (c, A.InputSimple m is)
+             return (c, A.InputSimple m is Nothing, Nothing)
+
+    extInput m c
+        = do is <- sepBy1 inputItem sSemi
+             eol
+             indent
+             p <- process
+             mp <- if inAlt then return Nothing else (tryVX process outdent >>* Just) <|> (outdent >> return Nothing)
+             return (c, A.InputSimple m is (Just p), mp)
+
+    extCaseInput m c
+        = do sCASE
+             tl <- taggedList
+             eol
+             indent
+             p <- process
+             mp <- if inAlt then return Nothing else (tryVX process outdent >>* Just) <|> (outdent >> return Nothing)
+             return (c, A.InputCase m A.InputCaseExtended (A.Only m (tl p mp)), Nothing)
 
 timerInput :: OccParser (A.Variable, A.InputMode)
 timerInput
@@ -1708,7 +1732,7 @@ timerInput
              <|> do { sAFTER; e <- expression; eol; return (c, A.InputTimerAfter m e) }
     <?> "timer input"
 
-taggedList :: OccParser (A.Process -> A.Variant)
+taggedList :: OccParser (A.Process -> Maybe A.Process -> A.Variant)
 taggedList
     =  do m <- md
           tag <- tagName
@@ -1732,19 +1756,28 @@ caseInput :: OccParser A.Process
 caseInput
     =   do m <- md
            c <- tryVX channel (sQuest >> sCASE >> eol)
-           vs <- maybeIndentedList m "empty ? CASE" variant
+           vs <- maybeIndentedList m "empty ? CASE" (variant A.InputCaseNormal)
-           return $ A.Input m c (A.InputCase m (A.Several m vs))
+           return $ A.Input m c (A.InputCase m A.InputCaseNormal (A.Several m vs))
+    <|> do m <- md
+           c <- tryVX channel (sDoubleQuest >> sCASE >> eol)
+           vs <- maybeIndentedList m "empty ? CASE" (variant A.InputCaseExtended)
+           return $ A.Input m c (A.InputCase m A.InputCaseExtended (A.Several m vs))
     <?> "case input"
 
-variant :: OccParser (A.Structured A.Variant)
+variant :: A.InputCaseType -> OccParser (A.Structured A.Variant)
-variant
+variant ty
     =   do m <- md
            tl <- tryVX taggedList eol
            indent
            p <- process
-           outdent
+           case ty of
-           return $ A.Only m (tl p)
+             A.InputCaseNormal -> do outdent
-    <|> handleSpecs specification variant A.Spec
+                                     return $ A.Only m (tl p Nothing)
+             A.InputCaseExtended ->
+               do mp <- (tryVX process outdent >>* Just)
+                        <|> (outdent >> return Nothing)
+                  return $ A.Only m (tl p mp)
+    <|> handleSpecs specification (variant ty) A.Spec
     <?> "variant"
 --}}}
 --{{{ output (!)
@@ -1943,39 +1976,48 @@ alternative
     -- guards are below.
     <|> do m <- md
            (b, c) <- tryVXVX expression sAmp channel (sQuest >> sCASE >> eol)
-           vs <- maybeIndentedList m "empty ? CASE" variant
+           guardCaseBody m b c A.InputCaseNormal
-           return $ A.Only m (A.Alternative m b c (A.InputCase m $ A.Several m vs) (A.Skip m))
     <|> do m <- md
            c <- tryVXX channel sQuest (sCASE >> eol)
-           vs <- maybeIndentedList m "empty ? CASE" variant
+           guardCaseBody m (A.True m) c A.InputCaseNormal
-           return $ A.Only m (A.Alternative m (A.True m) c (A.InputCase m $ A.Several m vs) (A.Skip m))
+    <|> do m <- md
+           (b, c) <- tryVXVX expression sAmp channel (sDoubleQuest >> sCASE >> eol)
+           guardCaseBody m b c A.InputCaseExtended
+    <|> do m <- md
+           c <- tryVXX channel sDoubleQuest (sCASE >> eol)
+           guardCaseBody m (A.True m) c A.InputCaseExtended
     <|> guardedAlternative
     <|> handleSpecs specification alternative A.Spec
     <?> "alternative"
+  where
+    guardCaseBody :: Meta -> A.Expression -> A.Variable -> A.InputCaseType -> OccParser (A.Structured A.Alternative)
+    guardCaseBody m b c ty
+      = do vs <- maybeIndentedList m "empty ? CASE" (variant ty)
+           return $ A.Only m (A.Alternative m b c (A.InputCase m ty $ A.Several m vs) (A.Skip m))
 
 guardedAlternative :: OccParser (A.Structured A.Alternative)
 guardedAlternative
     =   do m <- md
-           makeAlt <- guard
+           (makeAlt, alreadyIndented) <- guard
-           indent
+           when (not alreadyIndented) $ indent
            p <- process
            outdent
            return $ A.Only m (makeAlt p)
     <?> "guarded alternative"
 
-guard :: OccParser (A.Process -> A.Alternative)
+guard :: OccParser (A.Process -> A.Alternative, Bool)
 guard
     =   do m <- md
-           (c, im) <- input
+           (c, im, _) <- input True
-           return $ A.Alternative m (A.True m) c im
+           return (A.Alternative m (A.True m) c im, True)
     <|> do m <- md
            sSKIP
            eol
-           return $ A.AlternativeSkip m (A.True m)
+           return (A.AlternativeSkip m (A.True m), False)
     <|> do m <- md
            b <- tryVX expression sAmp
-           do { (c, im) <- input; return $ A.Alternative m b c im }
+           do { (c, im, _) <- input True; return (A.Alternative m b c im, True) }
-             <|> do { sSKIP; eol; return $ A.AlternativeSkip m b }
+             <|> do { sSKIP; eol; return (A.AlternativeSkip m b, False) }
     <?> "guard"
 --}}}
 --{{{ PROC calls

frontends/ParseRain.hs

@@ -391,7 +391,7 @@ comm isAlt
               (if isAlt
                 then pzero
                 else do {sOut ; exp <- expression ; possSemiColon ; return $ A.Output (findMeta lv) lv [A.OutExpression (findMeta exp) exp] })
-              <|> do {sIn ; rv <- lvalue ; possSemiColon ; return $ A.Input (findMeta lv) lv $ A.InputSimple (findMeta rv) [A.InVariable (findMeta rv) rv] }
+              <|> do {sIn ; rv <- lvalue ; possSemiColon ; return $ A.Input (findMeta lv) lv $ A.InputSimple (findMeta rv) [A.InVariable (findMeta rv) rv] Nothing }
               <?> (if isAlt then "input statement" else "input or output statement")
           }
        where

frontends/RainTypes.hs

@@ -309,7 +309,7 @@ markCommTypes = checkDepthM2 checkInputOutput checkAltInput
     checkWait _ = return ()
 
     checkInputOutput :: RainTypeCheck A.Process
-    checkInputOutput p@(A.Input m chanVar (A.InputSimple _ [A.InVariable _ destVar]))
+    checkInputOutput p@(A.Input m chanVar (A.InputSimple _ [A.InVariable _ destVar] _))
       = checkInput chanVar destVar m p
     checkInputOutput (A.Input _ _ im@(A.InputTimerFor {})) = checkWait im
     checkInputOutput (A.Input _ _ im@(A.InputTimerAfter {})) = checkWait im
@@ -319,7 +319,7 @@ markCommTypes = checkDepthM2 checkInputOutput checkAltInput
     checkInputOutput _ = return ()
 
     checkAltInput :: RainTypeCheck A.Alternative
-    checkAltInput a@(A.Alternative m _ chanVar (A.InputSimple _ [A.InVariable _ destVar]) body)
+    checkAltInput a@(A.Alternative m _ chanVar (A.InputSimple _ [A.InVariable _ destVar] _) body)
       = checkInput chanVar destVar m a
     checkAltInput (A.Alternative m _ _ im@(A.InputTimerFor {}) _) = checkWait im
     checkAltInput (A.Alternative m _ _ im@(A.InputTimerAfter {}) _) = checkWait im

pass/Properties.hs

@@ -391,7 +391,7 @@ seqInputsFlattened :: Property
 seqInputsFlattened = Property "seqInputsFlattened" $ checkNull "seqInputsFlattened" . listify findMultipleInputs
   where
     findMultipleInputs :: A.InputMode -> Bool
-    findMultipleInputs (A.InputSimple _ (_:_:_)) = True
+    findMultipleInputs (A.InputSimple _ (_:_:_) _) = True
     findMultipleInputs _ = False
 
 arraySizesDeclared :: Property

transformations/SimplifyComms.hs

@@ -21,6 +21,7 @@ module SimplifyComms where
 
 import Control.Monad.State
 import Data.List
+import Data.Maybe
 
 import qualified AST as A
 import CompState
@@ -142,30 +143,60 @@ transformInputCase = pass "Transform ? CASE statements/guards into plain CASE"
   (applyBottomUpM doProcess)
   where
     doProcess :: A.Process -> PassM A.Process
-    doProcess (A.Input m v (A.InputCase m' s))
+    doProcess (A.Input m v (A.InputCase m' ty s))
       = do spec@(A.Specification _ n _) <- defineNonce m "input_tag" (A.Declaration m' A.Int) A.Original
-           s' <- doStructuredV v s
+           case ty of
+             A.InputCaseNormal -> do 
+               s' <- doStructuredV Nothing v s
                return $ A.Seq m $ A.Spec m' spec $ A.Several m'
-             [A.Only m $ A.Input m v (A.InputSimple m [A.InVariable m (A.Variable m n)])
+                 [A.Only m $ A.Input m v (A.InputSimple m [A.InVariable m (A.Variable m n)] Nothing)
                  ,A.Only m' $ A.Case m' (A.ExprVariable m $ A.Variable m n) s']
+             A.InputCaseExtended -> do 
+               sA <- doStructuredV (Just A.InputCaseExtended) v s
+               sB <- doStructuredV (Just A.InputCaseNormal) v s
+               return $ A.Seq m $ A.Spec m' spec $ A.Several m' $ map (A.Only m')
+                 [A.Input m v (A.InputSimple m [A.InVariable m (A.Variable m n)]
+                    $ Just (A.Case m' (A.ExprVariable m $ A.Variable m n) sA))
+                 ,A.Case m' (A.ExprVariable m $ A.Variable m n) sB
+                 ]
+                 
     doProcess (A.Alt m pri s)
       = do s' <- doStructuredA s
            return (A.Alt m pri s')
     doProcess p = return p
 
     -- Convert Structured Variant into the equivalent Structured Option.
-    doStructuredV :: A.Variable -> A.Structured A.Variant -> PassM (A.Structured A.Option)
+    --
-    doStructuredV chanVar = transformOnly transform
+    -- For extended inputs, if there are no extra inputs after the tag, we must
+    -- perform the extended action during the extended input on the tag.  This
+    -- is when (Just A.InputCaseExtended) is passed.  If there are extra inputs
+    -- after the tag, we perform SKIP for the extended action, and then do our
+    -- real extended action on the further inputs
+    doStructuredV :: (Maybe A.InputCaseType) -> A.Variable -> A.Structured A.Variant -> PassM (A.Structured A.Option)
+    doStructuredV mty chanVar = transformOnly transform
       where
-        transform m (A.Variant m' n iis p)
+        transform m (A.Variant m' n iis p mp)
             =  do (Right items) <- protocolItems m' chanVar
                   let (Just idx) = elemIndex n (fst $ unzip items)
                   return $ A.Only m $ A.Option m' [makeConstant m' idx] $
-                    if length iis == 0
+                    case (mty, null iis) of
-                      then p
+                      -- Normal input, no extra inputs:
-                      else A.Seq m' $ A.Several m'
+                      (Nothing, True) -> p
-                             [A.Only m' $ A.Input m' chanVar (A.InputSimple m' iis),
+                      -- Extended phase, no extra inputs, so do extended process now:
+                      (Just A.InputCaseExtended, True) -> p
+                      -- After extended, no extra inputs, do after process:
+                      (Just A.InputCaseNormal, True) -> fromMaybe (A.Skip m) mp
+                      -- Normal input, extra inputs to do:
+                      (Nothing, False) -> A.Seq m' $ A.Several m'
+                             [A.Only m' $ A.Input m' chanVar (A.InputSimple m' iis Nothing),
                               A.Only (findMeta p) p]
+                      -- Extended phase, extra inputs to do:
+                      (Just A.InputCaseExtended, False) -> A.Skip m
+                      -- After extended, extra inputs to do:
+                      (Just A.InputCaseNormal, False) -> A.Seq m' $ A.Several m'
+                        $ map (A.Only m') $
+                          [A.Input m' chanVar (A.InputSimple m' iis $ Just p)
+                          ] ++ maybeToList mp
 
     -- Transform alt guards.
     doStructuredA :: A.Structured A.Alternative -> PassM (A.Structured A.Alternative)
@@ -173,12 +204,21 @@ transformInputCase = pass "Transform ? CASE statements/guards into plain CASE"
       where
         -- The processes that are the body of input-case guards are always
         -- skip, so we can discard them.
-        doAlternative m (A.Alternative m' e v (A.InputCase m'' s) _)
+        doAlternative m (A.Alternative m' e v (A.InputCase m'' ty s) _)
           = do spec@(A.Specification _ n _) <- defineNonce m "input_tag" (A.Declaration m' A.Int) A.Original
-               s' <- doStructuredV v s
+               case ty of
+                 A.InputCaseNormal -> do
+                   s' <- doStructuredV Nothing v s
                    return $ A.Spec m' spec $ A.Only m $ 
-                 A.Alternative m' e v (A.InputSimple m [A.InVariable m (A.Variable m n)]) $
+                     A.Alternative m' e v (A.InputSimple m [A.InVariable m (A.Variable m n)] Nothing) $
                      A.Case m'' (A.ExprVariable m'' $ A.Variable m n) s'
+                 A.InputCaseExtended -> do
+                   sA <- doStructuredV (Just A.InputCaseExtended) v s
+                   sB <- doStructuredV (Just A.InputCaseNormal) v s
+                   return $ A.Spec m' spec $ A.Only m $ 
+                     A.Alternative m' e v (A.InputSimple m [A.InVariable m (A.Variable m n)] $
+                       Just $ A.Case m'' (A.ExprVariable m'' $ A.Variable m n) sA)
+                       (A.Case m'' (A.ExprVariable m'' $ A.Variable m n) sB)
         -- Leave other guards untouched.
         doAlternative m a = return $ A.Only m a
 
@@ -189,14 +229,18 @@ transformProtocolInput = pass "Flatten sequential protocol inputs into multiple
   (applyBottomUpM2 doProcess doAlternative)
   where
     doProcess :: A.Process -> PassM A.Process
-    doProcess (A.Input m v (A.InputSimple m' iis@(_:_:_)))
+    doProcess (A.Input m v (A.InputSimple m' iis@(_:_:_) mp))
-      = return $ A.Seq m $ A.Several m $
+      = return $ A.Seq m $ A.Several m $ map (A.Only m . A.Input m v) $ flatten m' iis mp
-          map (A.Only m . A.Input m v . A.InputSimple m' . singleton) iis
     doProcess p = return p
 
+    -- We put the extended input on the final input:
+    flatten :: Meta -> [A.InputItem] -> Maybe A.Process -> [A.InputMode]
+    flatten m [ii] mp = [A.InputSimple m [ii] mp]
+    flatten m (ii:iis) mp = A.InputSimple m [ii] Nothing : flatten m iis mp
+
     doAlternative :: A.Alternative -> PassM A.Alternative
-    doAlternative (A.Alternative m cond v (A.InputSimple m' (firstII:(otherIIS@(_:_)))) body)
+    doAlternative (A.Alternative m cond v (A.InputSimple m' (firstII:(otherIIS@(_:_))) mp) body)
-      = return $ A.Alternative m cond v (A.InputSimple m' [firstII]) $ A.Seq m' $ A.Several m' $
+      = return $ A.Alternative m cond v (A.InputSimple m' [firstII] Nothing) $ A.Seq m' $ A.Several m' $
-             map (A.Only m' . A.Input m' v . A.InputSimple m' . singleton) otherIIS
+             (map (A.Only m' . A.Input m' v) $ flatten m' otherIIS mp)
              ++ [A.Only m' body]
     doAlternative s = return s