diff --git a/fco2/AST.hs b/fco2/AST.hs index e6fcfd6..a12df66 100644 --- a/fco2/AST.hs +++ b/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 - | OnlyC Meta Choice - | OnlyO Meta Option - | OnlyA Meta Alternative + | ProcThen Meta Process Structured + | OnlyV Meta Variant -- ^ Variant (CASE) input process + | OnlyC Meta Choice -- ^ IF process + | 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] - | SeqRep Meta Replicator Process + | Seq Meta Structured | If Meta Structured | Case Meta Expression Structured | While Meta Expression Process - | Par Meta ParMode [Process] - | ParRep Meta ParMode Replicator Process + | Par Meta ParMode Structured | Processor Meta Expression Process | Alt Meta Bool Structured | ProcCall Meta Name [Actual] diff --git a/fco2/GenerateC.hs b/fco2/GenerateC.hs index d2be734..94ab38f 100644 --- a/fco2/GenerateC.hs +++ b/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.SeqRep m r p -> genReplicator r (genProcess p) + A.Seq _ s -> genSeqBody s 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.ParRep m pm r p -> genParRep pm r p - A.Processor m e p -> missing "PROCESSOR not supported" + A.Par m pm s -> genParBody pm s + -- PROCESSOR does nothing special. + 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 () -genPar pm ps - = do pids <- mapM (\_ -> makeNonce "pid") ps - sequence_ $ [do tell ["Process *", pid, " = "] - genProcAlloc p - tell [";\n"] - | (pid, p) <- (zip pids ps)] +-- FIXME: This is a bit odd because it'll only generate the two forms of the +-- AST resulting from regular and replicated PARs. It'd probably be better to +-- make it deal with a general Structured PAR. + +genParBody :: A.ParMode -> A.Structured -> CGen () +genParBody pm (A.Spec _ spec s) = genSpec spec (genParBody pm s) +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 pm rep p +genParRep :: A.ParMode -> A.Replicator -> A.Structured -> CGen () +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, "++] = "] - genProcAlloc p - tell [";\n"] + genReplicator rep $ genParProc (\p -> do tell [pids, "[", index, "++] = "] + genProcAlloc p + 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 () diff --git a/fco2/Parse.hs b/fco2/Parse.hs index 33f1238..1d6b5bc 100644 --- a/fco2/Parse.hs +++ b/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 - <|> handleSpecs specification (valueProcess rs) A.ValOfSpec + return $ A.ProcThen m p (A.OnlyEL m el) + <|> 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 { r <- replicator; eol; indent; r' <- scopeInRep r; p <- process; scopeOutRep r'; outdent; return $ A.SeqRep m r' p } + 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.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 { r <- replicator; eol; indent; r' <- scopeInRep r; p <- process; scopeOutRep r'; outdent; return $ A.ParRep m isPri r' p } - <|> placedpar + 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.Par m isPri (A.Rep m r' (A.OnlyP m p)) } + <|> 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 -placedpar +processor :: OccParser A.Process +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. diff --git a/fco2/ParseState.hs b/fco2/ParseState.hs index 25658c8..c30d142 100644 --- a/fco2/ParseState.hs +++ b/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 - show p = "(function on A.Process)" +instance Show (A.Structured -> A.Structured) where + 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. -applyPulled :: PSM m => A.Process -> m A.Process +-- | Apply pulled items to a Structured. +applyPulled :: PSM m => A.Structured -> m A.Structured applyPulled ast = do ps <- get let ast' = foldl (\p f -> f p) ast (psPulledItems ps) diff --git a/fco2/SimplifyExprs.hs b/fco2/SimplifyExprs.hs index 2078275..aea1146 100644 --- a/fco2/SimplifyExprs.hs +++ b/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 - vpToProc (A.ValOfSpec m s vp) vs = A.ProcSpec m s (vpToProc vp vs) - vpToProc (A.ValOf m p el) vs = A.Seq m [p, A.Assign m vs el] + vpToSeq :: A.Structured -> [A.Variable] -> A.Structured + vpToSeq (A.Spec m spec s) vs = A.Spec m spec (vpToSeq s vs) + 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 - doProcess p + doStructured :: A.Structured -> PassM A.Structured + 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 - p' <- doGeneric p >>= applyPulled + -- Recurse over the body, then apply the pulled items to it + s' <- doGeneric s >>= applyPulled -- ... and restore the original pulled items - modify (\ps -> ps { psPulledItems = psPulledItems origPS }) - return p' + modify (\ps -> ps { psPulledItems = origPulled }) + 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 diff --git a/fco2/SimplifyProcs.hs b/fco2/SimplifyProcs.hs index b9d2a83..e9b5b12 100644 --- a/fco2/SimplifyProcs.hs +++ b/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) - = do ps' <- mapM parsToProcs ps - procs <- mapM (makeNonceProc m) ps' - 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 (A.Par m pm s) + = do s' <- doStructured s + return $ A.Par m pm s' 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 diff --git a/fco2/TODO b/fco2/TODO index cb5e1d2..21a710a 100644 --- a/fco2/TODO +++ b/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. diff --git a/fco2/Unnest.hs b/fco2/Unnest.hs index 6292fb7..d5910d5 100644 --- a/fco2/Unnest.hs +++ b/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 - doSpecification spec@(A.Specification m n st) + doStructured :: A.Structured -> PassM A.Structured + 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' - return A.NoSpecification - else doGeneric spec + addPulled $ A.Spec m spec' + return subS + 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 diff --git a/fco2/testcases/ptp-rep.occ b/fco2/testcases/ptp-rep.occ new file mode 100644 index 0000000..aa47208 --- /dev/null +++ b/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] +: +