Big AST rework: all spec/rep stuff is now done with Structured

fco2/AST.hs

@@ -172,10 +172,13 @@ data Variant = Variant Meta Name [InputItem] Process
 data Structured =
   Rep Meta Replicator Structured
   | Spec Meta Specification Structured
-  | OnlyV Meta Variant
+  | ProcThen Meta Process Structured
-  | OnlyC Meta Choice
+  | OnlyV Meta Variant                  -- ^ Variant (CASE) input process
-  | OnlyO Meta Option
+  | OnlyC Meta Choice                   -- ^ IF process
-  | OnlyA Meta Alternative
+  | OnlyO Meta Option                   -- ^ CASE process
+  | OnlyA Meta Alternative              -- ^ ALT process
+  | OnlyP Meta Process                  -- ^ SEQ, PAR
+  | OnlyEL Meta ExpressionList          -- ^ VALOF
   | Several Meta [Structured]
   deriving (Show, Eq, Typeable, Data)
 
@@ -193,7 +196,6 @@ data AbbrevMode =
 
 data Specification =
   Specification Meta Name SpecType
-  | NoSpecification   -- ^ A specification that's been removed by a pass.
   deriving (Show, Eq, Typeable, Data)
 
 data SpecType =
@@ -207,7 +209,7 @@ data SpecType =
   | Protocol Meta [Type]
   | ProtocolCase Meta [(Name, [Type])]
   | Proc Meta [Formal] Process
-  | Function Meta [Type] [Formal] ValueProcess
+  | Function Meta [Type] [Formal] Structured
   | Retypes Meta AbbrevMode Type Variable
   | RetypesExpr Meta AbbrevMode Type Expression
   deriving (Show, Eq, Typeable, Data)
@@ -221,31 +223,23 @@ data Actual =
   | ActualExpression Type Expression
   deriving (Show, Eq, Typeable, Data)
 
-data ValueProcess =
-  ValOfSpec Meta Specification ValueProcess
-  | ValOf Meta Process ExpressionList
-  deriving (Show, Eq, Typeable, Data)
-
 data ParMode =
   PlainPar | PriPar | PlacedPar
   deriving (Show, Eq, Typeable, Data)
 
 data Process =
-  ProcSpec Meta Specification Process
+  Assign Meta [Variable] ExpressionList
-  | Assign Meta [Variable] ExpressionList
   | Input Meta Variable InputMode
   | Output Meta Variable [OutputItem]
   | OutputCase Meta Variable Name [OutputItem]
   | Skip Meta
   | Stop Meta
   | Main Meta
-  | Seq Meta [Process]
+  | Seq Meta Structured
-  | SeqRep Meta Replicator Process
   | If Meta Structured
   | Case Meta Expression Structured
   | While Meta Expression Process
-  | Par Meta ParMode [Process]
+  | Par Meta ParMode Structured
-  | ParRep Meta ParMode Replicator Process
   | Processor Meta Expression Process
   | Alt Meta Bool Structured
   | ProcCall Meta Name [Actual]

fco2/GenerateC.hs

@@ -89,6 +89,7 @@ overArray var func
 genStructured :: A.Structured -> (A.Structured -> CGen ()) -> CGen ()
 genStructured (A.Rep _ rep s) def = genReplicator rep (genStructured s def)
 genStructured (A.Spec _ spec s) def = genSpec spec (genStructured s def)
+genStructured (A.ProcThen _ p s) def = genProcess p >> genStructured s def
 genStructured (A.Several _ ss) def = sequence_ [genStructured s def | s <- ss]
 genStructured s def = def s
 
@@ -591,12 +592,6 @@ genReplicatorSize :: A.Replicator -> CGen ()
 genReplicatorSize (A.For m n base count) = genExpression count
 --}}}
 
---{{{  choice/alternatives/options/variants
---}}}
-
---{{{  structured
---}}}
-
 --{{{  abbreviations
 -- FIXME: This code is horrible, and I can't easily convince myself that it's correct.
 
@@ -964,13 +959,9 @@ genFormal (A.Formal am t n)
         _ -> genDecl am t n
 --}}}
 
---{{{  par modes
---}}}
-
 --{{{  processes
 genProcess :: A.Process -> CGen ()
 genProcess p = case p of
-  A.ProcSpec m s p -> genSpec s (genProcess p)
   A.Assign m vs es -> genAssign vs es
   A.Input m c im -> genInput c im
   A.Output m c ois -> genOutput c ois
@@ -978,14 +969,13 @@ genProcess p = case p of
   A.Skip m -> tell ["/* skip */\n"]
   A.Stop m -> genStop m "STOP process"
   A.Main m -> tell ["/* main */\n"]
-  A.Seq m ps -> sequence_ $ map genProcess ps
+  A.Seq _ s -> genSeqBody s
-  A.SeqRep m r p -> genReplicator r (genProcess p)
   A.If m s -> genIf m s
   A.Case m e s -> genCase m e s
   A.While m e p -> genWhile e p
-  A.Par m pm ps -> genPar pm ps
+  A.Par m pm s -> genParBody pm s
-  A.ParRep m pm r p -> genParRep pm r p
+  -- PROCESSOR does nothing special.
-  A.Processor m e p -> missing "PROCESSOR not supported"
+  A.Processor m e p -> genProcess p
   A.Alt m b s -> genAlt b s
   A.ProcCall m n as -> genProcCall n as
 
@@ -1098,6 +1088,12 @@ genStop m s
           genMeta m
           tell [", \"", s, "\");\n"]
 --}}}
+--{{{  seq
+genSeqBody :: A.Structured -> CGen ()
+genSeqBody s = genStructured s doP
+  where
+    doP (A.OnlyP _ p) = genProcess p
+--}}}
 --{{{  if
 genIf :: Meta -> A.Structured -> CGen ()
 genIf m s
@@ -1162,13 +1158,28 @@ genWhile e p
           tell ["}\n"]
 --}}}
 --{{{  par
-genPar :: A.ParMode -> [A.Process] -> CGen ()
+-- FIXME: This is a bit odd because it'll only generate the two forms of the
-genPar pm ps
+-- AST resulting from regular and replicated PARs. It'd probably be better to
-    =  do pids <- mapM (\_ -> makeNonce "pid") ps
+-- make it deal with a general Structured PAR.
-          sequence_ $ [do tell ["Process *", pid, " = "]
+
-                          genProcAlloc p
+genParBody :: A.ParMode -> A.Structured -> CGen ()
-                          tell [";\n"]
+genParBody pm (A.Spec _ spec s) = genSpec spec (genParBody pm s)
-                       | (pid, p) <- (zip pids ps)]
+genParBody pm (A.ProcThen _ p s) = genProcess p >> genParBody pm s
+genParBody pm (A.Several _ ss) = genPar pm ss
+genParBody pm (A.Rep _ rep s) = genParRep pm rep s
+
+genParProc :: (A.Process -> CGen()) -> A.Structured -> CGen ()
+genParProc gen (A.Spec _ spec s) = genSpec spec (genParProc gen s)
+genParProc gen (A.ProcThen _ p s) = genProcess p >> genParProc gen s
+genParProc gen (A.OnlyP _ p) = gen p
+
+genPar :: A.ParMode -> [A.Structured] -> CGen ()
+genPar pm ss
+    =  do pids <- sequence [makeNonce "pid" | _ <- ss]
+          sequence_ $ [genParProc (\p -> do tell ["Process *", pid, " = "]
+                                            genProcAlloc p
+                                            tell [";\n"]) s
+                       | (pid, s) <- (zip pids ss)]
           case pm of
             A.PlainPar ->
               do tell ["ProcPar ("]
@@ -1177,17 +1188,17 @@ genPar pm ps
             _ -> missing $ "genPar " ++ show pm
           sequence_ $ [tell ["ProcAllocClean (", pid, ");\n"] | pid <- pids]
 
-genParRep :: A.ParMode -> A.Replicator -> A.Process -> CGen ()
+genParRep :: A.ParMode -> A.Replicator -> A.Structured -> CGen ()
-genParRep pm rep p
+genParRep pm rep s
     =  do pids <- makeNonce "pids"
           index <- makeNonce "i"
           tell ["Process *", pids, "["]
           genReplicatorSize rep
           tell [" + 1];\n"]
           tell ["int ", index, " = 0;\n"]
-          genReplicator rep $ do tell [pids, "[", index, "++] = "]
+          genReplicator rep $ genParProc (\p -> do tell [pids, "[", index, "++] = "]
-                                 genProcAlloc p
+                                                   genProcAlloc p
-                                 tell [";\n"]
+                                                   tell [";\n"]) s
           tell [pids, "[", index, "] = NULL;\n"]
           tell ["ProcParList (", pids, ");\n"]
           tell [index, " = 0;\n"]
@@ -1202,6 +1213,7 @@ genProcAlloc (A.ProcCall m n as)
           tell [", ", show stackSize, ", ", show $ numCArgs as]
           genActuals as
           tell [")"]
+genProcAlloc p = missing $ "genProcAlloc " ++ show p
 --}}}
 --{{{  alt
 genAlt :: Bool -> A.Structured -> CGen ()

fco2/Parse.hs

@@ -1194,7 +1194,7 @@ definition
            rs <- tryVX (sepBy1 dataType sComma) sFUNCTION
            n <- newFunctionName
            fs <- formalList
-           do { sIS; fs' <- scopeInFormals fs; el <- expressionList rs; scopeOutFormals fs'; sColon; eol; return $ A.Specification m n $ A.Function m rs fs' (A.ValOf m (A.Skip m) el) }
+           do { sIS; fs' <- scopeInFormals fs; el <- expressionList rs; scopeOutFormals fs'; sColon; eol; return $ A.Specification m n $ A.Function m rs fs' (A.OnlyEL m el) }
              <|> do { eol; indent; fs' <- scopeInFormals fs; vp <- valueProcess rs; scopeOutFormals fs'; outdent; sColon; eol; return $ A.Specification m n $ A.Function m rs fs' vp }
     <|> retypesAbbrev
     <?> "definition"
@@ -1277,7 +1277,7 @@ formalVariableType
            return (A.Abbrev, s)
     <?> "formal variable type"
 
-valueProcess :: [A.Type] -> OccParser A.ValueProcess
+valueProcess :: [A.Type] -> OccParser A.Structured
 valueProcess rs
     =   do m <- md
            sVALOF
@@ -1288,8 +1288,8 @@ valueProcess rs
            el <- expressionList rs
            eol
            outdent
-           return $ A.ValOf m p el
+           return $ A.ProcThen m p (A.OnlyEL m el)
-    <|> handleSpecs specification (valueProcess rs) A.ValOfSpec
+    <|> handleSpecs specification (valueProcess rs) A.Spec
     <?> "value process"
 --}}}
 --{{{ RECORDs
@@ -1336,7 +1336,8 @@ process
     <|> altProcess
     <|> procInstance
     <|> mainProcess
-    <|> handleSpecs (allocation <|> specification) process A.ProcSpec
+    <|> handleSpecs (allocation <|> specification) process
+                    (\m s p -> A.Seq m (A.Spec m s (A.OnlyP m p)))
     <|> preprocessorDirective
     <?> "process"
 
@@ -1510,8 +1511,8 @@ seqProcess :: OccParser A.Process
 seqProcess
     =   do m <- md
            sSEQ
-           do { eol; ps <- maybeIndentedList m "empty SEQ" process; return $ A.Seq m ps }
+           do { eol; ps <- maybeIndentedList m "empty SEQ" process; return $ A.Seq m (A.Several m (map (A.OnlyP m) ps)) }
-             <|> do { r <- replicator; eol; indent; r' <- scopeInRep r; p <- process; scopeOutRep r'; outdent; return $ A.SeqRep m r' p }
+             <|> do { r <- replicator; eol; indent; r' <- scopeInRep r; p <- process; scopeOutRep r'; outdent; return $ A.Seq m (A.Rep m r' (A.OnlyP m p)) }
     <?> "SEQ process"
 --}}}
 --{{{ IF
@@ -1598,24 +1599,21 @@ parallel :: OccParser A.Process
 parallel
     =   do m <- md
            isPri <- parKeyword
-           do { eol; ps <- maybeIndentedList m "empty PAR" process; return $ A.Par m isPri ps }
+           do { eol; ps <- maybeIndentedList m "empty PAR" process; return $ A.Par m isPri (A.Several m (map (A.OnlyP m) ps)) }
-             <|> do { r <- replicator; eol; indent; r' <- scopeInRep r; p <- process; scopeOutRep r'; outdent; return $ A.ParRep m isPri r' p }
+             <|> do { r <- replicator; eol; indent; r' <- scopeInRep r; p <- process; scopeOutRep r'; outdent; return $ A.Par m isPri (A.Rep m r' (A.OnlyP m p)) }
-    <|> placedpar
+    <|> processor
     <?> "PAR process"
 
 parKeyword :: OccParser A.ParMode
 parKeyword
     =   do { sPAR; return A.PlainPar }
     <|> do { tryXX sPRI sPAR; return A.PriPar }
+    <|> do { tryXX sPLACED sPAR; return A.PlacedPar }
 
 -- XXX PROCESSOR as a process isn't really legal, surely?
-placedpar :: OccParser A.Process
+processor :: OccParser A.Process
-placedpar
+processor
     =   do m <- md
-           tryXX sPLACED sPAR
-           do { eol; ps <- maybeIndentedList m "empty PLACED PAR" placedpar; return $ A.Par m A.PlacedPar ps  }
-             <|> do { r <- replicator; eol; indent; r' <- scopeInRep r; p <- placedpar; scopeOutRep r'; outdent; return $ A.ParRep m A.PlacedPar r' p }
-    <|> do m <- md
            sPROCESSOR
            e <- intExpr
            eol
@@ -1851,7 +1849,8 @@ parseFile file ps
             Right (p, ps'') -> return (replaceMain p, ps'')
   where
     replaceMain :: A.Process -> A.Process -> A.Process
-    replaceMain (A.ProcSpec m s p) np = A.ProcSpec m s (replaceMain p np)
+    replaceMain (A.Seq m (A.Spec m' s (A.OnlyP m'' p))) np
+        = A.Seq m (A.Spec m' s (A.OnlyP m'' (replaceMain p np)))
     replaceMain (A.Main _) np = np
 
 -- | Parse the top level source file in a program.

fco2/ParseState.hs

@@ -32,13 +32,13 @@ data ParseState = ParseState {
     -- Set by passes
     psNonceCounter :: Int,
     psFunctionReturns :: [(String, [A.Type])],
-    psPulledItems :: [A.Process -> A.Process],
+    psPulledItems :: [A.Structured -> A.Structured],
     psAdditionalArgs :: [(String, [A.Actual])]
   }
   deriving (Show, Data, Typeable)
 
-instance Show (A.Process -> A.Process) where
+instance Show (A.Structured -> A.Structured) where
-  show p = "(function on A.Process)"
+  show p = "(function on Structured)"
 
 emptyState :: ParseState
 emptyState = ParseState {
@@ -95,11 +95,11 @@ makeNonce s
           return $ s ++ "_n" ++ show i
 
 -- | Add a pulled item to the collection.
-addPulled :: PSM m => (A.Process -> A.Process) -> m ()
+addPulled :: PSM m => (A.Structured -> A.Structured) -> m ()
 addPulled item = modify (\ps -> ps { psPulledItems = item : psPulledItems ps })
 
--- | Apply pulled items to a Process.
+-- | Apply pulled items to a Structured.
-applyPulled :: PSM m => A.Process -> m A.Process
+applyPulled :: PSM m => A.Structured -> m A.Structured
 applyPulled ast
     =  do ps <- get
           let ast' = foldl (\p f -> f p) ast (psPulledItems ps)

fco2/SimplifyExprs.hs

@@ -35,7 +35,7 @@ functionsToProcs = doGeneric `extM` doSpecification
              -- Note the return types so we can fix calls later.
              modify $ (\ps -> ps { psFunctionReturns = (A.nameName n, rts) : psFunctionReturns ps })
              -- Turn the value process into an assignment process.
-             let p = vpToProc vp [A.Variable mf n | n <- names]
+             let p = A.Seq mf $ vpToSeq vp [A.Variable mf n | n <- names]
              let st = A.Proc mf (fs ++ [A.Formal A.Abbrev t n | (t, n) <- zip rts names]) p
              -- Build a new specification and redefine the function.
              let spec = A.Specification m n st
@@ -51,9 +51,10 @@ functionsToProcs = doGeneric `extM` doSpecification
              doGeneric spec
     doSpecification s = doGeneric s
 
-    vpToProc :: A.ValueProcess -> [A.Variable] -> A.Process
+    vpToSeq :: A.Structured -> [A.Variable] -> A.Structured
-    vpToProc (A.ValOfSpec m s vp) vs = A.ProcSpec m s (vpToProc vp vs)
+    vpToSeq (A.Spec m spec s) vs = A.Spec m spec (vpToSeq s vs)
-    vpToProc (A.ValOf m p el) vs = A.Seq m [p, A.Assign m vs el]
+    vpToSeq (A.ProcThen m p s) vs = A.ProcThen m p (vpToSeq s vs)
+    vpToSeq (A.OnlyEL m el) vs = A.OnlyP m $ A.Assign m vs el
 
 -- | Convert AFTER expressions to the equivalent using MINUS (which is how the
 -- occam 3 manual defines AFTER).
@@ -72,26 +73,28 @@ removeAfter = doGeneric `extM` doExpression
               return $ A.Dyadic m A.More (A.Dyadic m A.Minus a' b') zero
     doExpression e = doGeneric e
 
--- | Find things that need to be moved up to their enclosing process, and do
+-- | Find things that need to be moved up to their enclosing Structured, and do
 -- so.
+-- FIXME We probably need to force there to be Structureds in some places -- or
+-- construct them if we get to a Process without finding one.
 pullUp :: Data t => t -> PassM t
-pullUp = doGeneric `extM` doProcess `extM` doSpecification `extM` doExpression `extM` doVariable `extM` doExpressionList
+pullUp = doGeneric `extM` doStructured `extM` doSpecification `extM` doExpression `extM` doVariable `extM` doExpressionList
   where
     doGeneric :: Data t => t -> PassM t
     doGeneric = gmapM pullUp
 
     -- | When we encounter a process, create a new pulled items state,
     -- recurse over it, then apply whatever pulled items we found to it.
-    doProcess :: A.Process -> PassM A.Process
+    doStructured :: A.Structured -> PassM A.Structured
-    doProcess p
+    doStructured s
         =  do -- Save the pulled items
-              origPS <- get
+              origPulled <- liftM psPulledItems get
               modify (\ps -> ps { psPulledItems = [] })
-              -- Recurse over the process, then apply the pulled items to it
+              -- Recurse over the body, then apply the pulled items to it
-              p' <- doGeneric p >>= applyPulled
+              s' <- doGeneric s >>= applyPulled
               -- ... and restore the original pulled items
-              modify (\ps -> ps { psPulledItems = psPulledItems origPS })
+              modify (\ps -> ps { psPulledItems = origPulled })
-              return p'
+              return s'
 
     -- | *Don't* pull anything that's already an abbreviation.
     doSpecification :: A.Specification -> PassM A.Specification
@@ -119,7 +122,7 @@ pullUp = doGeneric `extM` doProcess `extM` doSpecification `extM` doExpression `
         pull t e
             = do let m = metaOfExpression e
                  spec@(A.Specification _ n _) <- makeNonceIsExpr "array_expr" m t e
-                 addPulled $ A.ProcSpec m spec
+                 addPulled $ A.Spec m spec
                  return $ A.ExprVariable m (A.Variable m n)
 
     -- | Pull any variable subscript that results in an array.
@@ -132,7 +135,7 @@ pullUp = doGeneric `extM` doProcess `extM` doSpecification `extM` doExpression `
                   do origAM <- abbrevModeOfVariable v'
                      let am = makeAbbrevAM origAM
                      spec@(A.Specification _ n _) <- makeNonceIs "array_slice" m t am v'
-                     addPulled $ A.ProcSpec m spec
+                     addPulled $ A.Spec m spec
                      return $ A.Variable m n
                 _ -> return v'
     doVariable v = doGeneric v
@@ -146,12 +149,12 @@ pullUp = doGeneric `extM` doProcess `extM` doSpecification `extM` doExpression `
              ps <- get
              let rts = fromJust $ lookup (A.nameName n) (psFunctionReturns ps)
              specs <- sequence [makeNonceVariable "return_actual" m t A.VariableName A.Original | t <- rts]
-             sequence_ [addPulled $ A.ProcSpec m spec | spec <- specs]
+             sequence_ [addPulled $ A.Spec m spec | spec <- specs]
 
              let names = [n | A.Specification _ n _ <- specs]
              let vars = [A.Variable m n | n <- names]
              let call = A.ProcCall m n ([A.ActualExpression t e | (t, e) <- zip ets es'] ++ [A.ActualVariable A.Abbrev t v | (t, v) <- zip rts vars])
-             addPulled (\p -> A.Seq m [call, p])
+             addPulled $ A.ProcThen m call
 
              return vars
 

fco2/SimplifyProcs.hs

@@ -28,20 +28,33 @@ parsToProcs = doGeneric `extM` doProcess
     doGeneric = gmapM parsToProcs
 
     doProcess :: A.Process -> PassM A.Process
-    doProcess (A.Par m pm ps)
+    doProcess (A.Par m pm s)
-        =  do ps' <- mapM parsToProcs ps
+        =  do s' <- doStructured s
-              procs <- mapM (makeNonceProc m) ps'
+              return $ A.Par m pm s'
-              let calls = [A.ProcSpec m s (A.ProcCall m n []) | s@(A.Specification m n _) <- procs]
-              return $ A.Par m pm calls
-    doProcess (A.ParRep m pm rep p)
-        =  do p' <- parsToProcs p
-              rep' <- parsToProcs rep
-              s@(A.Specification _ n _) <- makeNonceProc m p'
-              let call = A.ProcSpec m s (A.ProcCall m n [])
-              return $ A.ParRep m pm rep' call
     doProcess p = doGeneric p
 
--- | Turn parallel assignment into multiple single assignments.
+    -- FIXME This should be generic and in Pass.
+    doStructured :: A.Structured -> PassM A.Structured
+    doStructured (A.Rep m r s)
+        =  do r' <- parsToProcs r
+              s' <- doStructured s
+              return $ A.Rep m r' s'
+    doStructured (A.Spec m spec s)
+        =  do spec' <- parsToProcs spec
+              s' <- doStructured s
+              return $ A.Spec m spec' s'
+    doStructured (A.ProcThen m p s)
+        =  do p' <- parsToProcs p
+              s' <- doStructured s
+              return $ A.ProcThen m p' s'
+    doStructured (A.OnlyP m p)
+        =  do p' <- parsToProcs p
+              s@(A.Specification _ n _) <- makeNonceProc m p'
+              return $ A.Spec m s (A.OnlyP m (A.ProcCall m n []))
+    doStructured (A.Several m ss)
+        = liftM (A.Several m) $ mapM doStructured ss
+
+-- | Turn parallel assignment into multiple single assignments through temporaries.
 removeParAssign :: Data t => t -> PassM t
 removeParAssign = doGeneric `extM` doProcess
   where
@@ -55,6 +68,6 @@ removeParAssign = doGeneric `extM` doProcess
               let temps = [A.Variable m n | A.Specification _ n _ <- specs]
               let first = [A.Assign m [v] (A.ExpressionList m [e]) | (v, e) <- zip temps es]
               let second = [A.Assign m [v] (A.ExpressionList m [A.ExprVariable m v']) | (v, v') <- zip vs temps]
-              return $ foldl (\p s -> A.ProcSpec m s p) (A.Seq m $ first ++ second) specs
+              return $ A.Seq m $ foldl (\s spec -> A.Spec m spec s) (A.Several m (map (A.OnlyP m) (first ++ second))) specs
     doProcess p = doGeneric p
 

fco2/TODO

@@ -38,15 +38,6 @@ Output item expressions should be pulled up to variables.
 
 RETYPES of expressions should be converted to RETYPES of variables.
 
-Pulling up won't work correctly for things like:
-  IF i = 0 FOR 5
-    some.func (i)
-      ...
-This will require some thought (and probably some AST changes to insert an
-artifical place to pull up to -- perhaps just a more flexible Specification
-type).
-How about having a slot for "process, then" in Structured?
-
 Before code generation, have a pass that resolves all the DATA TYPE .. IS
 directives to their real types.
 

fco2/Unnest.hs

@@ -19,14 +19,13 @@ unnest = runPasses passes
     passes =
       [ ("Convert free names to arguments", removeFreeNames)
       , ("Pull nested definitions to top level", removeNesting)
-      , ("Clean up removed specifications", removeNoSpecs)
       ]
 
 type NameMap = Map.Map String A.Name
 
 -- | Get the set of free names within a block of code.
 freeNamesIn :: Data t => t -> NameMap
-freeNamesIn = doGeneric `extQ` doName `extQ` doProcess `extQ` doStructured `extQ` doValueProcess `extQ` doSpecType
+freeNamesIn = doGeneric `extQ` doName `extQ` doStructured `extQ` doSpecType
   where
     doGeneric :: Data t => t -> NameMap
     doGeneric n = Map.unions $ gmapQ freeNamesIn n
@@ -34,21 +33,11 @@ freeNamesIn = doGeneric `extQ` doName `extQ` doProcess `extQ` doStructured `extQ
     doName :: A.Name -> NameMap
     doName n = Map.singleton (A.nameName n) n
 
-    doProcess :: A.Process -> NameMap
-    doProcess (A.ProcSpec _ spec p) = doSpec spec p
-    doProcess (A.SeqRep _ rep p) = doRep rep p
-    doProcess (A.ParRep _ _ rep p) = doRep rep p
-    doProcess p = doGeneric p
-
     doStructured :: A.Structured -> NameMap
     doStructured (A.Rep _ rep s) = doRep rep s
     doStructured (A.Spec _ spec s) = doSpec spec s
     doStructured s = doGeneric s
 
-    doValueProcess :: A.ValueProcess -> NameMap
-    doValueProcess (A.ValOfSpec _ spec vp) = doSpec spec vp
-    doValueProcess vp = doGeneric vp
-
     doSpec :: Data t => A.Specification -> t -> NameMap
     doSpec (A.Specification _ n st) child
         = Map.union fns $ Map.delete (A.nameName n) $ freeNamesIn child
@@ -156,22 +145,24 @@ removeFreeNames = doGeneric `extM` doSpecification `extM` doProcess
 removeNesting :: A.Process -> PassM A.Process
 removeNesting p
     =  do p' <- pullSpecs p
-          applyPulled p'
+          s <- applyPulled $ A.OnlyP emptyMeta p'
+          return $ A.Seq emptyMeta s
   where
     pullSpecs :: Data t => t -> PassM t
-    pullSpecs = doGeneric `extM` doSpecification
+    pullSpecs = doGeneric `extM` doStructured
 
     doGeneric :: Data t => t -> PassM t
     doGeneric = gmapM pullSpecs
 
-    doSpecification :: A.Specification -> PassM A.Specification
+    doStructured :: A.Structured -> PassM A.Structured
-    doSpecification spec@(A.Specification m n st)
+    doStructured s@(A.Spec m spec@(A.Specification _ n st) subS)
         = do isConst <- isConstantName n
              if isConst || canPull st then
                  do spec' <- doGeneric spec
-                    addPulled $ A.ProcSpec m spec'
+                    addPulled $ A.Spec m spec'
-                    return A.NoSpecification
+                    return subS
-               else doGeneric spec
+               else doGeneric s
+    doStructured s = doGeneric s
 
     canPull :: A.SpecType -> Bool
     canPull (A.Proc _ _ _) = True
@@ -181,21 +172,3 @@ removeNesting p
     canPull (A.ProtocolCase _ _) = True
     canPull _ = False
 
--- | Remove specifications that have been turned into NoSpecifications.
-removeNoSpecs :: Data t => t -> PassM t
-removeNoSpecs = doGeneric `extM` doProcess `extM` doStructured `extM` doValueProcess
-  where
-    doGeneric :: Data t => t -> PassM t
-    doGeneric n = gmapM removeNoSpecs n
-
-    doProcess :: A.Process -> PassM A.Process
-    doProcess (A.ProcSpec _ A.NoSpecification p) = removeNoSpecs p
-    doProcess p = doGeneric p
-
-    doStructured :: A.Structured -> PassM A.Structured
-    doStructured (A.Spec _ A.NoSpecification s) = removeNoSpecs s
-    doStructured s = doGeneric s
-
-    doValueProcess :: A.ValueProcess -> PassM A.ValueProcess
-    doValueProcess (A.ValOfSpec _ A.NoSpecification vp) = removeNoSpecs vp
-    doValueProcess vp = doGeneric vp

fco2/testcases/ptp-rep.occ

@@ -0,0 +1,16 @@
+-- From cgtest00.
+
+PROC S19 ()
+  INT X:
+  SEQ
+    X := 42
+    [4]INT V:
+    [3]CHAN OF INT c:
+    PAR
+      PAR i = 0 FOR 3
+        c[i] ! (i + 5)
+      X := X
+      PAR i = 0 FOR 3
+        c[i] ? V[i]
+:
+