--
-- Copyright (c) 2009-2010, ERICSSON AB All rights reserved.
-- 
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are met:
-- 
--     * Redistributions of source code must retain the above copyright notice,
--       this list of conditions and the following disclaimer.
--     * Redistributions in binary form must reproduce the above copyright
--       notice, this list of conditions and the following disclaimer in the
--       documentation and/or other materials provided with the distribution.
--     * Neither the name of the ERICSSON AB nor the names of its contributors
--       may be used to endorse or promote products derived from this software
--       without specific prior written permission.
-- 
-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
-- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS
-- BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY,
-- OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
-- THE POSSIBILITY OF SUCH DAMAGE.
--

{-# LANGUAGE TypeFamilies #-}

module Feldspar.Compiler.Imperative.Representation where

import Feldspar.Compiler.Imperative.Semantics

-- ====================================================================================================
--   == Representation of imperative programs
-- ====================================================================================================
data (SemanticInfo t) => Procedure t = Procedure {
    procedureName                            :: String,
    inParameters                             :: [FormalParameter t],
    outParameters                            :: [FormalParameter t],
    procedureBody                            :: Block t,
    procedureSemInf                          :: ProcedureInfo t
} deriving (Eq, Show)

data (SemanticInfo t) => Block t = Block {
    blockDeclarations                        :: [LocalDeclaration t],
    blockInstructions                        :: Program t,
    blockSemInf                              :: BlockInfo t
} deriving (Eq, Show)

data (SemanticInfo t) => Program t = Program {
    programConstruction                      :: ProgramConstruction t,
    programSemInf                            :: ProgramInfo t
} deriving (Eq, Show)

data (SemanticInfo t) => ProgramConstruction t = 
      EmptyProgram (Empty t)
    | PrimitiveProgram (Primitive t)
    | SequenceProgram (Sequence t)
    | BranchProgram (Branch t)
    | SequentialLoopProgram (SequentialLoop t)
    | ParallelLoopProgram (ParallelLoop t)
    deriving (Eq, Show)

data (SemanticInfo t) => Empty t = Empty {
    emptySemInf                              :: EmptyInfo t
} deriving (Eq, Show)

data (SemanticInfo t) => Primitive t = Primitive {
    primitiveInstruction                     :: Instruction t,
    primitiveSemInf                          :: PrimitiveInfo t
} deriving (Eq, Show)

data (SemanticInfo t) => Sequence t = Sequence {
    sequenceProgramList                      :: [Program t],
    sequenceSemInf                           :: SequenceInfo t
} deriving (Eq, Show)

data (SemanticInfo t) => Branch t = Branch {
    branchConditionVariable                  :: Variable t,
    thenBlock                                :: Block t,
    elseBlock                                :: Block t,
    branchSemInf                             :: BranchInfo t
} deriving (Eq, Show)

data (SemanticInfo t) => SequentialLoop t = SequentialLoop {
    sequentialLoopCondition                  :: Expression t,
    conditionCalculation                     :: Block t,
    sequentialLoopCore                       :: Block t,
    sequentialLoopSemInf                     :: SequentialLoopInfo t
} deriving (Eq, Show)

data (SemanticInfo t) => ParallelLoop t = ParallelLoop {
    parallelLoopConditionVariable            :: Variable t,
    numberOfIterations                       :: Expression t,
    parallelLoopStep                         :: Int,
    parallelLoopCore                         :: Block t,
    parallelLoopSemInf                       :: ParallelLoopInfo t
} deriving (Eq, Show)

data (SemanticInfo t) => FormalParameter t = FormalParameter {
    formalParameterVariable                  :: Variable t,
    formalParameterSemInf                    :: FormalParameterInfo t
} deriving (Eq, Show)

data (SemanticInfo t) => LocalDeclaration t = LocalDeclaration {
    localVariable                            :: Variable t,
    localInitValue                           :: Maybe (Expression t),
    localDeclarationSemInf                   :: LocalDeclarationInfo t
} deriving (Eq, Show)

data (SemanticInfo t) => Expression t = Expression {
    expressionData                           :: ExpressionData t,
    expressionSemInf                         :: ExpressionInfo t
} deriving (Eq, Show)

data (SemanticInfo t) => ExpressionData t = 
      LeftValueExpression (LeftValue t)
    | ConstantExpression (Constant t)
    | FunctionCallExpression (FunctionCall t)
    deriving (Eq, Show)

data (SemanticInfo t) => Constant t = Constant {
    constantData                             :: ConstantData t,
    constantSemInf                           :: ConstantInfo t
} deriving (Eq, Show)

data (SemanticInfo t) => FunctionCall t = FunctionCall {
    roleOfFunctionToCall                     :: FunctionRole,
    typeOfFunctionToCall                     :: Type,
    nameOfFunctionToCall                     :: String,
    actualParametersOfFunctionToCall         :: [Expression t],
    functionCallSemInf                       :: FunctionCallInfo t
} deriving (Eq, Show)

data (SemanticInfo t) => LeftValue t = LeftValue {
    leftValueData                            :: LeftValueData t,
    leftValueSemInf                          :: LeftValueInfo t
} deriving (Eq, Show)

data (SemanticInfo t) => LeftValueData t = 
      VariableLeftValue (Variable t)
    | ArrayElemReferenceLeftValue (ArrayElemReference t)
    deriving (Eq, Show)

data (SemanticInfo t) => ArrayElemReference t = ArrayElemReference {
    arrayName                                :: LeftValue t,
    arrayIndex                               :: Expression t,
    arrayElemReferenceSemInf                 :: ArrayElemReferenceInfo t
} deriving (Eq, Show)

data (SemanticInfo t) => Instruction t = Instruction {
    instructionData                          :: InstructionData t,
    instructionSemInf                        :: InstructionInfo t
} deriving (Eq, Show)

data (SemanticInfo t) => InstructionData t = 
      AssignmentInstruction (Assignment t)
    | ProcedureCallInstruction (ProcedureCall t)
    deriving (Eq, Show)

data (SemanticInfo t) => Assignment t = Assignment {
    assignmentLhs                            :: LeftValue t,
    assignmentRhs                            :: Expression t,
    assignmentSemInf                         :: AssignmentInfo t
} deriving (Eq, Show)

data (SemanticInfo t) => ProcedureCall t = ProcedureCall {
    nameOfProcedureToCall                    :: String,
    actualParametersOfProcedureToCall        :: [ActualParameter t],
    procedureCallSemInf                      :: ProcedureCallInfo t
} deriving (Eq, Show)

data (SemanticInfo t) => ActualParameter t = ActualParameter {
    actualParameterData                      :: ActualParameterData t,
    actualParameterSemInf                    :: ActualParameterInfo t
} deriving (Eq, Show)

data (SemanticInfo t) => ActualParameterData t = 
      InputActualParameter (Expression t)
    | OutputActualParameter (LeftValue t)
    deriving (Eq, Show)

data (SemanticInfo t) => ConstantData t = 
      IntConstant (IntConstantType t)
    | FloatConstant (FloatConstantType t)
    | BoolConstant (BoolConstantType t)
    | ArrayConstant (ArrayConstantType t)
    deriving (Eq, Show)

data (SemanticInfo t) => IntConstantType t = IntConstantType {
    intConstantValue                         :: Int,
    intConstantSemInf                        :: IntConstantInfo t
} deriving (Eq, Show)

data (SemanticInfo t) => FloatConstantType t = FloatConstantType {
    floatConstantValue                       :: Float,
    floatConstantSemInf                      :: FloatConstantInfo t
} deriving (Eq, Show)

data (SemanticInfo t) => BoolConstantType t = BoolConstantType {
    boolConstantValue                        :: Bool,
    boolConstantSemInf                       :: BoolConstantInfo t
} deriving (Eq, Show)

data (SemanticInfo t) => ArrayConstantType t = ArrayConstantType {
    arrayConstantValue                       :: [Constant t],
    arrayConstantSemInf                      :: ArrayConstantInfo t
} deriving (Eq, Show)

data (SemanticInfo t) => Variable t = Variable {
    variableRole                             :: VariableRole,
    variableType                             :: Type,
    variableName                             :: String,
    variableSemInf                           :: VariableInfo t
} deriving (Eq, Show)


-- ========================= [ Basic structures ] ============================

data Length = Norm Int | Defined Int | Undefined  
    deriving (Eq,Show)

data Size = S8 | S16 | S32 | S40 | S64
    deriving (Eq,Show)

data Signedness = ImpSigned | ImpUnsigned
    deriving (Eq,Show)

data Type = BoolType | FloatType | Numeric Signedness Size | ImpArrayType Length Type | UserType String
    deriving (Eq,Show)
    
data FunctionRole = SimpleFun | InfixOp | PrefixOp
    deriving (Eq,Show)

data VariableRole = Value {- input of main & local -} | FunOut {- output of main -}
    deriving (Eq,Show)