From 7e7625385dff1e53c1c50d94de97f5cc34fd89c2 Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Fri, 8 Feb 2008 01:08:42 +0000 Subject: [PATCH] Pulled out various types and definitions from GenerateC into a common module, GenerateCBased --- Makefile.am | 1 + backends/GenerateC.hs | 172 +------------------------------ backends/GenerateCBased.hs | 201 +++++++++++++++++++++++++++++++++++++ backends/GenerateCPPCSP.hs | 1 + backends/GenerateCTest.hs | 1 + 5 files changed, 206 insertions(+), 170 deletions(-) create mode 100644 backends/GenerateCBased.hs diff --git a/Makefile.am b/Makefile.am index fe8231a..05e4f2b 100644 --- a/Makefile.am +++ b/Makefile.am @@ -97,6 +97,7 @@ tock_SOURCES_hs = Main.hs tock_SOURCES_hs += backends/AnalyseAsm.hs tock_SOURCES_hs += backends/BackendPasses.hs tock_SOURCES_hs += backends/GenerateC.hs +tock_SOURCES_hs += backends/GenerateCBased.hs tock_SOURCES_hs += backends/GenerateCPPCSP.hs tock_SOURCES_hs += backends/TLP.hs tock_SOURCES_hs += checks/ArrayUsageCheck.hs diff --git a/backends/GenerateC.hs b/backends/GenerateC.hs index d0b6e1f..ff1cf96 100644 --- a/backends/GenerateC.hs +++ b/backends/GenerateC.hs @@ -17,14 +17,13 @@ with this program. If not, see . -} -- | Generate C code from the mangled AST. -module GenerateC (CGenCall(..), CGen, CGen', cgenOps, cintroduceSpec, fget, genComma, genCPasses, generate, generateC, genLeftB, genMeta, genName, genRightB, GenOps(..), indexOfFreeDimensions, seqComma, SubscripterFunction, withIf ) where +module GenerateC (cgenOps, cintroduceSpec, fget, genComma, genCPasses, generate, generateC, genLeftB, genMeta, genName, genRightB, GenOps(..), indexOfFreeDimensions, seqComma, withIf ) where import Data.Char import Data.Generics import Data.List import Data.Maybe import qualified Data.Set as Set -import Control.Monad.Error import Control.Monad.Reader import Control.Monad.State import Control.Monad.Writer @@ -37,6 +36,7 @@ import CompState import Errors import EvalConstants import EvalLiterals +import GenerateCBased import Metadata import Pass import ShowCode @@ -52,171 +52,6 @@ genCPasses = ] --}}} ---{{{ monad definition -type CGen' = WriterT [String] PassM -type CGen = ReaderT GenOps CGen' - -instance Die CGen where - dieReport = throwError ---}}} - ---{{{ generator ops --- | Operations for turning various things into C. --- These are in a structure so that we can reuse operations in other --- backends without breaking the mutual recursion. -data GenOps = GenOps { - -- | Declares the C array of sizes for an occam array. - declareArraySizes :: A.Type -> A.Name -> CGen (), - -- | Generates code when a variable goes out of scope (e.g. deallocating memory). - declareFree :: Meta -> A.Type -> A.Variable -> Maybe (CGen ()), - -- | Generates code when a variable comes into scope (e.g. allocating memory, initialising variables). - declareInit :: Meta -> A.Type -> A.Variable -> Maybe A.Expression -> Maybe (CGen ()), - -- | Generates an individual parameter to a function\/proc. - genActual :: A.Actual -> CGen (), - -- | Generates the list of actual parameters to a function\/proc. - genActuals :: [A.Actual] -> CGen (), - genAllocMobile :: Meta -> A.Type -> Maybe A.Expression -> CGen(), - genAlt :: Bool -> A.Structured A.Alternative -> CGen (), - -- | Generates the given array element expressions as a flattened (one-dimensional) list of literals - genArrayLiteralElems :: [A.ArrayElem] -> CGen (), - -- | Declares a constant array for the sizes (dimensions) of a C array. - genArraySize :: Bool -> CGen () -> A.Name -> CGen (), - -- | Writes out the dimensions of an array, that can be used to initialise the sizes of an array. Fails if there is an 'A.UnknownDimension' present. - genArraySizesLiteral :: A.Name -> A.Type -> CGen (), - -- | Writes out the actual data storage array name. - genArrayStoreName :: A.Name -> CGen(), - -- | Generates an array subscript for the given variable (with error checking if the Bool is True), using the given expression list as subscripts - genArraySubscript :: Bool -> A.Variable -> [A.Expression] -> CGen (), - genAssert :: Meta -> A.Expression -> CGen (), - -- | Generates an assignment statement with a single destination and single source. - genAssign :: Meta -> [A.Variable] -> A.ExpressionList -> CGen (), - -- | Generates the number of bytes in a fixed size type, fails if a free dimension is present and is not allowed. - -- The Either parameter is either an array variable (to use the _sizes array of) or a boolean specifying - -- wheter or not one free dimension is allowed (True <=> allowed). - genBytesIn :: Meta -> A.Type -> Either Bool A.Variable -> CGen (), - -- | Generates a case statement over the given expression with the structured as the body. - genCase :: Meta -> A.Expression -> A.Structured A.Option -> CGen (), - genCheckedConversion :: Meta -> A.Type -> A.Type -> CGen () -> CGen (), - genClearMobile :: Meta -> A.Variable -> CGen (), - genConversion :: Meta -> A.ConversionMode -> A.Type -> A.Expression -> CGen (), - genConversionSymbol :: A.Type -> A.Type -> A.ConversionMode -> CGen (), - genDecl :: A.AbbrevMode -> A.Type -> A.Name -> CGen (), - genDeclType :: A.AbbrevMode -> A.Type -> CGen (), - -- | 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). - genDeclaration :: A.Type -> A.Name -> Bool -> CGen (), - genDirectedVariable :: CGen () -> A.Direction -> CGen (), - genDyadic :: Meta -> A.DyadicOp -> A.Expression -> A.Expression -> CGen (), - genExpression :: A.Expression -> CGen (), - genFlatArraySize :: [A.Dimension] -> CGen (), - genFormal :: A.Formal -> CGen (), - genFormals :: [A.Formal] -> CGen (), - genForwardDeclaration :: A.Specification -> CGen(), - genFuncDyadic :: Meta -> String -> A.Expression -> A.Expression -> CGen (), - genFuncMonadic :: Meta -> String -> A.Expression -> CGen (), - -- | Gets the current time into the given variable - genGetTime :: Meta -> A.Variable -> CGen (), - -- | Generates an IF statement (which can have replicators, specifications and such things inside it). - genIf :: Meta -> A.Structured A.Choice -> CGen (), - genInput :: A.Variable -> A.InputMode -> CGen (), - genInputItem :: A.Variable -> A.InputItem -> CGen (), - genIntrinsicFunction :: Meta -> String -> [A.Expression] -> CGen (), - genIntrinsicProc :: Meta -> String -> [A.Actual] -> CGen (), - genLiteral :: A.LiteralRepr -> CGen (), - genLiteralRepr :: A.LiteralRepr -> CGen (), - genMissing :: String -> CGen (), - genMissingC :: CGen String -> CGen (), - genMonadic :: Meta -> A.MonadicOp -> A.Expression -> CGen (), - -- | Generates an output statement. - genOutput :: A.Variable -> [A.OutputItem] -> CGen (), - -- | Generates an output statement for a tagged protocol. - genOutputCase :: A.Variable -> A.Name -> [A.OutputItem] -> CGen (), - -- | Generates an output for an individual item. - genOutputItem :: A.Variable -> A.OutputItem -> CGen (), - -- | Generates a loop that maps over every element in a (potentially multi-dimensional) array - genOverArray :: Meta -> A.Variable -> (SubscripterFunction -> Maybe (CGen ())) -> CGen (), - genPar :: A.ParMode -> A.Structured A.Process -> CGen (), - genProcCall :: A.Name -> [A.Actual] -> CGen (), - genProcess :: A.Process -> CGen (), - -- | Generates a replicator loop, given the replicator and body - genReplicator :: A.Replicator -> CGen () -> CGen (), - -- | Generates the three bits of a for loop (e.g. "int i=0;i<10;i++" for the given replicator - genReplicatorLoop :: A.Replicator -> CGen (), - genRetypeSizes :: Meta -> A.Type -> A.Name -> A.Type -> A.Variable -> CGen (), - genSeq :: A.Structured A.Process -> CGen (), - genSimpleDyadic :: String -> A.Expression -> A.Expression -> CGen (), - genSimpleMonadic :: String -> A.Expression -> CGen (), - genSizeSuffix :: String -> CGen (), - genSlice :: A.Variable -> A.Expression -> A.Expression -> [A.Dimension] -> (CGen (), A.Name -> CGen ()), - genSpec :: A.Specification -> CGen () -> CGen (), - genSpecMode :: A.SpecMode -> CGen (), - -- | Generates a STOP process that uses the given Meta tag and message as its printed message. - genStop :: Meta -> String -> CGen (), - genStructured :: forall a. Data a => A.Structured a -> (Meta -> a -> CGen ()) -> CGen (), - genTLPChannel :: TLPChannel -> CGen (), - genTimerRead :: A.Variable -> A.Variable -> CGen (), - genTimerWait :: A.Expression -> CGen (), - genTopLevel :: A.AST -> CGen (), - -- | Generates the type as it might be used in a cast expression - genType :: A.Type -> CGen (), - genTypeSymbol :: String -> A.Type -> CGen (), - genUnfoldedExpression :: A.Expression -> CGen (), - genUnfoldedVariable :: Meta -> A.Variable -> CGen (), - -- | Generates a variable, with indexing checks if needed - genVariable :: A.Variable -> CGen (), - genVariableAM :: A.Variable -> A.AbbrevMode -> CGen (), - -- | Generates a variable, with no indexing checks anywhere - genVariableUnchecked :: A.Variable -> CGen (), - -- | Performs a wait for\/until (depending on the 'A.WaitMode') a specified time - genWait :: A.WaitMode -> A.Expression -> CGen (), - -- | Generates a while loop with the given condition and body. - genWhile :: A.Expression -> A.Process -> CGen (), - getScalarType :: A.Type -> Maybe String, - introduceSpec :: A.Specification -> CGen (), - removeSpec :: A.Specification -> CGen () - } - --- | Call an operation in GenOps. -class CGenCall a where - call :: (GenOps -> a) -> a - -instance CGenCall (a -> CGen z) where --- call :: (a -> CGen b) -> a -> CGen b - call f x0 = do ops <- ask - f ops x0 - -instance CGenCall (a -> b -> CGen z) where - call f x0 x1 - = do ops <- ask - f ops x0 x1 - -instance CGenCall (a -> b -> c -> CGen z) where - call f x0 x1 x2 - = do ops <- ask - f ops x0 x1 x2 - -instance CGenCall (a -> b -> c -> d -> CGen z) where - call f x0 x1 x2 x3 - = do ops <- ask - f ops x0 x1 x2 x3 - -instance CGenCall (a -> b -> c -> d -> e -> CGen z) where - call f x0 x1 x2 x3 x4 - = do ops <- ask - f ops x0 x1 x2 x3 x4 - --- A bit of a mind-boggler, but this is essentially for genSlice -instance CGenCall (a -> b -> c -> d -> (CGen x, y -> CGen z)) where - call f x0 x1 x2 x3 - = (do ops <- ask - fst $ f ops x0 x1 x2 x3 - ,\y -> do ops <- ask - (snd $ f ops x0 x1 x2 x3) y - ) - -fget :: (GenOps -> a) -> CGen a -fget = asks - -- | Operations for the C backend. cgenOps :: GenOps cgenOps = GenOps { @@ -355,9 +190,6 @@ genRightB :: CGen () genRightB = tell ["}"] --}}} --- | A function that applies a subscript to a variable. -type SubscripterFunction = A.Variable -> A.Variable - -- | Map an operation over every item of an occam array. cgenOverArray :: Meta -> A.Variable -> (SubscripterFunction -> Maybe (CGen ())) -> CGen () cgenOverArray m var func diff --git a/backends/GenerateCBased.hs b/backends/GenerateCBased.hs new file mode 100644 index 0000000..680025c --- /dev/null +++ b/backends/GenerateCBased.hs @@ -0,0 +1,201 @@ +{- +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 . +-} + +-- | The function dictionary and various types/helper functions for backends based around C +module GenerateCBased where + +import Control.Monad.Error +import Control.Monad.Reader +import Control.Monad.Writer +import Data.Generics + +import qualified AST as A +import Errors +import Metadata +import Pass +import TLP + + +--{{{ monad definition +type CGen' = WriterT [String] PassM +type CGen = ReaderT GenOps CGen' + +instance Die CGen where + dieReport = throwError +--}}} + +-- | A function that applies a subscript to a variable. +type SubscripterFunction = A.Variable -> A.Variable + +--{{{ generator ops +-- | Operations for turning various things into C. +-- These are in a structure so that we can reuse operations in other +-- backends without breaking the mutual recursion. +data GenOps = GenOps { + -- | Declares the C array of sizes for an occam array. + declareArraySizes :: A.Type -> A.Name -> CGen (), + -- | Generates code when a variable goes out of scope (e.g. deallocating memory). + declareFree :: Meta -> A.Type -> A.Variable -> Maybe (CGen ()), + -- | Generates code when a variable comes into scope (e.g. allocating memory, initialising variables). + declareInit :: Meta -> A.Type -> A.Variable -> Maybe A.Expression -> Maybe (CGen ()), + -- | Generates an individual parameter to a function\/proc. + genActual :: A.Actual -> CGen (), + -- | Generates the list of actual parameters to a function\/proc. + genActuals :: [A.Actual] -> CGen (), + genAllocMobile :: Meta -> A.Type -> Maybe A.Expression -> CGen(), + genAlt :: Bool -> A.Structured A.Alternative -> CGen (), + -- | Generates the given array element expressions as a flattened (one-dimensional) list of literals + genArrayLiteralElems :: [A.ArrayElem] -> CGen (), + -- | Declares a constant array for the sizes (dimensions) of a C array. + genArraySize :: Bool -> CGen () -> A.Name -> CGen (), + -- | Writes out the dimensions of an array, that can be used to initialise the sizes of an array. Fails if there is an 'A.UnknownDimension' present. + genArraySizesLiteral :: A.Name -> A.Type -> CGen (), + -- | Writes out the actual data storage array name. + genArrayStoreName :: A.Name -> CGen(), + -- | Generates an array subscript for the given variable (with error checking if the Bool is True), using the given expression list as subscripts + genArraySubscript :: Bool -> A.Variable -> [A.Expression] -> CGen (), + genAssert :: Meta -> A.Expression -> CGen (), + -- | Generates an assignment statement with a single destination and single source. + genAssign :: Meta -> [A.Variable] -> A.ExpressionList -> CGen (), + -- | Generates the number of bytes in a fixed size type, fails if a free dimension is present and is not allowed. + -- The Either parameter is either an array variable (to use the _sizes array of) or a boolean specifying + -- wheter or not one free dimension is allowed (True <=> allowed). + genBytesIn :: Meta -> A.Type -> Either Bool A.Variable -> CGen (), + -- | Generates a case statement over the given expression with the structured as the body. + genCase :: Meta -> A.Expression -> A.Structured A.Option -> CGen (), + genCheckedConversion :: Meta -> A.Type -> A.Type -> CGen () -> CGen (), + genClearMobile :: Meta -> A.Variable -> CGen (), + genConversion :: Meta -> A.ConversionMode -> A.Type -> A.Expression -> CGen (), + genConversionSymbol :: A.Type -> A.Type -> A.ConversionMode -> CGen (), + genDecl :: A.AbbrevMode -> A.Type -> A.Name -> CGen (), + genDeclType :: A.AbbrevMode -> A.Type -> CGen (), + -- | 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). + genDeclaration :: A.Type -> A.Name -> Bool -> CGen (), + genDirectedVariable :: CGen () -> A.Direction -> CGen (), + genDyadic :: Meta -> A.DyadicOp -> A.Expression -> A.Expression -> CGen (), + genExpression :: A.Expression -> CGen (), + genFlatArraySize :: [A.Dimension] -> CGen (), + genFormal :: A.Formal -> CGen (), + genFormals :: [A.Formal] -> CGen (), + genForwardDeclaration :: A.Specification -> CGen(), + genFuncDyadic :: Meta -> String -> A.Expression -> A.Expression -> CGen (), + genFuncMonadic :: Meta -> String -> A.Expression -> CGen (), + -- | Gets the current time into the given variable + genGetTime :: Meta -> A.Variable -> CGen (), + -- | Generates an IF statement (which can have replicators, specifications and such things inside it). + genIf :: Meta -> A.Structured A.Choice -> CGen (), + genInput :: A.Variable -> A.InputMode -> CGen (), + genInputItem :: A.Variable -> A.InputItem -> CGen (), + genIntrinsicFunction :: Meta -> String -> [A.Expression] -> CGen (), + genIntrinsicProc :: Meta -> String -> [A.Actual] -> CGen (), + genLiteral :: A.LiteralRepr -> CGen (), + genLiteralRepr :: A.LiteralRepr -> CGen (), + genMissing :: String -> CGen (), + genMissingC :: CGen String -> CGen (), + genMonadic :: Meta -> A.MonadicOp -> A.Expression -> CGen (), + -- | Generates an output statement. + genOutput :: A.Variable -> [A.OutputItem] -> CGen (), + -- | Generates an output statement for a tagged protocol. + genOutputCase :: A.Variable -> A.Name -> [A.OutputItem] -> CGen (), + -- | Generates an output for an individual item. + genOutputItem :: A.Variable -> A.OutputItem -> CGen (), + -- | Generates a loop that maps over every element in a (potentially multi-dimensional) array + genOverArray :: Meta -> A.Variable -> (SubscripterFunction -> Maybe (CGen ())) -> CGen (), + genPar :: A.ParMode -> A.Structured A.Process -> CGen (), + genProcCall :: A.Name -> [A.Actual] -> CGen (), + genProcess :: A.Process -> CGen (), + -- | Generates a replicator loop, given the replicator and body + genReplicator :: A.Replicator -> CGen () -> CGen (), + -- | Generates the three bits of a for loop (e.g. "int i=0;i<10;i++" for the given replicator + genReplicatorLoop :: A.Replicator -> CGen (), + genRetypeSizes :: Meta -> A.Type -> A.Name -> A.Type -> A.Variable -> CGen (), + genSeq :: A.Structured A.Process -> CGen (), + genSimpleDyadic :: String -> A.Expression -> A.Expression -> CGen (), + genSimpleMonadic :: String -> A.Expression -> CGen (), + genSizeSuffix :: String -> CGen (), + genSlice :: A.Variable -> A.Expression -> A.Expression -> [A.Dimension] -> (CGen (), A.Name -> CGen ()), + genSpec :: A.Specification -> CGen () -> CGen (), + genSpecMode :: A.SpecMode -> CGen (), + -- | Generates a STOP process that uses the given Meta tag and message as its printed message. + genStop :: Meta -> String -> CGen (), + genStructured :: forall a. Data a => A.Structured a -> (Meta -> a -> CGen ()) -> CGen (), + genTLPChannel :: TLPChannel -> CGen (), + genTimerRead :: A.Variable -> A.Variable -> CGen (), + genTimerWait :: A.Expression -> CGen (), + genTopLevel :: A.AST -> CGen (), + -- | Generates the type as it might be used in a cast expression + genType :: A.Type -> CGen (), + genTypeSymbol :: String -> A.Type -> CGen (), + genUnfoldedExpression :: A.Expression -> CGen (), + genUnfoldedVariable :: Meta -> A.Variable -> CGen (), + -- | Generates a variable, with indexing checks if needed + genVariable :: A.Variable -> CGen (), + genVariableAM :: A.Variable -> A.AbbrevMode -> CGen (), + -- | Generates a variable, with no indexing checks anywhere + genVariableUnchecked :: A.Variable -> CGen (), + -- | Performs a wait for\/until (depending on the 'A.WaitMode') a specified time + genWait :: A.WaitMode -> A.Expression -> CGen (), + -- | Generates a while loop with the given condition and body. + genWhile :: A.Expression -> A.Process -> CGen (), + getScalarType :: A.Type -> Maybe String, + introduceSpec :: A.Specification -> CGen (), + removeSpec :: A.Specification -> CGen () + } + +-- | Call an operation in GenOps. +class CGenCall a where + call :: (GenOps -> a) -> a + +instance CGenCall (a -> CGen z) where +-- call :: (a -> CGen b) -> a -> CGen b + call f x0 = do ops <- ask + f ops x0 + +instance CGenCall (a -> b -> CGen z) where + call f x0 x1 + = do ops <- ask + f ops x0 x1 + +instance CGenCall (a -> b -> c -> CGen z) where + call f x0 x1 x2 + = do ops <- ask + f ops x0 x1 x2 + +instance CGenCall (a -> b -> c -> d -> CGen z) where + call f x0 x1 x2 x3 + = do ops <- ask + f ops x0 x1 x2 x3 + +instance CGenCall (a -> b -> c -> d -> e -> CGen z) where + call f x0 x1 x2 x3 x4 + = do ops <- ask + f ops x0 x1 x2 x3 x4 + +-- A bit of a mind-boggler, but this is essentially for genSlice +instance CGenCall (a -> b -> c -> d -> (CGen x, y -> CGen z)) where + call f x0 x1 x2 x3 + = (do ops <- ask + fst $ f ops x0 x1 x2 x3 + ,\y -> do ops <- ask + (snd $ f ops x0 x1 x2 x3) y + ) + +fget :: (GenOps -> a) -> CGen a +fget = asks + diff --git a/backends/GenerateCPPCSP.hs b/backends/GenerateCPPCSP.hs index 23d79fd..ad1969c 100644 --- a/backends/GenerateCPPCSP.hs +++ b/backends/GenerateCPPCSP.hs @@ -81,6 +81,7 @@ import qualified AST as A import CompState import Errors import GenerateC +import GenerateCBased import Metadata import Pass import ShowCode diff --git a/backends/GenerateCTest.hs b/backends/GenerateCTest.hs index ca16604..353fac9 100644 --- a/backends/GenerateCTest.hs +++ b/backends/GenerateCTest.hs @@ -45,6 +45,7 @@ import qualified AST as A import CompState import Errors import GenerateC +import GenerateCBased import GenerateCPPCSP import Metadata import TestUtils