suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Added code to put static before every identifier that is not being exported, to avoid collisions between occam files

Browse Source
This commit is contained in:
Neil Brown 2009-04-01 19:50:15 +00:00
parent c85dc01842
commit e28bff5a50
3 changed files with 97 additions and 77 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

133
backends/GenerateC.hs
View File

@ -33,6 +33,7 @@ module GenerateC
, genMeta , genMeta
, genName , genName
, genRightB , genRightB
, genStatic
, justOnly , justOnly
, withIf , withIf
) where ) where
@ -189,7 +190,7 @@ cgenTopLevel headerName s
sequence_ [tell ["extern void ", mungeExternalName n, "(int*);"] sequence_ [tell ["extern void ", mungeExternalName n, "(int*);"]
| (n, fs) <- csExternals cs] | (n, fs) <- csExternals cs]
call genStructured s (\m _ -> tell ["\n#error Invalid top-level item: ", show m]) call genStructured TopLevel s (\m _ -> tell ["\n#error Invalid top-level item: ", show m])
when (csHasMain cs) $ do when (csHasMain cs) $ do
(tlpName, tlpChans) <- tlpInterface (tlpName, tlpChans) <- tlpInterface
@ -301,12 +302,12 @@ cgenOverArray m var func
Nothing -> return () Nothing -> return ()
-- | Generate code for one of the Structured types. -- | Generate code for one of the Structured types.
cgenStructured :: Data a => A.Structured a -> (Meta -> a -> CGen b) -> CGen [b] cgenStructured :: Data a => Level -> A.Structured a -> (Meta -> a -> CGen b) -> CGen [b]
cgenStructured (A.Spec _ spec s) def = call genSpec spec (call genStructured s def) cgenStructured lvl (A.Spec _ spec s) def = call genSpec lvl spec (call genStructured lvl s def)
cgenStructured (A.ProcThen _ p s) def = call genProcess p >> call genStructured s def cgenStructured lvl (A.ProcThen _ p s) def = call genProcess p >> call genStructured lvl s def
cgenStructured (A.Several _ ss) def cgenStructured lvl (A.Several _ ss) def
= sequence [call genStructured s def | s <- ss] >>* concat = sequence [call genStructured lvl s def | s <- ss] >>* concat
cgenStructured (A.Only m s) def = def m s >>* singleton cgenStructured _ (A.Only m s) def = def m s >>* singleton
--}}} --}}}
@ -411,10 +412,18 @@ cgenBytesIn m t v
--}}} --}}}
genStatic :: Level -> A.Name -> CGen ()
genStatic NotTopLevel _ = return ()
genStatic TopLevel n
= do cs <- getCompState
when (A.nameName n `notElem` csOriginalTopLevelProcs cs) $
tell ["static "]
--{{{ declarations --{{{ declarations
cgenDecl :: A.AbbrevMode -> A.Type -> A.Name -> CGen () cgenDecl :: Level -> A.AbbrevMode -> A.Type -> A.Name -> CGen ()
cgenDecl am t n cgenDecl lvl am t n
= do genCType (A.nameMeta n) t am = do genStatic lvl n
genCType (A.nameMeta n) t am
tell [" "] tell [" "]
genName n genName n
--}}} --}}}
@ -1203,17 +1212,18 @@ abbrevExpression am _ e = call genExpression e
--}}} --}}}
--{{{ specifications --{{{ specifications
cgenSpec :: A.Specification -> CGen b -> CGen b cgenSpec :: Level -> A.Specification -> CGen b -> CGen b
cgenSpec spec body cgenSpec lvl spec body
= do call introduceSpec spec = do call introduceSpec lvl spec
x <- body x <- body
call removeSpec spec call removeSpec spec
return x return x
-- | Generate a declaration of a new variable. -- | Generate a declaration of a new variable.
cgenDeclaration :: A.Type -> A.Name -> Bool -> CGen () cgenDeclaration :: Level -> A.Type -> A.Name -> Bool -> CGen ()
cgenDeclaration at@(A.Array ds t) n False cgenDeclaration lvl at@(A.Array ds t) n False
= do genType t = do genStatic lvl n
genType t
tell [" "] tell [" "]
case t of case t of
A.Chan _ _ -> A.Chan _ _ ->
@ -1227,14 +1237,16 @@ cgenDeclaration at@(A.Array ds t) n False
call genArrayStoreName n call genArrayStoreName n
call genFlatArraySize ds call genFlatArraySize ds
tell [";"] tell [";"]
cgenDeclaration (A.Array ds t) n True cgenDeclaration lvl (A.Array ds t) n True
= do genType t = do genStatic lvl n
genType t
tell [" "] tell [" "]
call genArrayStoreName n call genArrayStoreName n
call genFlatArraySize ds call genFlatArraySize ds
tell [";"] tell [";"]
cgenDeclaration t n _ cgenDeclaration lvl t n _
= do genType t = do genStatic lvl n
genType t
tell [" "] tell [" "]
genName n genName n
tell [";"] tell [";"]
@ -1318,26 +1330,27 @@ CHAN OF INT c IS d: Channel *c = d;
[]CHAN OF INT ds IS cs: Channel **ds = cs; []CHAN OF INT ds IS cs: Channel **ds = cs;
const int *ds_sizes = cs_sizes; const int *ds_sizes = cs_sizes;
-} -}
cintroduceSpec :: A.Specification -> CGen () cintroduceSpec :: Level -> A.Specification -> CGen ()
cintroduceSpec (A.Specification m n (A.Declaration _ t)) cintroduceSpec lvl (A.Specification m n (A.Declaration _ t))
= do call genDeclaration t n False = do call genDeclaration lvl t n False
fdeclareInit <- fget declareInit fdeclareInit <- fget declareInit
case fdeclareInit m t (A.Variable m n) of case fdeclareInit m t (A.Variable m n) of
Just p -> p Just p -> p
Nothing -> return () Nothing -> return ()
cintroduceSpec (A.Specification _ n (A.Is _ am t (A.ActualVariable v))) cintroduceSpec lvl (A.Specification _ n (A.Is _ am t (A.ActualVariable v)))
= do let rhs = call genVariable v am = do let rhs = call genVariable v am
call genDecl am t n call genDecl lvl am t n
tell ["="] tell ["="]
rhs rhs
tell [";"] tell [";"]
cintroduceSpec (A.Specification _ n (A.Is _ am t (A.ActualExpression e))) cintroduceSpec lvl (A.Specification _ n (A.Is _ am t (A.ActualExpression e)))
= do let rhs = abbrevExpression am t e = do let rhs = abbrevExpression am t e
case (am, t, e) of case (am, t, e) of
(A.ValAbbrev, A.Array _ ts, A.Literal _ _ _) -> (A.ValAbbrev, A.Array _ ts, A.Literal _ _ _) ->
-- For "VAL []T a IS [vs]:", we have to use [] rather than * in the -- For "VAL []T a IS [vs]:", we have to use [] rather than * in the
-- declaration, since you can't say "int *foo = {vs};" in C. -- declaration, since you can't say "int *foo = {vs};" in C.
do tell ["const "] do genStatic lvl n
tell ["const "]
genType ts genType ts
tell [" "] tell [" "]
genName n genName n
@ -1348,20 +1361,22 @@ cintroduceSpec (A.Specification _ n (A.Is _ am t (A.ActualExpression e)))
-- Record literals are even trickier, because there's no way of -- Record literals are even trickier, because there's no way of
-- directly writing a struct literal in C that you can use -> on. -- directly writing a struct literal in C that you can use -> on.
do tmp <- csmLift $ makeNonce "record_literal" do tmp <- csmLift $ makeNonce "record_literal"
genStatic lvl n
tell ["const "] tell ["const "]
genType t genType t
tell [" ", tmp, " = "] tell [" ", tmp, " = "]
rhs rhs
tell [";\n"] tell [";\n"]
call genDecl am t n call genDecl lvl am t n
tell [" = &", tmp, ";\n"] tell [" = &", tmp, ";\n"]
_ -> _ ->
do call genDecl am t n do call genDecl lvl am t n
tell [" = "] tell [" = "]
rhs rhs
tell [";\n"] tell [";\n"]
cintroduceSpec (A.Specification _ n (A.Is _ _ (A.Array _ c) (A.ActualChannelArray cs))) cintroduceSpec lvl (A.Specification _ n (A.Is _ _ (A.Array _ c) (A.ActualChannelArray cs)))
= do genType c = do genStatic lvl n
genType c
case c of case c of
A.Chan _ _ -> tell ["* "] A.Chan _ _ -> tell ["* "]
-- Channel ends don't need an extra indirection; in C++ they are not -- Channel ends don't need an extra indirection; in C++ they are not
@ -1371,14 +1386,14 @@ cintroduceSpec (A.Specification _ n (A.Is _ _ (A.Array _ c) (A.ActualChannelArra
tell ["[]={"] tell ["[]={"]
seqComma (map (\v -> call genVariable v A.Abbrev) cs) seqComma (map (\v -> call genVariable v A.Abbrev) cs)
tell ["};"] tell ["};"]
cintroduceSpec (A.Specification _ n (A.Is _ _ _ (A.ActualClaim v))) cintroduceSpec lvl (A.Specification _ n (A.Is _ _ _ (A.ActualClaim v)))
= do t <- astTypeOf n = do t <- astTypeOf n
case t of case t of
A.ChanEnd dir _ _ -> do call genDecl A.Original t n A.ChanEnd dir _ _ -> do call genDecl lvl A.Original t n
tell ["=(&(((mt_cb_t*)"] tell ["=(&(((mt_cb_t*)"]
lock dir lock dir
tell [")->channels[0]));"] tell [")->channels[0]));"]
A.ChanDataType dir _ _ -> do call genDecl A.Original t n A.ChanDataType dir _ _ -> do call genDecl lvl A.Original t n
tell ["="] tell ["="]
lock dir lock dir
tell [";"] tell [";"]
@ -1389,12 +1404,13 @@ cintroduceSpec (A.Specification _ n (A.Is _ _ _ (A.ActualClaim v)))
then "MT_CB_CLIENT" then "MT_CB_CLIENT"
else "MT_CB_SERVER" else "MT_CB_SERVER"
,")"] ,")"]
cintroduceSpec (A.Specification _ _ (A.DataType _ _)) = return () cintroduceSpec _ (A.Specification _ _ (A.DataType _ _)) = return ()
cintroduceSpec (A.Specification _ _ (A.RecordType _ _ _)) = return () cintroduceSpec _ (A.Specification _ _ (A.RecordType _ _ _)) = return ()
cintroduceSpec (A.Specification _ _ (A.ChanBundleType {})) = return () cintroduceSpec _ (A.Specification _ _ (A.ChanBundleType {})) = return ()
cintroduceSpec (A.Specification _ n (A.Protocol _ _)) = return () cintroduceSpec _ (A.Specification _ n (A.Protocol _ _)) = return ()
cintroduceSpec (A.Specification _ n (A.ProtocolCase _ ts)) cintroduceSpec lvl (A.Specification _ n (A.ProtocolCase _ ts))
= do tell ["typedef enum{"] = do genStatic lvl n
tell ["typedef enum{"]
seqComma [genName tag >> tell ["_"] >> genName n | (tag, _) <- ts] seqComma [genName tag >> tell ["_"] >> genName n | (tag, _) <- ts]
-- You aren't allowed to have an empty enum. -- You aren't allowed to have an empty enum.
when (ts == []) $ when (ts == []) $
@ -1402,12 +1418,12 @@ cintroduceSpec (A.Specification _ n (A.ProtocolCase _ ts))
tell ["}"] tell ["}"]
genName n genName n
tell [";"] tell [";"]
cintroduceSpec (A.Specification _ n st@(A.Proc _ _ _ _)) cintroduceSpec lvl (A.Specification _ n st@(A.Proc _ _ _ _))
= genProcSpec n st False = genProcSpec lvl n st False
cintroduceSpec (A.Specification _ n (A.Retypes m am t v)) cintroduceSpec lvl (A.Specification _ n (A.Retypes m am t v))
= do origT <- astTypeOf v = do origT <- astTypeOf v
let rhs = call genVariable v A.Abbrev let rhs = call genVariable v A.Abbrev
call genDecl am t n call genDecl lvl am t n
tell ["="] tell ["="]
-- For scalar types that are VAL abbreviations (e.g. VAL INT64), -- For scalar types that are VAL abbreviations (e.g. VAL INT64),
-- we need to dereference the pointer that abbrevVariable gives us. -- we need to dereference the pointer that abbrevVariable gives us.
@ -1426,15 +1442,15 @@ cintroduceSpec (A.Specification _ n (A.Retypes m am t v))
rhs rhs
tell [";"] tell [";"]
call genRetypeSizes m t n origT v call genRetypeSizes m t n origT v
cintroduceSpec (A.Specification _ n (A.Rep m rep)) cintroduceSpec _ (A.Specification _ n (A.Rep m rep))
= call genReplicatorStart n rep = call genReplicatorStart n rep
--cintroduceSpec (A.Specification _ n (A.RetypesExpr _ am t e)) --cintroduceSpec (A.Specification _ n (A.RetypesExpr _ am t e))
cintroduceSpec n = call genMissing $ "introduceSpec " ++ show n cintroduceSpec _ n = call genMissing $ "introduceSpec " ++ show n
cgenRecordTypeSpec :: A.Name -> A.RecordAttr -> [(A.Name, A.Type)] -> CGen () cgenRecordTypeSpec :: A.Name -> A.RecordAttr -> [(A.Name, A.Type)] -> CGen ()
cgenRecordTypeSpec n attr fs cgenRecordTypeSpec n attr fs
= do tell ["typedef struct{"] = do tell ["typedef struct{"]
sequence_ [call genDeclaration t n True | (n, t) <- fs] sequence_ [call genDeclaration NotTopLevel t n True | (n, t) <- fs]
tell ["}"] tell ["}"]
when (A.packedRecord attr || A.mobileRecord attr) $ tell [" occam_struct_packed "] when (A.packedRecord attr || A.mobileRecord attr) $ tell [" occam_struct_packed "]
genName n genName n
@ -1472,7 +1488,7 @@ cgenRecordTypeSpec n attr fs
cgenForwardDeclaration :: A.Specification -> CGen () cgenForwardDeclaration :: A.Specification -> CGen ()
cgenForwardDeclaration (A.Specification _ n st@(A.Proc _ _ _ _)) cgenForwardDeclaration (A.Specification _ n st@(A.Proc _ _ _ _))
= genProcSpec n st True = genProcSpec TopLevel n st True
cgenForwardDeclaration (A.Specification _ n (A.RecordType _ b fs)) cgenForwardDeclaration (A.Specification _ n (A.RecordType _ b fs))
= call genRecordTypeSpec n b fs = call genRecordTypeSpec n b fs
cgenForwardDeclaration _ = return () cgenForwardDeclaration _ = return ()
@ -1557,13 +1573,14 @@ genProcName n
-- calling convention otherwise. If will not munge the name if the process was -- calling convention otherwise. If will not munge the name if the process was
-- one of the original top-level procs, other than to add an occam_ prefix (which -- one of the original top-level procs, other than to add an occam_ prefix (which
-- avoids name collisions). -- avoids name collisions).
genProcSpec :: A.Name -> A.SpecType -> Bool -> CGen () genProcSpec :: Level -> A.Name -> A.SpecType -> Bool -> CGen ()
genProcSpec n (A.Proc _ (sm, rm) fs p) forwardDecl genProcSpec lvl n (A.Proc _ (sm, rm) fs p) forwardDecl
= do cs <- getCompState = do cs <- getCompState
let (header, params) = if n `Set.member` csParProcs cs let (header, params) = if n `Set.member` csParProcs cs
|| rm == A.Recursive || rm == A.Recursive
then (genParHeader, genParParams) then (genParHeader, genParParams)
else (genNormalHeader, return ()) else (genNormalHeader, return ())
genStatic lvl n
header header
if forwardDecl if forwardDecl
then tell [";\n"] then tell [";\n"]
@ -1797,13 +1814,13 @@ cgenStop m s
--}}} --}}}
--{{{ seq --{{{ seq
cgenSeq :: A.Structured A.Process -> CGen () cgenSeq :: A.Structured A.Process -> CGen ()
cgenSeq s = call genStructured s doP >> return () cgenSeq s = call genStructured NotTopLevel s doP >> return ()
where where
doP _ p = call genProcess p doP _ p = call genProcess p
--}}} --}}}
--{{{ if --{{{ if
cgenIf :: Meta -> A.Structured A.Choice -> CGen () cgenIf :: Meta -> A.Structured A.Choice -> CGen ()
cgenIf m s | justOnly s = do call genStructured s doCplain cgenIf m s | justOnly s = do call genStructured NotTopLevel s doCplain
tell ["{"] tell ["{"]
call genStop m "no choice matched in IF process" call genStop m "no choice matched in IF process"
tell ["}"] tell ["}"]
@ -1815,7 +1832,7 @@ cgenIf m s | justOnly s = do call genStructured s doCplain
tell [label, ":;"] tell [label, ":;"]
where where
genIfBody :: String -> A.Structured A.Choice -> CGen () genIfBody :: String -> A.Structured A.Choice -> CGen ()
genIfBody label s = call genStructured s doC >> return () genIfBody label s = call genStructured NotTopLevel s doC >> return ()
where where
doC m (A.Choice m' e p) doC m (A.Choice m' e p)
= do tell ["if("] = do tell ["if("]
@ -1850,7 +1867,7 @@ cgenCase m e s
where where
genCaseBody :: CGen () -> A.Structured A.Option -> CGen Bool genCaseBody :: CGen () -> A.Structured A.Option -> CGen Bool
genCaseBody coll (A.Spec _ spec s) genCaseBody coll (A.Spec _ spec s)
= genCaseBody (call genSpec spec coll) s = genCaseBody (call genSpec NotTopLevel spec coll) s
genCaseBody coll (A.Only _ (A.Option _ es p)) genCaseBody coll (A.Only _ (A.Option _ es p))
= do sequence_ [tell ["case "] >> call genExpression e >> tell [":"] | e <- es] = do sequence_ [tell ["case "] >> call genExpression e >> tell [":"] | e <- es]
tell ["{"] tell ["{"]
@ -1896,7 +1913,7 @@ cgenPar pm s
call genExpression count call genExpression count
tell [");"] tell [");"]
call genStructured s (startP bar wss) call genStructured NotTopLevel s (startP bar wss)
tell ["LightProcBarrierWait (wptr, &", bar, ");\n"] tell ["LightProcBarrierWait (wptr, &", bar, ");\n"]
@ -1953,7 +1970,7 @@ cgenAlt isPri s
containsTimers (A.Several _ ss) = or $ map containsTimers ss containsTimers (A.Several _ ss) = or $ map containsTimers ss
genAltEnable :: String -> A.Structured A.Alternative -> CGen () genAltEnable :: String -> A.Structured A.Alternative -> CGen ()
genAltEnable id s = call genStructured s doA >> return () genAltEnable id s = call genStructured NotTopLevel s doA >> return ()
where where
doA _ alt doA _ alt
= case alt of = case alt of
@ -1973,7 +1990,7 @@ cgenAlt isPri s
tell [");\n"] tell [");\n"]
genAltDisable :: String -> A.Structured A.Alternative -> CGen () genAltDisable :: String -> A.Structured A.Alternative -> CGen ()
genAltDisable id s = call genStructured s doA >> return () genAltDisable id s = call genStructured NotTopLevel s doA >> return ()
where where
doA _ alt doA _ alt
= case alt of = case alt of
@ -1993,7 +2010,7 @@ cgenAlt isPri s
tell [");\n"] tell [");\n"]
genAltProcesses :: String -> String -> String -> A.Structured A.Alternative -> CGen () genAltProcesses :: String -> String -> String -> A.Structured A.Alternative -> CGen ()
genAltProcesses id fired label s = call genStructured s doA >> return () genAltProcesses id fired label s = call genStructured NotTopLevel s doA >> return ()
where where
doA _ alt doA _ alt
= case alt of = case alt of

12
backends/GenerateCBased.hs
View File

@ -96,6 +96,8 @@ csmLift = lift . lift
-- | A function that applies a subscript to a variable. -- | A function that applies a subscript to a variable.
type SubscripterFunction = A.Variable -> A.Variable type SubscripterFunction = A.Variable -> A.Variable
data Level = TopLevel | NotTopLevel
--{{{ generator ops --{{{ generator ops
-- | Operations for turning various things into C. -- | Operations for turning various things into C.
-- These are in a structure so that we can reuse operations in other -- These are in a structure so that we can reuse operations in other
@ -132,10 +134,10 @@ data GenOps = GenOps {
genConversion :: Meta -> A.ConversionMode -> A.Type -> A.Expression -> CGen (), genConversion :: Meta -> A.ConversionMode -> A.Type -> A.Expression -> CGen (),
genConversionSymbol :: A.Type -> A.Type -> A.ConversionMode -> CGen (), genConversionSymbol :: A.Type -> A.Type -> A.ConversionMode -> CGen (),
getCType :: Meta -> A.Type -> A.AbbrevMode -> CGen CType, getCType :: Meta -> A.Type -> A.AbbrevMode -> CGen CType,
genDecl :: A.AbbrevMode -> A.Type -> A.Name -> CGen (), genDecl :: Level -> A.AbbrevMode -> A.Type -> A.Name -> CGen (),
-- | Generates a declaration of a variable of the specified type and name. -- | Generates a declaration of a variable of the specified type and name.
-- The Bool indicates whether the declaration is inside a record (True) or not (False). -- The Bool indicates whether the declaration is inside a record (True) or not (False).
genDeclaration :: A.Type -> A.Name -> Bool -> CGen (), genDeclaration :: Level -> A.Type -> A.Name -> Bool -> CGen (),
genDirectedVariable :: Meta -> A.Type -> CGen () -> A.Direction -> CGen (), genDirectedVariable :: Meta -> A.Type -> CGen () -> A.Direction -> CGen (),
genDyadic :: Meta -> A.DyadicOp -> A.Expression -> A.Expression -> CGen (), genDyadic :: Meta -> A.DyadicOp -> A.Expression -> A.Expression -> CGen (),
genExpression :: A.Expression -> CGen (), genExpression :: A.Expression -> CGen (),
@ -182,11 +184,11 @@ data GenOps = GenOps {
genSeq :: A.Structured A.Process -> CGen (), genSeq :: A.Structured A.Process -> CGen (),
genSimpleDyadic :: String -> A.Expression -> A.Expression -> CGen (), genSimpleDyadic :: String -> A.Expression -> A.Expression -> CGen (),
genSimpleMonadic :: String -> A.Expression -> CGen (), genSimpleMonadic :: String -> A.Expression -> CGen (),
genSpec :: forall b. A.Specification -> CGen b -> CGen b, genSpec :: forall b. Level -> A.Specification -> CGen b -> CGen b,
genSpecMode :: A.SpecMode -> CGen (), genSpecMode :: A.SpecMode -> CGen (),
-- | Generates a STOP process that uses the given Meta tag and message as its printed message. -- | Generates a STOP process that uses the given Meta tag and message as its printed message.
genStop :: Meta -> String -> CGen (), genStop :: Meta -> String -> CGen (),
genStructured :: forall a b. Data a => A.Structured a -> (Meta -> a -> CGen b) -> CGen [b], genStructured :: forall a b. Data a => Level -> A.Structured a -> (Meta -> a -> CGen b) -> CGen [b],
genTimerRead :: A.Variable -> A.Variable -> CGen (), genTimerRead :: A.Variable -> A.Variable -> CGen (),
genTimerWait :: A.Expression -> CGen (), genTimerWait :: A.Expression -> CGen (),
genTopLevel :: String -> A.AST -> CGen (), genTopLevel :: String -> A.AST -> CGen (),
@ -200,7 +202,7 @@ data GenOps = GenOps {
-- | Generates a while loop with the given condition and body. -- | Generates a while loop with the given condition and body.
genWhile :: A.Expression -> A.Process -> CGen (), genWhile :: A.Expression -> A.Process -> CGen (),
getScalarType :: A.Type -> Maybe String, getScalarType :: A.Type -> Maybe String,
introduceSpec :: A.Specification -> CGen (), introduceSpec :: Level -> A.Specification -> CGen (),
removeSpec :: A.Specification -> CGen () removeSpec :: A.Specification -> CGen ()
} }

29
backends/GenerateCPPCSP.hs
View File

@ -40,7 +40,7 @@ import System.IO
import qualified AST as A import qualified AST as A
import CompState import CompState
import GenerateC (cgenOps, cgenReplicatorLoop, cgetCType, cintroduceSpec, import GenerateC (cgenOps, cgenReplicatorLoop, cgetCType, cintroduceSpec,
genDynamicDim, generate, genLeftB, genMeta, genName, genRightB, justOnly, withIf) genDynamicDim, generate, genLeftB, genMeta, genName, genRightB, genStatic, justOnly, withIf)
import GenerateCBased import GenerateCBased
import Errors import Errors
import Metadata import Metadata
@ -136,7 +136,7 @@ cppgenTopLevel headerName s
tell ["#include <tock_support_cppcsp.h>\n"] tell ["#include <tock_support_cppcsp.h>\n"]
--In future, these declarations could be moved to a header file: --In future, these declarations could be moved to a header file:
sequence_ $ map (call genForwardDeclaration) (listify (const True :: A.Specification -> Bool) s) sequence_ $ map (call genForwardDeclaration) (listify (const True :: A.Specification -> Bool) s)
call genStructured s (\m _ -> tell ["\n#error Invalid top-level item: ",show m]) call genStructured TopLevel s (\m _ -> tell ["\n#error Invalid top-level item: ",show m])
(name, chans) <- tlpInterface (name, chans) <- tlpInterface
tell ["int main (int argc, char** argv) { csp::Start_CPPCSP();"] tell ["int main (int argc, char** argv) { csp::Start_CPPCSP();"]
(chanTypeRead, chanTypeWrite, writer, reader) <- (chanTypeRead, chanTypeWrite, writer, reader) <-
@ -385,7 +385,7 @@ cppgenPar :: A.ParMode -> A.Structured A.Process -> CGen ()
cppgenPar _ s cppgenPar _ s
= do forking <- csmLift $ makeNonce "forking" = do forking <- csmLift $ makeNonce "forking"
tell ["{ csp::ScopedForking ",forking," ; "] tell ["{ csp::ScopedForking ",forking," ; "]
call genStructured s (genPar' forking) call genStructured NotTopLevel s (genPar' forking)
tell [" }"] tell [" }"]
where where
genPar' :: String -> Meta -> A.Process -> CGen () genPar' :: String -> Meta -> A.Process -> CGen ()
@ -423,7 +423,7 @@ cppgenAlt _ s
where where
--This function is like the enable function in GenerateC, but this one merely builds a list of guards. It does not do anything other than add to the guard list --This function is like the enable function in GenerateC, but this one merely builds a list of guards. It does not do anything other than add to the guard list
initAltGuards :: String -> A.Structured A.Alternative -> CGen () initAltGuards :: String -> A.Structured A.Alternative -> CGen ()
initAltGuards guardList s = call genStructured s doA >> return () initAltGuards guardList s = call genStructured NotTopLevel s doA >> return ()
where where
doA _ alt doA _ alt
= case alt of = case alt of
@ -444,7 +444,7 @@ cppgenAlt _ s
-- This is the same as GenerateC for now -- but it's not really reusable -- This is the same as GenerateC for now -- but it's not really reusable
-- because it's so closely tied to how ALT is implemented in the backend. -- because it's so closely tied to how ALT is implemented in the backend.
genAltProcesses :: String -> String -> String -> A.Structured A.Alternative -> CGen () genAltProcesses :: String -> String -> String -> A.Structured A.Alternative -> CGen ()
genAltProcesses id fired label s = call genStructured s doA >> return () genAltProcesses id fired label s = call genStructured NotTopLevel s doA >> return ()
where where
doA _ alt doA _ alt
= case alt of = case alt of
@ -516,7 +516,7 @@ cppgenFormals nameFunc list = seqComma (map (cppgenFormal nameFunc) list)
--Changed as genFormals --Changed as genFormals
cppgenFormal :: (A.Name -> A.Name) -> A.Formal -> CGen () cppgenFormal :: (A.Name -> A.Name) -> A.Formal -> CGen ()
cppgenFormal nameFunc (A.Formal am t n) = call genDecl am t (nameFunc n) cppgenFormal nameFunc (A.Formal am t n) = call genDecl NotTopLevel am t (nameFunc n)
cppgenForwardDeclaration :: A.Specification -> CGen() cppgenForwardDeclaration :: A.Specification -> CGen()
cppgenForwardDeclaration (A.Specification _ n (A.Proc _ (sm, _) fs _)) cppgenForwardDeclaration (A.Specification _ n (A.Proc _ (sm, _) fs _))
@ -548,7 +548,7 @@ cppgenForwardDeclaration (A.Specification _ n (A.Proc _ (sm, _) fs _))
--A simple function for generating declarations of class variables --A simple function for generating declarations of class variables
genClassVar :: A.Formal -> CGen() genClassVar :: A.Formal -> CGen()
genClassVar (A.Formal am t n) genClassVar (A.Formal am t n)
= do call genDecl am t n = do call genDecl NotTopLevel am t n
tell[";"] tell[";"]
--Generates the given list of class variables --Generates the given list of class variables
@ -572,10 +572,11 @@ cppgenForwardDeclaration (A.Specification _ n (A.RecordType _ b fs))
= call genRecordTypeSpec n b fs = call genRecordTypeSpec n b fs
cppgenForwardDeclaration _ = return () cppgenForwardDeclaration _ = return ()
cppintroduceSpec :: A.Specification -> CGen () cppintroduceSpec :: Level -> A.Specification -> CGen ()
--I generate process wrappers for all functions by default: --I generate process wrappers for all functions by default:
cppintroduceSpec (A.Specification _ n (A.Proc _ (sm, _) fs p)) cppintroduceSpec lvl (A.Specification _ n (A.Proc _ (sm, _) fs p))
= do --Generate the "process" as a C++ function: = do --Generate the "process" as a C++ function:
genStatic lvl n
call genSpecMode sm call genSpecMode sm
tell ["void "] tell ["void "]
name name
@ -603,7 +604,7 @@ cppintroduceSpec (A.Specification _ n (A.Proc _ (sm, _) fs p))
--A helper function for calling the wrapped functions: --A helper function for calling the wrapped functions:
genParamList :: [A.Formal] -> CGen() genParamList :: [A.Formal] -> CGen()
genParamList fs = seqComma $ map genParam fs genParamList fs = seqComma $ map genParam fs
cppintroduceSpec (A.Specification _ n (A.Is _ am t@(A.Array ds c@(A.ChanEnd {})) cppintroduceSpec lvl (A.Specification _ n (A.Is _ am t@(A.Array ds c@(A.ChanEnd {}))
(A.ActualVariable dirV@(A.DirectedVariable m dir v)))) (A.ActualVariable dirV@(A.DirectedVariable m dir v))))
= do t' <- if A.UnknownDimension `elem` ds = do t' <- if A.UnknownDimension `elem` ds
then do dirVT <- astTypeOf dirV then do dirVT <- astTypeOf dirV
@ -611,7 +612,7 @@ cppintroduceSpec (A.Specification _ n (A.Is _ am t@(A.Array ds c@(A.ChanEnd {}))
A.Array ds' _ -> return $ A.Array ds' c A.Array ds' _ -> return $ A.Array ds' c
_ -> diePC m $ formatCode "Expected variable to be an array type, instead: %" dirVT _ -> diePC m $ formatCode "Expected variable to be an array type, instead: %" dirVT
else return t else return t
call genDeclaration t' n False call genDeclaration lvl t' n False
tell [";"] tell [";"]
tell ["tockInitChan",if dir == A.DirInput then "in" else "out","Array("] tell ["tockInitChan",if dir == A.DirInput then "in" else "out","Array("]
call genVariable v am call genVariable v am
@ -621,7 +622,7 @@ cppintroduceSpec (A.Specification _ n (A.Is _ am t@(A.Array ds c@(A.ChanEnd {}))
genDynamicDim (A.Variable m n) 0 genDynamicDim (A.Variable m n) 0
tell [");"] tell [");"]
--For all other cases, use the C implementation: --For all other cases, use the C implementation:
cppintroduceSpec n = cintroduceSpec n cppintroduceSpec lvl n = cintroduceSpec lvl n
--}}} --}}}
@ -825,7 +826,7 @@ cppgenUnfoldedVariable m var
-- | Changed to throw a nonce-exception class instead of the goto, because C++ doesn't allow gotos to cross class initialisations (such as arrays) -- | Changed to throw a nonce-exception class instead of the goto, because C++ doesn't allow gotos to cross class initialisations (such as arrays)
cppgenIf :: Meta -> A.Structured A.Choice -> CGen () cppgenIf :: Meta -> A.Structured A.Choice -> CGen ()
cppgenIf m s | justOnly s = do call genStructured s doCplain cppgenIf m s | justOnly s = do call genStructured NotTopLevel s doCplain
tell ["{"] tell ["{"]
call genStop m "no choice matched in IF process" call genStop m "no choice matched in IF process"
tell ["}"] tell ["}"]
@ -837,7 +838,7 @@ cppgenIf m s | justOnly s = do call genStructured s doCplain
tell ["}catch(",ifExc,"){}"] tell ["}catch(",ifExc,"){}"]
where where
genIfBody :: String -> A.Structured A.Choice -> CGen () genIfBody :: String -> A.Structured A.Choice -> CGen ()
genIfBody ifExc s = call genStructured s doC >> return () genIfBody ifExc s = call genStructured NotTopLevel s doC >> return ()
where where
doC m (A.Choice m' e p) doC m (A.Choice m' e p)
= do tell ["if("] = do tell ["if("]