{- Tock: a compiler for parallel languages Copyright (C) 2007 University of Kent This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . -} -- #ignore-exports {-| Generate C++ code from the mangled AST that uses the C++CSP2 library. In order to compile the generated code, you will need: * A standards-compliant C++98 compiler (GCC or Visual Studio >= 2003, but not Visual Studio 6). * The C++CSP2 library (>= 2.0.2), available from , and any appropriate dependencies (e.g. Boost). Channels of direction 'A.DirUnknown' are passed around as pointers to a One2OneChannel\<\> object. To read I use the reader() function and to write I use the writer() function. For channels of direction 'A.DirInput' or 'A.DirOutput' I actually pass the Chanin\<\> and Chanout\<\> objects as you would expect. -} module GenerateCPPCSP (cppcspPrereq, cppgenOps, generateCPPCSP, genCPPCSPPasses) where import Control.Monad.State import Data.Char import Data.Generics import Data.List import Data.Maybe import System.IO import qualified AST as A import CompState import GenerateC (cgenOps, cintroduceSpec, cgenType, generate, genComma, genLeftB, genMeta, genName, genRightB, seqComma, withIf) import GenerateCBased import Metadata import Pass import qualified Properties as Prop import ShowCode import TLP import Types import Utils --{{{ generator ops -- | Operations for the C++CSP backend. -- Most of this is inherited directly from the C backend in the "GenerateC" module. cppgenOps :: GenOps cppgenOps = cgenOps { declareFree = cppdeclareFree, declareInit = cppdeclareInit, genActuals = cppgenActuals, genAllocMobile = cppgenAllocMobile, genAlt = cppgenAlt, genClearMobile = cppgenClearMobile, genDirectedVariable = cppgenDirectedVariable, genForwardDeclaration = cppgenForwardDeclaration, genGetTime = cppgenGetTime, genIf = cppgenIf, genInputItem = cppgenInputItem, genOutputCase = cppgenOutputCase, genOutputItem = cppgenOutputItem, genPar = cppgenPar, genProcCall = cppgenProcCall, genStop = cppgenStop, genTimerRead = cppgenTimerRead, genTimerWait = cppgenTimerWait, genTopLevel = cppgenTopLevel, genType = cppgenType, genUnfoldedExpression = cppgenUnfoldedExpression, genUnfoldedVariable = cppgenUnfoldedVariable, genWait = cppgenWait, getScalarType = cppgetScalarType, introduceSpec = cppintroduceSpec, removeSpec = cppremoveSpec } --}}} genCPPCSPPasses :: [Pass] genCPPCSPPasses = makePassesDep' ((== BackendCPPCSP) . csBackend) [ ("Transform channels to ANY", chansToAny, [Prop.processTypesChecked], [Prop.allChansToAnyOrProtocol]) ] chansToAny :: Data t => t -> PassM t chansToAny x = do st <- get case csFrontend st of FrontendOccam -> do chansToAnyInCompState chansToAnyM x _ -> return x where chansToAny' :: A.Type -> PassM A.Type chansToAny' c@(A.Chan _ _ (A.UserProtocol {})) = return c chansToAny' (A.Chan a b _) = return $ A.Chan a b A.Any chansToAny' t = doGeneric t chansToAnyM :: Data t => t -> PassM t chansToAnyM = doGeneric `extM` chansToAny' doGeneric :: Data t => t -> PassM t doGeneric = makeGeneric chansToAnyM chansToAnyInCompState :: PassM () chansToAnyInCompState = do st <- get csn <- chansToAnyM (csNames st) put $ st {csNames = csn} return () --{{{ top-level -- | Transforms the given AST into a pass that generates C++ code. generateCPPCSP :: Handle -> A.AST -> PassM () generateCPPCSP = generate cppgenOps cppcspPrereq :: [Property] cppcspPrereq = cCppCommonPreReq ++ [Prop.allChansToAnyOrProtocol] -- | Generates the top-level code for an AST. cppgenTopLevel :: A.AST -> CGen () cppgenTopLevel s = do tell ["#include \n"] --In future, these declarations could be moved to a header file: sequence_ $ map (call genForwardDeclaration) (listify (const True :: A.Specification -> Bool) s) call genStructured s (\m _ -> tell ["\n#error Invalid top-level item: ",show m]) (name, chans) <- tlpInterface tell ["int main (int argc, char** argv) { csp::Start_CPPCSP();"] (chanType,writer) <- do st <- getCompState case csFrontend st of FrontendOccam -> return ("tockSendableArrayOfBytes","StreamWriterByteArray") _ -> return ("uint8_t","StreamWriter") tell ["csp::One2OneChannel<",chanType,"> in,out,err;"] --TODO add streamreader tell [" csp::Run( csp::InParallel (new ",writer,"(std::cout,out.reader())) (new ",writer,"(std::cerr,err.reader())) (csp::InSequenceOneThread ( new proc_"] genName name tell ["("] infixComma $ map tlpChannel chans tell [")) (new csp::common::ChannelPoisoner< csp::Chanout<",chanType,">/**/> (out.writer())) (new csp::common::ChannelPoisoner< csp::Chanout<",chanType,">/**/> (err.writer())) ) ); csp::End_CPPCSP(); return 0;}"] where tlpChannel :: (A.Direction,TLPChannel) -> CGen() tlpChannel (dir,c) = case dir of A.DirUnknown -> tell ["&", chanName] A.DirInput -> tell [chanName, ".reader() "] A.DirOutput -> tell [chanName, ".writer() "] where chanName = case c of TLPIn -> "in" TLPOut -> "out" TLPError -> "err" --}}} -- | CIF has a stop function for stopping processes. --In C++CSP I use the exception handling to make a stop call throw a StopException, --and the catch is placed so that catching a stop exception immediately finishes the process cppgenStop :: Meta -> String -> CGen () cppgenStop m s = do tell ["throw StopException("] genMeta m tell [" \"",s,"\");"] --{{{ Two helper functions to aggregate some common functionality in this file. -- | Generates code from a channel 'A.Variable' that will be of type Chanin\<\> genCPPCSPChannelInput :: A.Variable -> CGen() genCPPCSPChannelInput var = do t <- typeOfVariable var case t of (A.Chan A.DirInput _ _) -> call genVariable var (A.Chan A.DirUnknown _ _) -> do call genVariable var tell ["->reader()"] _ -> call genMissing $ "genCPPCSPChannelInput used on something which does not support input: " ++ show var -- | Generates code from a channel 'A.Variable' that will be of type Chanout\<\> genCPPCSPChannelOutput :: A.Variable -> CGen() genCPPCSPChannelOutput var = do t <- typeOfVariable var case t of (A.Chan A.DirOutput _ _) -> call genVariable var (A.Chan A.DirUnknown _ _) -> do call genVariable var tell ["->writer()"] _ -> call genMissing $ "genCPPCSPChannelOutput used on something which does not support output: " ++ show var --}}} -- | C++CSP2 returns the number of seconds since the epoch as the time --Since this is too large to be contained in an int once it has been multiplied, --the remainder is taken to trim the timer back down to something that will be useful in an int cppgenTimerRead :: A.Variable -> A.Variable -> CGen () cppgenTimerRead c v = do tell ["csp::CurrentTime (&"] call genVariable c tell [");\n"] call genVariable v tell [" = (int)(unsigned)remainder(1000000.0 * csp::GetSeconds("] call genVariable c tell ["),4294967296.0);\n"] cppgenGetTime :: A.Variable -> CGen () cppgenGetTime v = do tell ["csp::CurrentTime(&"] call genVariable v tell [");"] cppgenWait :: A.WaitMode -> A.Expression -> CGen () cppgenWait wm e = do tell [if wm == A.WaitFor then "csp::SleepFor" else "csp::SleepUntil", "("] call genExpression e tell [");"] {-| Gets a csp::Time to wait with, given a 32-bit microsecond value (returns the temp variable we have put it in) Time in occam is in microseconds, and is usually stored in the user's programs as a signed 32-bit integer. Therefore the timer wraps round approx every 72 minutes. A usual pattern of behaviour might be: TIMER tim: INT t: SEQ tim ? t -- read current time t := t PLUS us -- add delay tim ? AFTER t -- wait until time "t" According to Fred's occam page that I took that from, half of time delays are considered in the past and the other half are considered in the future. Now consider C++CSP's time. It typically has a more expressive time - on Linux, time is measured since the epoch. Since the epoch was more than 72 minutes ago, this is problematic when converted to microseconds and stuffed into a 32-bit int. I'll express C++CSP times as (HIGH, LOW) where LOW is the lowest 32 bits, and HIGH is the higher bits. Getting the time for the occam programmer is quite straightforward - we retrieve the C++CSP time, and hand LOW back to the programmer as a 32-bit signed value (LOW is unsigned normally). The occam programmer will now add some delay to their LOW value, making it LOWalpha. They then ask to wait until LOWalpha. We know that LOWalpha came from LOW at some point in the past and has been added to. We need to combine it with some HIGH value, HIGHalpha to form (HIGHalpha, LOWalpha), the time to wait until. So what should HIGHalpha be? We could say that HIGHalpha = HIGH. But if the user wrapped around LOWalpha, we actually want: HIGHalpha = HIGH + 1. So we need to check if LOWalpha is a wrapped round version of LOW. This could be done by checking whether LOWalpha < LOW. If this is true, it must have wrapped. Otherwise, it must not have. -} genCPPCSPTime :: A.Expression -> CGen String genCPPCSPTime e = do time <- csmLift $ makeNonce "time_exp" tell ["unsigned ",time," = (unsigned)"] call genExpression e tell [" ; "] curTime <- csmLift $ makeNonce "time_exp" curTimeLow <- csmLift $ makeNonce "time_exp" curTimeHigh <- csmLift $ makeNonce "time_exp" retTime <- csmLift $ makeNonce "time_exp" tell ["double ",curTime," = csp::GetSeconds(csp::CurrentTime());"] tell ["unsigned ",curTimeLow," = (unsigned)remainder(1000000.0 * ",curTime,",4294967296.0);"] tell ["unsigned ",curTimeHigh," = (unsigned)((1000000.0 * ",curTime,") / 4294967296.0);"] --if time is less than curTime, it must have wrapped around so add one: tell ["csp::Time ",retTime," = csp::Seconds((((double)(",curTimeHigh," + TimeDiffHelper(",curTimeLow,",",time,")) * 4294967296.0) + (double)",time,") / 1000000.0);"] return retTime cppgenTimerWait :: A.Expression -> CGen () cppgenTimerWait e = do time <- genCPPCSPTime e tell ["csp::SleepUntil(",time,");"] cppgenInputItem :: A.Variable -> A.InputItem -> CGen () cppgenInputItem c dest = case dest of (A.InCounted m cv av) -> do call genInputItem c (A.InVariable m cv) recvBytes av ( do call genVariable cv tell ["*"] t <- typeOfVariable av subT <- trivialSubscriptType m t call genBytesIn m subT (Right av) ) (A.InVariable m v) -> do ct <- typeOfVariable c t <- typeOfVariable v case (byteArrayChan ct,t) of (True,_)-> recvBytes v (call genBytesIn m t (Right v)) (False,A.Array {}) -> do tell ["tockRecvArray("] chan' tell [","] call genVariable v tell [");"] (False,_) -> do chan' tell [">>"] genNonPoint v tell [";"] where chan' = genCPPCSPChannelInput c recvBytes :: A.Variable -> CGen () -> CGen () recvBytes v b = do tell ["tockRecvArrayOfBytes("] chan' tell [",tockSendableArrayOfBytes("] b tell [","] genPoint v tell ["));"] cppgenOutputItem :: A.Variable -> A.OutputItem -> CGen () cppgenOutputItem chan item = case item of (A.OutCounted m (A.ExprVariable _ cv) (A.ExprVariable _ av)) -> (sendBytes cv) >> (sendBytes av) (A.OutExpression _ (A.ExprVariable _ sv)) -> do t <- typeOfVariable chan tsv <- typeOfVariable sv case (byteArrayChan t,tsv) of (True,_) -> sendBytes sv (False,A.Array {}) -> do tell ["tockSendArray("] chan' tell [","] call genVariable sv tell [");"] (False,_) -> do chan' tell ["<<"] genNonPoint sv tell [";"] where chan' = genCPPCSPChannelOutput chan sendBytes v = do chan' tell ["< Bool byteArrayChan (A.Chan _ _ (A.UserProtocol _)) = True byteArrayChan (A.Chan _ _ A.Any) = True byteArrayChan (A.Chan _ _ (A.Counted _ _)) = True byteArrayChan _ = False genPoint :: A.Variable -> CGen() genPoint v = do t <- typeOfVariable v when (not $ isPoint t) $ tell ["&"] call genVariable v genNonPoint :: A.Variable -> CGen() genNonPoint v = do t <- typeOfVariable v when (isPoint t) $ tell ["*"] call genVariable v isPoint :: A.Type -> Bool isPoint (A.Record _) = True isPoint (A.Array _ _) = True isPoint _ = False -- FIXME Should be a generic helper somewhere (along with the others from GenerateC) -- | Helper function to place a comma between items, but not before or after infixComma :: [CGen ()] -> CGen () infixComma (c0:cs) = c0 >> sequence_ [genComma >> c | c <- cs] infixComma [] = return () cppgenOutputCase :: A.Variable -> A.Name -> [A.OutputItem] -> CGen () cppgenOutputCase c tag ois = do t <- typeOfVariable c let proto = case t of A.Chan _ _ (A.UserProtocol n) -> n tell ["tockSendInt("] genCPPCSPChannelOutput c tell [","] genName tag tell ["_"] genName proto tell [");"] call genOutput c ois -- | We use the process wrappers here, in order to execute the functions in parallel. --We use forking instead of Run\/InParallelOneThread, because it is easier to use forking with replication. cppgenPar :: A.ParMode -> A.Structured A.Process -> CGen () cppgenPar _ s = do forking <- csmLift $ makeNonce "forking" tell ["{ csp::ScopedForking ",forking," ; "] call genStructured s (genPar' forking) tell [" }"] where genPar' :: String -> Meta -> A.Process -> CGen () genPar' forking _ p = case p of A.ProcCall _ n as -> do tell [forking," .forkInThisThread(new proc_"] genName n tell ["("] call genActuals as tell [" ) ); "] _ -> error ("trying to run something other than a process in parallel") -- | Changed to use C++CSP's Alternative class: cppgenAlt :: Bool -> A.Structured A.Alternative -> CGen () cppgenAlt _ s = do guards <- csmLift $ makeNonce "alt_guards" tell ["std::list< csp::Guard* > ", guards, " ; "] initAltGuards guards s alt <- csmLift $ makeNonce "alt" tell ["csp::Alternative ",alt, " ( ", guards, " ); "] id <- csmLift $ makeNonce "alt_id" tell ["int ", id, " = 0;\n"] fired <- csmLift $ makeNonce "alt_fired" tell ["int ", fired, " = ", alt, " .priSelect();"] label <- csmLift $ makeNonce "alt_end" tell ["{\n"] genAltProcesses id fired label s tell ["}\n"] tell [label, ":\n;\n"] 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 initAltGuards :: String -> A.Structured A.Alternative -> CGen () initAltGuards guardList s = call genStructured s doA where doA _ alt = case alt of A.Alternative _ c im _ -> doIn c im A.AlternativeCond _ e c im _ -> withIf e $ doIn c im A.AlternativeSkip _ e _ -> withIf e $ tell [guardList, " . push_back( new csp::SkipGuard() );\n"] A.AlternativeWait _ wm e _ -> do tell [guardList, " . push_back( new ", if wm == A.WaitUntil then "csp::TimeoutGuard (" else "csp::RelTimeoutGuard("] call genExpression e tell ["));"] doIn c im = do case im of A.InputTimerRead _ _ -> call genMissing "timer read in ALT" A.InputTimerAfter _ time -> do timeVal <- genCPPCSPTime time tell [guardList, " . push_back( new csp::TimeoutGuard (",timeVal,"));\n"] _ -> do tell [guardList, " . push_back( "] genCPPCSPChannelInput c tell [" . inputGuard());\n"] -- 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. genAltProcesses :: String -> String -> String -> A.Structured A.Alternative -> CGen () genAltProcesses id fired label s = call genStructured s doA where doA _ alt = case alt of A.Alternative _ c im p -> doIn c im p A.AlternativeCond _ e c im p -> withIf e $ doIn c im p A.AlternativeSkip _ e p -> withIf e $ doCheck (call genProcess p) A.AlternativeWait _ _ _ p -> doCheck (call genProcess p) doIn c im p = do case im of A.InputTimerRead _ _ -> call genMissing "timer read in ALT" A.InputTimerAfter _ _ -> doCheck (call genProcess p) _ -> doCheck (call genInput c im >> call genProcess p) doCheck body = do tell ["if (", id, "++ == ", fired, ") {\n"] body tell ["goto ", label, ";\n"] tell ["}\n"] -- | In GenerateC this uses prefixComma (because "Process * me" is always the first argument), but here we use infixComma. cppgenActuals :: [A.Actual] -> CGen () cppgenActuals as = infixComma (map (call genActual) as) -- | The only change from GenerateC is that passing "me" is not necessary in C++CSP cppgenProcCall :: A.Name -> [A.Actual] -> CGen () cppgenProcCall n as = do genName n tell ["("] call genActuals as tell [");"] -- | Changed because we initialise channels and arrays differently in C++ cppdeclareInit :: Meta -> A.Type -> A.Variable -> Maybe (CGen ()) cppdeclareInit m t@(A.Array ds t') var = Just $ do case t' of A.Chan A.DirUnknown _ _ -> do tell ["tockInitChanArray("] call genVariableUnchecked var tell ["_storage,"] call genVariableUnchecked var tell [","] sequence_ $ intersperse (tell ["*"]) [case dim of A.Dimension d -> tell [show d] | dim <- ds] tell [");"] _ -> return () cppdeclareInit m rt@(A.Record _) var = Just $ do fs <- recordFields m rt sequence_ [initField t (A.SubscriptedVariable m (A.SubscriptField m n) var) | (n, t) <- fs] where initField :: A.Type -> A.Variable -> CGen () initField t v = do fdeclareInit <- fget declareInit doMaybe $ fdeclareInit m t v cppdeclareInit _ _ _ = Nothing -- | Changed because we don't need any de-initialisation in C++, regardless of whether C does. cppdeclareFree :: Meta -> A.Type -> A.Variable -> Maybe (CGen ()) cppdeclareFree _ _ _ = Nothing -- | Changed to work properly with declareFree to free channel arrays. cppremoveSpec :: A.Specification -> CGen () cppremoveSpec (A.Specification m n (A.Declaration _ t)) = do fdeclareFree <- fget declareFree case fdeclareFree m t var of Just p -> p Nothing -> return () where var = A.Variable m n cppremoveSpec _ = return () --Changed from GenerateC to add a name function (to allow us to use the same function for doing function parameters as constructor parameters) --and also changed to use infixComma. --Therefore these functions are not part of GenOps. They are called directly by cppgenForwardDeclaration and cppintroduceSpec. --To use for a constructor list, pass prefixUnderscore as the function, otherwise pass the identity function cppgenFormals :: (A.Name -> A.Name) -> [A.Formal] -> CGen () cppgenFormals nameFunc list = infixComma (map (cppgenFormal nameFunc) list) --Changed as genFormals cppgenFormal :: (A.Name -> A.Name) -> A.Formal -> CGen () cppgenFormal nameFunc (A.Formal am t n) = call genDecl am t (nameFunc n) cppgenForwardDeclaration :: A.Specification -> CGen() cppgenForwardDeclaration (A.Specification _ n (A.Proc _ sm fs _)) = do --Generate the "process" as a C++ function: call genSpecMode sm tell ["void "] name tell [" ("] cppgenFormals (\x -> x) fs tell [");"] --And generate its CSProcess wrapper: tell ["class proc_"] name tell [" : public csp::CSProcess {private:"] genClassVars fs tell ["public:inline proc_"] name tell ["("] cppgenFormals prefixUnderscore fs -- One of the cgtests declares an array of 200*100*sizeof(csp::Time). -- Assuming csp::Time could be up to 16 bytes, we need half a meg stack: tell [") : csp::CSProcess(524288)"] genConstructorList fs tell ["{} protected: virtual void run(); };"] where name = genName n --A simple function for generating declarations of class variables genClassVar :: A.Formal -> CGen() genClassVar (A.Formal am t n) = do call genDecl am t n tell[";"] --Generates the given list of class variables genClassVars :: [A.Formal] -> CGen () genClassVars fs = mapM_ genClassVar fs --A helper function for generating the initialiser list in a process wrapper constructor genConsItem :: A.Formal -> CGen() genConsItem (A.Formal am t n) = do tell[","] genName n tell["(_"] genName n tell[")"] --A function for generating the initialiser list in a process wrapper constructor genConstructorList :: [A.Formal] -> CGen () genConstructorList fs = mapM_ genConsItem fs cppgenForwardDeclaration (A.Specification _ n (A.RecordType _ b fs)) = call genRecordTypeSpec n b fs cppgenForwardDeclaration _ = return () cppintroduceSpec :: A.Specification -> CGen () --I generate process wrappers for all functions by default: cppintroduceSpec (A.Specification _ n (A.Proc _ sm fs p)) = do --Generate the "process" as a C++ function: call genSpecMode sm tell ["void "] name tell [" ("] cppgenFormals (\x -> x) fs tell [") {\n"] call genProcess p tell ["}\n"] --And generate its CSProcess wrapper: tell ["void proc_"] name tell ["::run() { try {"] name tell [" ( "] genParamList fs tell [" ); } catch (StopException e) {std::cerr << \"Stopped because: \" << e.reason << std::endl; } }"] where name = genName n --A helper function for calling the wrapped functions: genParam :: A.Formal -> CGen() genParam (A.Formal _ _ n) = genName n --A helper function for calling the wrapped functions: genParamList :: [A.Formal] -> CGen() genParamList fs = infixComma $ map genParam fs --For all other cases, use the C implementation: cppintroduceSpec n = cintroduceSpec n --}}} --{{{ types -- | If a type maps to a simple C type, return Just that; else return Nothing. --Changed from GenerateC to change the A.Timer type to use C++CSP time. --Also changed the bool type, because vector in C++ is odd, so we hide it from the compiler. cppgetScalarType :: A.Type -> Maybe String cppgetScalarType A.Bool = Just "bool" cppgetScalarType A.Byte = Just "uint8_t" cppgetScalarType A.UInt16 = Just "uint16_t" cppgetScalarType A.UInt32 = Just "uint32_t" cppgetScalarType A.UInt64 = Just "uint64_t" cppgetScalarType A.Int8 = Just "int8_t" cppgetScalarType A.Int = Just "int" cppgetScalarType A.Int16 = Just "int16_t" cppgetScalarType A.Int32 = Just "int32_t" cppgetScalarType A.Int64 = Just "int64_t" cppgetScalarType A.Real32 = Just "float" cppgetScalarType A.Real64 = Just "double" cppgetScalarType A.Timer = Just "csp::Time" cppgetScalarType A.Time = Just "csp::Time" cppgetScalarType _ = Nothing -- | Changed from GenerateC to change the arrays and the channels --Also changed to add counted arrays and user protocols cppgenType :: A.Type -> CGen () cppgenType arr@(A.Array _ _) = cgenType arr cppgenType (A.Record n) = genName n cppgenType (A.Chan dir attr t) = do let chanType = case dir of A.DirInput -> "csp::Chanin" A.DirOutput -> "csp::Chanout" A.DirUnknown -> case (A.caWritingShared attr,A.caReadingShared attr) of (False,False) -> "csp::One2OneChannel" (False,True) -> "csp::One2AnyChannel" (True,False) -> "csp::Any2OneChannel" (True,True) -> "csp::Any2AnyChannel" tell [chanType,"<"] cppTypeInsideChannel t tell [">/**/"] where cppTypeInsideChannel :: A.Type -> CGen () cppTypeInsideChannel A.Any = tell ["tockSendableArrayOfBytes"] cppTypeInsideChannel (A.Counted _ _) = tell ["tockSendableArrayOfBytes"] cppTypeInsideChannel (A.UserProtocol _) = tell ["tockSendableArrayOfBytes"] cppTypeInsideChannel (A.Array ds t) = do tell ["tockSendableArray<"] call genType t tell [","] tell $ intersperse "*" [case d of A.Dimension n -> show n | d <- ds] tell [">/**/"] cppTypeInsideChannel t = call genType t cppgenType (A.Mobile t@(A.Array {})) = call genType t cppgenType (A.Mobile t@(A.List {})) = call genType t cppgenType (A.Mobile t) = call genType t >> tell ["*"] cppgenType (A.List t) = tell ["tockList<"] >> call genType t >> tell [">/**/"] cppgenType t = do fgetScalarType <- fget getScalarType case fgetScalarType t of Just s -> tell [s] Nothing -> call genMissingC $ formatCode "genType %" t -- | Helper function for prefixing an underscore to a name. prefixUnderscore :: A.Name -> A.Name prefixUnderscore n = n { A.nameName = "_" ++ A.nameName n } -- TODO I think I can remove both these unfolded expression things now that -- I've changed the arrays -- | Changed to remove array size: cppgenUnfoldedExpression :: A.Expression -> CGen () cppgenUnfoldedExpression (A.Literal _ t lr) = call genLiteralRepr lr t cppgenUnfoldedExpression (A.ExprVariable m var) = call genUnfoldedVariable m var cppgenUnfoldedExpression e = call genExpression e -- | Changed to remove array size: cppgenUnfoldedVariable :: Meta -> A.Variable -> CGen () cppgenUnfoldedVariable m var = do t <- typeOfVariable var case t of A.Record _ -> do genLeftB fs <- recordFields m t seqComma [call genUnfoldedVariable m (A.SubscriptedVariable m (A.SubscriptField m n) var) | (n, t) <- fs] genRightB -- We can defeat the usage check here because we know it's safe; *we're* -- generating the subscripts. -- FIXME Is that actually true for something like [a[x]]? _ -> call genVariableUnchecked var --{{{ if -- | 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 m s = do ifExc <- csmLift $ makeNonce "if_exc" tell ["class ",ifExc, "{};try{"] genIfBody ifExc s call genStop m "no choice matched in IF process" tell ["}catch(",ifExc,"){}"] where genIfBody :: String -> A.Structured A.Choice -> CGen () genIfBody ifExc s = call genStructured s doC where doC m (A.Choice m' e p) = do tell ["if("] call genExpression e tell ["){"] call genProcess p tell ["throw ",ifExc, "();}"] --}}} -- | Changed because C++CSP has channel-ends as concepts (whereas CCSP does not) cppgenDirectedVariable :: CGen () -> A.Direction -> CGen () cppgenDirectedVariable v A.DirInput = tell ["(("] >> v >> tell [")->reader())"] cppgenDirectedVariable v A.DirOutput = tell ["(("] >> v >> tell [")->writer())"] cppgenDirectedVariable v dir = call genMissing $ "Cannot direct variable to direction: " ++ show dir cppgenAllocMobile :: Meta -> A.Type -> Maybe A.Expression -> CGen () cppgenAllocMobile m (A.Mobile t) me = do tell ["new "] call genType t case me of Just e -> tell ["("] >> call genExpression e >> tell [")"] Nothing -> return () cppgenClearMobile :: Meta -> A.Variable -> CGen () cppgenClearMobile _ v = do tell ["if("] genVar tell ["!=NULL){delete "] genVar tell [";"] genVar tell ["=NULL;}"] where genVar = call genVariable v