diff --git a/AST.hs b/AST.hs
index 894ced4..2a9aeb0 100644
--- a/AST.hs
+++ b/AST.hs
@@ -54,6 +54,9 @@ instance Show Name where
instance Eq Name where
(==) a b = nameName a == nameName b
+instance Ord Name where
+ compare a b = compare (nameName a) (nameName b)
+
-- | The definition of a name.
data NameDef = NameDef {
-- | Metadata.
diff --git a/CompState.hs b/CompState.hs
index e1081ec..02fcac9 100644
--- a/CompState.hs
+++ b/CompState.hs
@@ -22,6 +22,7 @@ module CompState where
import Data.Generics
import Data.Map (Map)
import qualified Data.Map as Map
+import Data.Set (Set)
import qualified Data.Set as Set
import Control.Monad.State
@@ -52,7 +53,7 @@ data CompState = CompState {
-- Set by preprocessor
csCurrentFile :: String,
- csUsedFiles :: Set.Set String,
+ csUsedFiles :: Set String,
-- Set by Parse
csLocalNames :: [(String, A.Name)],
@@ -69,9 +70,7 @@ data CompState = CompState {
csFunctionReturns :: Map String [A.Type],
csPulledItems :: [[A.Structured -> A.Structured]],
csAdditionalArgs :: Map String [A.Actual],
-
- -- Set by code generators
- csGeneratedDefs :: [String]
+ csParProcs :: Set A.Name
}
deriving (Show, Data, Typeable)
@@ -102,8 +101,7 @@ emptyState = CompState {
csFunctionReturns = Map.empty,
csPulledItems = [],
csAdditionalArgs = Map.empty,
-
- csGeneratedDefs = []
+ csParProcs = Set.empty
}
-- | Class of monads which keep a CompState.
@@ -168,19 +166,6 @@ applyPulled ast
return $ foldl (\p f -> f p) ast l
--}}}
---{{{ generated definitions
--- | Add a generated definition to the collection.
-addGeneratedDef :: CSM m => String -> m ()
-addGeneratedDef s = modify (\ps -> ps { csGeneratedDefs = s : csGeneratedDefs ps })
-
--- | Get and clear the collection of generated definitions.
-getGeneratedDefs :: CSM m => m [String]
-getGeneratedDefs
- = do ps <- get
- put $ ps { csGeneratedDefs = [] }
- return $ csGeneratedDefs ps
---}}}
-
--{{{ type contexts
-- | Enter a type context.
pushTypeContext :: CSM m => Maybe A.Type -> m ()
diff --git a/GenerateC.hs b/GenerateC.hs
index ee7b568..1fdbd09 100644
--- a/GenerateC.hs
+++ b/GenerateC.hs
@@ -20,8 +20,10 @@ with this program. If not, see .
module GenerateC where
import Data.Char
+import Data.Generics
import Data.List
import Data.Maybe
+import qualified Data.Set as Set
import Control.Monad.Writer
import Control.Monad.Error
import Control.Monad.State
@@ -39,6 +41,29 @@ import TLP
import Types
import Utils
+--{{{ passes related to C generation
+genCPasses :: [(String, Pass)]
+genCPasses =
+ [ ("Identify parallel processes", identifyParProcs)
+ ]
+
+-- | Identify processes that we'll need to compute the stack size of.
+identifyParProcs :: Pass
+identifyParProcs = everywhereM (mkM doProcess)
+ where
+ doProcess :: A.Process -> PassM A.Process
+ doProcess p@(A.Par _ _ s) = findProcs s >> return p
+ doProcess p = return p
+
+ findProcs :: A.Structured -> PassM ()
+ findProcs (A.Rep _ _ s) = findProcs s
+ findProcs (A.Spec _ _ s) = findProcs s
+ findProcs (A.ProcThen _ _ s) = findProcs s
+ findProcs (A.Several _ ss) = sequence_ $ map findProcs ss
+ findProcs (A.OnlyP _ (A.ProcCall _ n _))
+ = modify (\cs -> cs { csParProcs = Set.insert n (csParProcs cs) })
+--}}}
+
--{{{ monad definition
type CGen = WriterT [String] PassM
@@ -216,15 +241,13 @@ cgenOps = GenOps {
--}}}
--{{{ top-level
-generate :: GenOps -> String -> A.Process -> PassM String
-generate ops headerFileName ast
- = do (a, w) <- runWriterT (call genTopLevel ops ast)
- gds <- getGeneratedDefs
- let out = ["#include ",headerFileName,"\n"] ++ gds ++ w
+generate :: GenOps -> A.Process -> PassM String
+generate ops ast
+ = do (a, out) <- runWriterT (call genTopLevel ops ast)
return $ concat out
generateC :: A.Process -> PassM String
-generateC = generate cgenOps ""
+generateC = generate cgenOps
cgenTLPChannel :: GenOps -> TLPChannel -> CGen ()
cgenTLPChannel _ TLPIn = tell ["in"]
@@ -233,7 +256,11 @@ cgenTLPChannel _ TLPError = tell ["err"]
cgenTopLevel :: GenOps -> A.Process -> CGen ()
cgenTopLevel ops p
- = do call genProcess ops p
+ = do tell ["#include \n"]
+ cs <- get
+ tell ["extern int " ++ nameString n ++ "_stack_size;\n"
+ | n <- Set.toList $ csParProcs cs]
+ call genProcess ops p
(name, chans) <- tlpInterface
tell ["void tock_main (Process *me, Channel *in, Channel *out, Channel *err) {\n"]
genName name
@@ -1638,7 +1665,6 @@ cgenPar ops pm s
= do tell ["ProcAlloc ("]
genName n
let stackSize = nameString n ++ "_stack_size"
- addGeneratedDef $ "extern int " ++ stackSize ++ ";\n"
tell [", ", stackSize, ", ", show $ numCArgs as]
call genActuals ops as
tell [")"]
diff --git a/GenerateCPPCSP.hs b/GenerateCPPCSP.hs
index 8e6eb14..60d6066 100644
--- a/GenerateCPPCSP.hs
+++ b/GenerateCPPCSP.hs
@@ -131,11 +131,12 @@ In occam-pi I could possibly use the channel-ends properly, but in occam 2.1 I h
--{{{ top-level
generateCPPCSP :: A.Process -> PassM String
-generateCPPCSP = generate cppgenOps ""
+generateCPPCSP = generate cppgenOps
cppgenTopLevel :: GenOps -> A.Process -> CGen ()
cppgenTopLevel ops p
- = do call genProcess ops p
+ = do tell ["#include \n"]
+ call genProcess ops p
(name, chans) <- tlpInterface
tell ["int main (int argc, char** argv) { csp::Start_CPPCSP();"]
tell ["csp::One2OneChannel in,out,err;"] --TODO add streamreader
diff --git a/Main.hs b/Main.hs
index 270f223..737e2ef 100644
--- a/Main.hs
+++ b/Main.hs
@@ -163,6 +163,9 @@ compile fn
, if csFrontend optsPS == FrontendRain
then rainPasses
else []
+ , if csBackend optsPS == BackendC
+ then genCPasses
+ else []
]
ast2 <- runPasses passes ast1