diff --git a/fco2/GenerateC.hs b/fco2/GenerateC.hs index f05a5e5..8d68bd5 100644 --- a/fco2/GenerateC.hs +++ b/fco2/GenerateC.hs @@ -1,6 +1,12 @@ -- | Generate C++ code from the mangled AST. module GenerateC where +-- FIXME: Use AbbrevMode to track whether something is an abbreviation at all +-- (and hence make it a pointer or not -- so we can go to C proper). + +-- FIXME: Use Structured for Par and Seq (and ValOf, etc.). This would make it +-- easier to put {} around sets of declarations. + -- FIXME: Checks should be done in the parser, not here -- for example, the -- expressionList production should take an argument with a list of types. diff --git a/fco2/ParseState.hs b/fco2/ParseState.hs index 96e943a..cb3ea7b 100644 --- a/fco2/ParseState.hs +++ b/fco2/ParseState.hs @@ -5,6 +5,7 @@ import Data.Generics import Control.Monad.State import qualified AST as A +import Metadata -- FIXME This is a rather inappropriate name now... -- | State necessary for compilation. @@ -12,7 +13,8 @@ data ParseState = ParseState { psLocalNames :: [(String, A.Name)], psNames :: [(String, A.NameDef)], psNameCounter :: Int, - psNonceCounter :: Int + psNonceCounter :: Int, + psPulledSpecs :: [(Meta, A.Specification)] } deriving (Show, Eq, Typeable, Data) @@ -21,7 +23,8 @@ emptyState = ParseState { psLocalNames = [], psNames = [], psNameCounter = 0, - psNonceCounter = 0 + psNonceCounter = 0, + psPulledSpecs = [] } -- | Add the definition of a name. diff --git a/fco2/Unnest.hs b/fco2/Unnest.hs index 2186448..1ca07ad 100644 --- a/fco2/Unnest.hs +++ b/fco2/Unnest.hs @@ -158,7 +158,6 @@ removeFreeNames = doGeneric `extM` doProcess `extM` doStructured `extM` doValueP let newAs = [case A.nameType n of A.ChannelName -> A.ActualChannel (A.Channel m n) A.VariableName -> A.ActualExpression (A.ExprVariable m (A.Variable m n)) - _ -> error $ "not handled: " ++ show n | (t, n) <- zip types freeNames] child' <- removeFreeNames (addToCalls n newAs child) return (spec', child') @@ -168,18 +167,41 @@ removeFreeNames = doGeneric `extM` doProcess `extM` doStructured `extM` doValueP return (spec', child') -- | Pull nested declarations to the top level. -removeNesting :: Data t => t -> UnM t -removeNesting = doGeneric `extM` doProcess `extM` doStructured `extM` doValueProcess +removeNesting :: A.Process -> UnM A.Process +removeNesting p + = do p' <- pullSpecs p + st <- get + let pulled = psPulledSpecs st + put $ st { psPulledSpecs = [] } + return $ foldl (\p (m, spec) -> A.ProcSpec m spec p) p' pulled where + pullSpecs :: Data t => t -> UnM t + pullSpecs = doGeneric `extM` doProcess `extM` doStructured `extM` doValueProcess + doGeneric :: Data t => t -> UnM t - doGeneric = gmapM removeNesting + doGeneric = gmapM pullSpecs doProcess :: A.Process -> UnM A.Process + doProcess orig@(A.ProcSpec m spec p) = doSpec orig m spec p doProcess p = doGeneric p doStructured :: A.Structured -> UnM A.Structured + doStructured orig@(A.Spec m spec s) = doSpec orig m spec s doStructured s = doGeneric s doValueProcess :: A.ValueProcess -> UnM A.ValueProcess + doValueProcess orig@(A.ValOfSpec m spec vp) = doSpec orig m spec vp doValueProcess vp = doGeneric vp + doSpec :: Data t => t -> Meta -> A.Specification -> t -> UnM t + doSpec orig m spec@(_, st) child + = if canPull st then + do spec' <- pullSpecs spec + modify $ (\ps -> ps { psPulledSpecs = (m, spec') : psPulledSpecs ps }) + child' <- pullSpecs child + return child' + else doGeneric orig + + canPull :: A.SpecType -> Bool + canPull (A.Proc _ _ _) = True + canPull _ = False