{-
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 <http://www.gnu.org/licenses/>.
-}

-- | The function dictionary and various types and helper functions for backends based around C
module GenerateCBased where

import Control.Monad.Error
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Writer
import Data.Generics
import System.IO

import qualified AST as A
import CompState
import Errors
import Metadata
import Pass
import qualified Properties as Prop

cCppCommonPreReq :: [Property]
cCppCommonPreReq =
 [Prop.afterRemoved
 ,Prop.arrayLiteralsExpanded
 ,Prop.assignFlattened
 ,Prop.assignParRemoved
 ,Prop.freeNamesToArgs
 ,Prop.functionCallsRemoved
 ,Prop.functionsRemoved
 ,Prop.inputCaseRemoved
 ,Prop.mainTagged
 ,Prop.nestedPulled
 ,Prop.outExpressionRemoved
 ,Prop.parsWrapped
 ,Prop.parUsageChecked
 ,Prop.subscriptsPulledUp
 ,Prop.typesResolvedInAST
 ,Prop.typesResolvedInState
 ]


--{{{  monad definition
type CGen' = StateT (Either [String] Handle) PassM
type CGen = ReaderT GenOps CGen'

instance Die CGen where
  dieReport err = lift $ lift $ dieReport err
  
instance CSMR CGen' where
  getCompState = lift getCompState

instance CSMR CGen where
  getCompState = lift getCompState

tell :: [String] -> CGen ()
tell x = do st <- get
            case st of
                Left prev -> put $ Left (prev ++ x)
                Right h -> liftIO $ mapM_ (hPutStr h) x

csmLift :: PassM a -> CGen a
csmLift = lift . lift
--}}}

-- | 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 {
    -- | 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 (CGen ()),
    -- | Generates an individual parameter to a function\/proc.
    genActual :: A.Formal -> A.Actual -> CGen (),
    -- | Generates the list of actual parameters to a function\/proc.
    genActuals :: [A.Formal] -> [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 (),
    -- | Writes out the actual data storage array name.
    genArrayStoreName :: A.Name -> CGen(),
    -- | Generates an array subscript for the given variable (with error checking according to the first variable), using the given expression list as subscripts
    genArraySubscript :: A.SubscriptCheck -> A.Variable -> [(Meta, CGen ())] -> 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 (),
    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 :: 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 (),
    genListAssign :: A.Variable -> A.Expression -> CGen (),
    genListConcat :: A.Expression -> A.Expression -> CGen (),
    genListLiteral :: [A.Expression] -> A.Type -> CGen (),
    genListSize :: A.Variable -> CGen (),
    genLiteral :: A.LiteralRepr -> A.Type -> CGen (),
    genLiteralRepr :: A.LiteralRepr -> A.Type -> 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 (),
    genRecordTypeSpec :: A.Name -> Bool -> [(A.Name, A.Type)] -> 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 (),
    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 (),
    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 (),
    -- | 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

fget :: (GenOps -> a) -> CGen a
fget = asks

generate :: GenOps -> Handle -> A.AST -> PassM ()
generate ops h ast = evalStateT (runReaderT (call genTopLevel ast) ops) (Right h)