diff --git a/fco2/GenerateC.hs b/fco2/GenerateC.hs index 758eda5..a045cfc 100644 --- a/fco2/GenerateC.hs +++ b/fco2/GenerateC.hs @@ -17,9 +17,7 @@ module GenerateC where -- FIXME: Should have a pass that converts functions to procs, and calls to a -- call outside the enclosing process (which can be found by a generic pass -- over the tree). --- Array constants need pulling up at the same time (might as well avoid --- walking the tree twice!). --- And slices. Subscripts generally? +-- And array subscripts also. -- FIXME: The timer read mess can be cleaned up -- when you declare a timer, -- that declares the temp variable... @@ -69,7 +67,7 @@ withPS f = do st <- get return $ f st -checkJust :: Maybe t -> CGen t +checkJust :: Monad m => Maybe t -> m t checkJust (Just v) = return v checkJust Nothing = fail "checkJust failed" @@ -483,7 +481,7 @@ CHAN OF INT c IS d: Channel *c = d; for (...) { cs[i] = &tmp[i]; ChanInit(cs[i]); } const int cs_sizes[] = { 10 }; []CHAN OF INT ds IS cs: Channel **ds = cs; - const int ds_sizes[] = cs_sizes; + const int *ds_sizes = cs_sizes; -} introduceSpec :: A.Specification -> CGen () introduceSpec (n, A.Declaration m t) @@ -545,9 +543,9 @@ introduceSpec (n, A.Is m am t v) tell [";\n"] case rhsSizes of Just r -> - do tell ["const int "] + do tell ["const int *"] genName n - tell ["_sizes[] = "] + tell ["_sizes = "] r tell [";\n"] Nothing -> return () diff --git a/fco2/Main.hs b/fco2/Main.hs index 969758e..9bc6aea 100644 --- a/fco2/Main.hs +++ b/fco2/Main.hs @@ -67,7 +67,7 @@ main = do if ParseOnly `elem` opts then putStrLn $ show ast else do - (ast', state') <- runPass (runPasses passes) ast state + (ast', state') <- runPass (runPasses progress passes) ast state progress "{{{ Generate C" c <- generateC state' ast' diff --git a/fco2/ParseState.hs b/fco2/ParseState.hs index 27ab4bb..35f12d5 100644 --- a/fco2/ParseState.hs +++ b/fco2/ParseState.hs @@ -59,3 +59,30 @@ applyPulled ast let ast' = foldl (\p f -> f p) ast (psPulledItems ps) put $ ps { psPulledItems = [] } return ast' + +-- | Generate and define a nonce specification. +defineNonce :: MonadState ParseState m => Meta -> String -> A.SpecType -> A.NameType -> A.AbbrevMode -> m A.Specification +defineNonce m s st nt am + = do ns <- makeNonce s + let n = A.Name m A.ProcName ns + let nd = A.NameDef { + A.ndMeta = m, + A.ndName = ns, + A.ndOrigName = ns, + A.ndNameType = nt, + A.ndType = st, + A.ndAbbrevMode = am + } + modify $ psDefineName n nd + return (n, st) + +-- | Generate and define a no-arg wrapper PROC around a process. +makeNonceProc :: MonadState ParseState m => Meta -> A.Process -> m A.Specification +makeNonceProc m p + = defineNonce m "wrapper_proc" (A.Proc m [] p) A.ProcName A.Abbrev + +-- | Generate and define a VAL abbreviation. +makeNonceValIs :: MonadState ParseState m => Meta -> A.Type -> A.Expression -> m A.Specification +makeNonceValIs m t e + = defineNonce m "expr" (A.IsExpr m A.ValAbbrev t e) A.VariableName A.ValAbbrev + diff --git a/fco2/Pass.hs b/fco2/Pass.hs index 7480831..baccf81 100644 --- a/fco2/Pass.hs +++ b/fco2/Pass.hs @@ -13,12 +13,12 @@ type Pass = A.Process -> PassM A.Process runPass :: Pass -> A.Process -> ParseState -> IO (A.Process, ParseState) runPass pass ast st = runStateT (pass ast) st -runPasses :: [(String, Pass)] -> A.Process -> PassM A.Process -runPasses [] ast = return ast -runPasses ((s, p):ps) ast - = do liftIO $ putStrLn $ "{{{ " ++ s +runPasses :: (String -> IO ()) -> [(String, Pass)] -> A.Process -> PassM A.Process +runPasses _ [] ast = return ast +runPasses progress ((s, p):ps) ast + = do liftIO $ progress $ "{{{ " ++ s ast' <- p ast - liftIO $ putStrLn $ "}}}" - ast'' <- runPasses ps ast' + liftIO $ progress $ "}}}" + ast'' <- runPasses progress ps ast' return ast'' diff --git a/fco2/SimplifyExprs.hs b/fco2/SimplifyExprs.hs index 5157931..6d3e661 100644 --- a/fco2/SimplifyExprs.hs +++ b/fco2/SimplifyExprs.hs @@ -3,6 +3,7 @@ module SimplifyExprs (simplifyExprs) where import Control.Monad.State import Data.Generics +import Data.Maybe import qualified AST as A import Metadata @@ -13,15 +14,45 @@ import Pass simplifyExprs :: A.Process -> PassM A.Process simplifyExprs = pullUp +-- | Find things that need to be moved up to their enclosing process, and do +-- so. pullUp :: Data t => t -> PassM t -pullUp = doGeneric `extM` doProcess +pullUp = doGeneric `extM` doProcess `extM` doExpression 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 - = do p' <- doGeneric p - liftIO $ putStrLn $ "looking at process" + = do -- Save the pulled items + origPS <- get + modify (\ps -> ps { psPulledItems = [] }) + -- Recurse over the process, then apply the pulled items to it + p' <- doGeneric p >>= applyPulled + -- ... and restore the original pulled items + modify (\ps -> ps { psPulledItems = psPulledItems origPS }) return p' + -- | Pull array expressions that aren't already variables. + doExpression :: A.Expression -> PassM A.Expression + doExpression e + = do e' <- doGeneric e + ps <- get + let t = fromJust $ typeOfExpression ps e' + case t of + A.Array _ _ -> + case e of + A.ExprVariable _ _ -> return e' + _ -> pull t e' + _ -> return e' + where + pull :: A.Type -> A.Expression -> PassM A.Expression + pull t e + = do -- FIXME Should get Meta from somewhere... + let m = [] + spec@(n, _) <- makeNonceValIs m t e + addPulled $ A.ProcSpec m spec + return $ A.ExprVariable m (A.Variable m n) + diff --git a/fco2/Types.hs b/fco2/Types.hs index b137438..0805a15 100644 --- a/fco2/Types.hs +++ b/fco2/Types.hs @@ -3,6 +3,9 @@ module Types where -- FIXME: This module is a mess -- sort it and document the functions. +-- FIXME: These functions should have state-monadic versions. +-- It'd be nice if we could provide an instance of StateMonad for the Parsec state... + import Control.Monad import qualified AST as A diff --git a/fco2/Unnest.hs b/fco2/Unnest.hs index f1ab774..5de2348 100644 --- a/fco2/Unnest.hs +++ b/fco2/Unnest.hs @@ -15,23 +15,6 @@ import Pass unnest :: A.Process -> PassM A.Process unnest p = parsToProcs p >>= removeFreeNames >>= removeNesting --- | Generate and define a no-arg wrapper PROC around a process. -makeNonceProc :: Meta -> A.Process -> PassM A.Specification -makeNonceProc m p - = do ns <- makeNonce "wrapper_proc" - let n = A.Name m A.ProcName ns - let st = A.Proc m [] p - let nd = A.NameDef { - A.ndMeta = m, - A.ndName = ns, - A.ndOrigName = ns, - A.ndNameType = A.ProcName, - A.ndType = st, - A.ndAbbrevMode = A.Abbrev - } - modify $ psDefineName n nd - return (n, st) - -- | Wrap the subprocesses of PARs in no-arg PROCs. parsToProcs :: Data t => t -> PassM t parsToProcs = doGeneric `extM` doProcess