content: {-# LANGUAGE GADTs #-}
  
  -- | High-level translation of Copilot Core into C99.
  module Copilot.Compile.C99.CodeGen
      (
        -- * Externs
        mkExtCpyDecln
      , mkExtDecln
  
        -- * Type declarations
      , mkStructDecln
      , mkStructForwDecln
  
        -- * Ring buffers
      , mkBuffDecln
      , mkIndexDecln
      , mkAccessDecln
  
        -- * Stream generators
      , mkGenFun
      , mkGenFunArray
  
        -- * Monitor processing
      , mkStep
      )
    where
  
  -- External imports
  import           Control.Monad.State ( runState )
  import           Data.List           ( unzip4 )
  import qualified Data.List.NonEmpty  as NonEmpty
  import qualified Language.C99.Simple as C
  
  -- Internal imports: Copilot
  import Copilot.Core ( Expr (..), Id, Stream (..), Struct (..), Trigger (..),
                        Type (..), UExpr (..), Value (..), fieldName, typeSize )
  
  -- Internal imports
  import Copilot.Compile.C99.Error          ( impossible )
  import Copilot.Compile.C99.Expr           ( constArray, transExpr )
  import Copilot.Compile.C99.External       ( External (..) )
  import Copilot.Compile.C99.Name           ( argNames, argTempNames,
                                              generatorName, guardName,
                                              indexName, streamAccessorName,
                                              streamName )
  import Copilot.Compile.C99.Settings       ( CSettings,
                                              cSettingsStepFunctionName )
  import Copilot.Compile.C99.Type           ( transType )
  import Copilot.Compile.C99.Representation ( UniqueTrigger (..) )
  
  -- * Externs
  
  -- | Make a extern declaration of a variable.
  mkExtDecln :: External -> C.Decln
  mkExtDecln (External name _ ty) = decln
    where
      decln = C.VarDecln (Just C.Extern) cTy name Nothing
      cTy   = transType ty
  
  -- | Make a declaration for a copy of an external variable.
  mkExtCpyDecln :: External -> C.Decln
  mkExtCpyDecln (External _name cpyName ty) = decln
    where
      decln = C.VarDecln (Just C.Static) cTy cpyName Nothing
      cTy   = transType ty
  
  -- * Type declarations
  
  -- | Write a struct declaration based on its definition.
  mkStructDecln :: Struct a => Type a -> C.Decln
  mkStructDecln (Struct x) = C.TypeDecln struct
    where
      struct = C.TypeSpec $ C.StructDecln (Just $ typeName x) fields
      fields = NonEmpty.fromList $ map mkField (toValues x)
  
      mkField :: Value a -> C.FieldDecln
      mkField (Value ty field) = C.FieldDecln (transType ty) (fieldName field)
  
  -- | Write a forward struct declaration.
  mkStructForwDecln :: Struct a => Type a -> C.Decln
  mkStructForwDecln (Struct x) = C.TypeDecln struct
    where
      struct = C.TypeSpec $ C.Struct (typeName x)
  
  -- * Ring buffers
  
  -- | Make a C buffer variable and initialise it with the stream buffer.
  mkBuffDecln :: Id -> Type a -> [a] -> C.Decln
  mkBuffDecln sId ty xs = C.VarDecln (Just C.Static) cTy name initVals
    where
      name     = streamName sId
      cTy      = C.Array (transType ty) (Just $ C.LitInt $ fromIntegral buffSize)
      buffSize = length xs
      initVals = Just $ C.InitList $ constArray ty xs
  
  -- | Make a C index variable and initialise it to 0.
  mkIndexDecln :: Id -> C.Decln
  mkIndexDecln sId = C.VarDecln (Just C.Static) cTy name initVal
    where
      name    = indexName sId
      cTy     = C.TypeSpec $ C.TypedefName "size_t"
      initVal = Just $ C.InitExpr $ C.LitInt 0
  
  -- | Define an accessor functions for the ring buffer associated with a stream.
  mkAccessDecln :: Id -> Type a -> [a] -> C.FunDef
  mkAccessDecln sId ty xs =
      C.FunDef static cTy name params [] [C.Return (Just expr)]
    where
      static     = Just C.Static
      cTy        = C.decay $ transType ty
      name       = streamAccessorName sId
  
      -- We cast the buffer length to a size_t to make sure that there are no
      -- implicit conversions. This is a requirement for compliance with MISRA C
      -- (Rule 10.4).
      buffLength = C.Cast sizeT $ C.LitInt $ fromIntegral $ length xs
      sizeT      = C.TypeName $ C.TypeSpec $ C.TypedefName "size_t"
      params     = [C.Param (C.TypeSpec $ C.TypedefName "size_t") "x"]
      index      = (C.Ident (indexName sId) C..+ C.Ident "x") C..% buffLength
      expr       = C.Index (C.Ident (streamName sId)) index
  
  -- * Stream generators
  
  -- | Write a generator function for a stream.
  mkGenFun :: String -> Expr a -> Type a -> C.FunDef
  mkGenFun name expr ty =
      C.FunDef static cTy name [] cVars stmts
    where
      static             = Just C.Static
      cTy                = C.decay $ transType ty
      (cExpr, state')    = runState (transExpr expr) (0, mempty, mempty)
      (_, cVars, stmts') = state'
      stmts              = stmts' ++ [C.Return $ Just cExpr]
  
  -- | Write a generator function for a stream that returns an array.
  mkGenFunArray :: String -> String -> Expr a -> Type a -> C.FunDef
  mkGenFunArray name nameArg expr ty@(Array _) =
      C.FunDef static funType name [ outputParam ] varDecls stmts
    where
      static  = Just C.Static
      funType = C.TypeSpec C.Void
  
      -- The output value is an array
      outputParam = C.Param cArrayType nameArg
      cArrayType  = transType ty
  
      -- Statements to execute as part of the generator. They include statements
      -- related to calculating the values of intermediate expressions, and
      -- statements related to copying the final value to the destination array.
      stmts = stmts' ++ [ copyStmt ]
  
      -- Output value, variable declarations needed, and other statements that
      -- must be executed to calculate intermediate values.
      (cExpr, state')       = runState (transExpr expr) (0, mempty, mempty)
      (_, varDecls, stmts') = state'
  
      -- Copy expression to output argument.
      copyStmt = C.Expr $ memcpy (C.Ident nameArg) cExpr size
      size     = C.LitInt (fromIntegral $ typeSize ty)
                   C..* C.SizeOfType (C.TypeName $ tyElemName ty)
  
  mkGenFunArray _name _nameArg _expr _ty =
    impossible "mkGenFunArray" "copilot-c99"
  
  -- * Monitor processing
  
  -- | Define the step function that updates all streams.
  mkStep :: CSettings -> [Stream] -> [UniqueTrigger] -> [External] -> C.FunDef
  mkStep cSettings streams triggers exts =
      C.FunDef Nothing void (cSettingsStepFunctionName cSettings) [] declns stmts
    where
      void = C.TypeSpec C.Void
  
      declns =  streamDeclns
             ++ concat triggerDeclns
  
      stmts  =  map mkExCopy exts
             ++ triggerStmts
             ++ tmpAssigns
             ++ bufferUpdates
             ++ indexUpdates
  
      (streamDeclns, tmpAssigns, bufferUpdates, indexUpdates) =
        unzip4 $ map mkUpdateGlobals streams
      (triggerDeclns, triggerStmts) =
        unzip $ map mkTriggerCheck triggers
  
      -- Update the value of a variable with the result of calling a function that
      -- generates the next value in a stream expression. If the type of the
      -- variable is an array, then we cannot perform a direct C assignment, so
      -- we instead pass the variable as an output array to the function.
      updateVar :: C.Ident -> C.Ident -> Type a -> C.Expr
      updateVar varName genName (Array _) =
        C.Funcall (C.Ident genName) [C.Ident varName]
      updateVar varName genName _ =
        C.AssignOp C.Assign (C.Ident varName) (C.Funcall (C.Ident genName) [])
  
      -- Write code to update global stream buffers and index.
      mkUpdateGlobals :: Stream -> (C.Decln, C.Stmt, C.Stmt, C.Stmt)
      mkUpdateGlobals (Stream sId buff _expr ty) =
        (tmpDecln, tmpAssign, bufferUpdate, indexUpdate)
          where
            tmpDecln = C.VarDecln Nothing cTy tmpVar Nothing
  
            tmpAssign = C.Expr $ updateVar tmpVar (generatorName sId) ty
  
            bufferUpdate = case ty of
              Array _ -> C.Expr $ memcpy dest (C.Ident tmpVar) size
                where
                  dest = C.Index buffVar indexVar
                  size = C.LitInt
                             (fromIntegral $ typeSize ty)
                             C..* C.SizeOfType (C.TypeName (tyElemName ty))
              _       -> C.Expr $
                             C.Index buffVar indexVar C..= C.Ident tmpVar
  
            indexUpdate = C.Expr $ indexVar C..= (incIndex C..% buffLength)
              where
                -- We cast the buffer length and the literal one to a size_t to
                -- make sure that there are no implicit conversions. This is a
                -- requirement for compliance with MISRA C (Rule 10.4).
                buffLength = C.Cast sizeT $ C.LitInt $ fromIntegral $ length buff
                incIndex   = indexVar C..+ C.Cast sizeT (C.LitInt 1)
                sizeT      = C.TypeName $ C.TypeSpec $ C.TypedefName "size_t"
  
            tmpVar   = streamName sId ++ "_tmp"
            buffVar  = C.Ident $ streamName sId
            indexVar = C.Ident $ indexName sId
            cTy      = transType ty
  
      -- Make code that copies an external variable to its local one.
      mkExCopy :: External -> C.Stmt
      mkExCopy (External name cpyName ty) = C.Expr $ case ty of
        Array _ -> memcpy exVar locVar size
          where
            exVar  = C.Ident cpyName
            locVar = C.Ident name
            size   = C.LitInt (fromIntegral $ typeSize ty)
                       C..* C.SizeOfType (C.TypeName (tyElemName ty))
  
        _       -> C.Ident cpyName C..= C.Ident name
  
      -- Make if-statement to check the guard, call the handler if necessary.
      -- This returns two things:
      --
      -- * A list of Declns for temporary variables, one for each argument that
      --   the handler function accepts. For example, if a handler function takes
      --   three arguments, the list of Declns might look something like this:
      --
      --   @
      --   int8_t   handler_arg_temp0;
      --   int16_t  handler_arg_temp1;
      --   struct s handler_arg_temp2;
      --   @
      --
      -- * A Stmt representing the if-statement. Continuing the example above,
      --   the if-statement would look something like this:
      --
      --   @
      --   if (handler_guard()) {
      --     handler_arg_temp0 = handler_arg0();
      --     handler_arg_temp1 = handler_arg1();
      --     handler_arg_temp2 = handler_arg2();
      --     handler(handler_arg_temp0, handler_arg_temp1, &handler_arg_temp2);
      --   }
      --   @
      --
      -- We create temporary variables because:
      --
      -- 1. We want to pass structs by reference intead of by value. To this end,
      --    we use C's & operator to obtain a reference to a temporary variable
      --    of a struct type and pass that to the handler function.
      --
      -- 2. Assigning a struct to a temporary variable defensively ensures that
      --    any modifications that the handler called makes to the struct argument
      --    will not affect the internals of the monitoring code.
      mkTriggerCheck :: UniqueTrigger -> ([C.Decln], C.Stmt)
      mkTriggerCheck (UniqueTrigger uniqueName (Trigger name _guard args)) =
          (aTmpDeclns, triggerCheckStmt)
        where
          aTmpDeclns :: [C.Decln]
          aTmpDeclns = zipWith declare args aTempNames
            where
              declare :: UExpr -> C.Ident -> C.Decln
              declare (UExpr ty _) tmpVar =
                C.VarDecln Nothing (transType ty) tmpVar Nothing
  
          triggerCheckStmt :: C.Stmt
          triggerCheckStmt = C.If guard' fireTrigger
            where
              guard' = C.Funcall (C.Ident $ guardName uniqueName) []
  
              -- The body of the if-statement. This consists of statements that
              -- assign the values of the temporary variables, following by a
              -- final statement that passes the temporary variables to the
              -- handler function.
              -- Note that we call 'name' here instead of 'uniqueName', as 'name'
              -- is the name of the actual external function.
              fireTrigger =  map C.Expr argAssigns
                          ++ [C.Expr $
                                 C.Funcall (C.Ident name)
                                           (zipWith passArg aTempNames args)]
                where
                  -- List of assignments of values of temporary variables.
                  argAssigns :: [C.Expr]
                  argAssigns = zipWith3 assign aTempNames aArgNames args
  
                  assign :: C.Ident -> C.Ident -> UExpr -> C.Expr
                  assign aTempName aArgName (UExpr ty _) =
                    updateVar aTempName aArgName ty
  
                  aArgNames :: [C.Ident]
                  aArgNames = take (length args) (argNames uniqueName)
  
                  -- Build an expression to pass a temporary variable as argument
                  -- to a trigger handler.
                  --
                  -- We need to pass a reference to the variable in some cases,
                  -- so we also need the type of the expression, which is enclosed
                  -- in the second argument, an UExpr.
                  passArg :: String -> UExpr -> C.Expr
                  passArg aTempName (UExpr ty _) =
                    case ty of
                      -- Special case for Struct to pass reference to temporary
                      -- struct variable to handler. (See the comments for
                      -- mktriggercheck for details.)
                      Struct _ -> C.UnaryOp C.Ref $ C.Ident aTempName
                      _        -> C.Ident aTempName
  
          aTempNames :: [String]
          aTempNames = take (length args) (argTempNames uniqueName)
  
  -- * Auxiliary functions
  
  -- Write a call to the memcpy function.
  memcpy :: C.Expr -> C.Expr -> C.Expr -> C.Expr
  memcpy dest src size = C.Funcall (C.Ident "memcpy") [dest, src, size]
  
  -- Translate a Copilot type to a C99 type, handling arrays especially.
  --
  -- If the given type is an array (including multi-dimensional arrays), the
  -- type is that of the elements in the array. Otherwise, it is just the
  -- equivalent representation of the given type in C.
  tyElemName :: Type a -> C.Type
  tyElemName ty = case ty of
    Array ty' -> tyElemName ty'
    _         -> transType ty
  