Pull up array expressions

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

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'

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
+

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

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

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

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