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