suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Adam Sampson 2007-04-27 21:49:34 +00:00
parent 5e32facc59
commit 2bcdd7cd66
9 changed files with 144 additions and 143 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
fco2/AST.hs
View File

@ -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]

66
fco2/GenerateC.hs
View File

@ -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 ()

33
fco2/Parse.hs
View File

@ -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.

12
fco2/ParseState.hs
View File

@ -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)

37
fco2/SimplifyExprs.hs
View File

@ -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

39
fco2/SimplifyProcs.hs
View File

@ -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

9
fco2/TODO
View File

@ -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.

47
fco2/Unnest.hs
View File

@ -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

16
fco2/testcases/ptp-rep.occ Normal file
View File

@ -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]
: