{-# LANGUAGE TypeFamilies, UndecidableInstances, OverlappingInstances #-}
module Feldspar.Compiler.Imperative.Representation where

-- ===============================================================================================
-- == Class defining semantic information attached to different nodes in the imperative program ==
-- ===============================================================================================

class Annotation t s where
    type Label t s

instance Annotation () s where
    type Label () s = ()

-- =================================================
-- == Data stuctures to store imperative programs ==
-- =================================================

data Module t = Module
    { definitions                   :: [Definition t]
    , moduleLabel                   :: Label t Module
    }

deriving instance (ShowLabel t) => Show (Module t)
deriving instance (EqLabel t)   => Eq (Module t) 

data Definition t
    = Struct
        { structName                :: String
        , structMembers             :: [StructMember t]
        , structLabel               :: Label t Struct
        , definitionLabel           :: Label t Definition
        }
    | Union
        { unionName                 :: String
        , unionMembers              :: [UnionMember t]
        , unionLabel                :: Label t Union
        , definitionLabel           :: Label t Definition
        }
    | Procedure
        { procName                  :: String
        , inParams                  :: [Variable t]
        , outParams                 :: [Variable t]
        , procBody                  :: Block t
        , procLabel                 :: Label t Procedure
        , definitionLabel           :: Label t Definition
        }
    | Prototype
        { protoReturnType           :: Type
        , protoName                 :: String
        , inParams                  :: [Variable t]
        , outParams                 :: [Variable t]
        , protoLabel                :: Label t Prototype
        , definitionLabel           :: Label t Definition
        }
    | GlobalVar
        { globalVarDecl             :: Declaration t
        , globalVarDeclLabel        :: Label t GlobalVar
        , definitionLabel           :: Label t Definition
        }
   

deriving instance (ShowLabel t) => Show (Definition t)
deriving instance (EqLabel t)   => Eq (Definition t) 

data StructMember t = StructMember
    { structMemberName              :: String
    , structMemberType              :: Type
    , structMemberLabel             :: Label t StructMember
    }

data UnionMember t = UnionMember
    { unionMemberName               :: String
    , unionMemberType               :: Type
    , unionMemberLabel              :: Label t UnionMember
    }


deriving instance (ShowLabel t) => Show (StructMember t)
deriving instance (EqLabel t)   => Eq (StructMember t)
deriving instance (ShowLabel t) => Show (UnionMember t)
deriving instance (EqLabel t)   => Eq (UnionMember t)

data Block t = Block
    { locals                        :: [Declaration t]
    , blockBody                     :: Program t
    , blockLabel                    :: Label t Block
    }

deriving instance (ShowLabel t) => Show (Block t)
deriving instance (EqLabel t)   => Eq (Block t)

data Program t
    = Empty
        { emptyLabel                :: Label t Empty
        , programLabel              :: Label t Program
        }
    | Comment
        { isBlockComment            :: Bool
        , commentValue              :: String
        , commentLabel              :: Label t Comment
        , programLabel              :: Label t Program
        }
    | Assign
        { lhs                       :: Expression t
        , rhs                       :: Expression t
        , assignLabel               :: Label t Assign
        , programLabel              :: Label t Program
        }
    | ProcedureCall
        { procCallName              :: String
        , procCallParams            :: [ActualParameter t]
        , procCallLabel             :: Label t ProcedureCall
        , programLabel              :: Label t Program
        }
    | Sequence
        { sequenceProgs             :: [Program t]
        , sequenceLabel             :: Label t Sequence
        , programLabel              :: Label t Program
        }
    | Branch
        { branchCond                :: Expression t
        , thenBlock                 :: Block t
        , elseBlock                 :: Block t
        , branchLabel               :: Label t Branch
        , programLabel              :: Label t Program
        }
    | Switch
        { switchCond                :: Expression t
        , switchCases               :: [SwitchCase t]
        , switchLabel               :: Label t Switch
        , programLabel              :: Label t Program
        }
    | SeqLoop
        { sLoopCond                 :: Expression t
        , sLoopCondCalc             :: Block t
        , sLoopBlock                :: Block t
        , sLoopLabel                :: Label t SeqLoop
        , programLabel              :: Label t Program
        }
    | ParLoop
        { pLoopCounter              :: Variable t
        , pLoopBound                :: Expression t
        , pLoopStep                 :: Int
        , pLoopBlock                :: Block t
        , pLoopLabel                :: Label t ParLoop
        , programLabel              :: Label t Program
        }
    | BlockProgram
        { blockProgram              :: Block t
        , programLabel              :: Label t Program
        }

deriving instance (ShowLabel t) => Show (Program t)
deriving instance (EqLabel t)   => Eq (Program t)

data SwitchCase t = SwitchCase
    { switchCasePattern             :: Constant t
    , switchCaseImpl                :: Block t
    , switchCaseLabel               :: Label t SwitchCase
    }

deriving instance (ShowLabel t) => Show (SwitchCase t)
deriving instance (EqLabel t)   => Eq (SwitchCase t)

data ActualParameter t
    = In
        { inParam                   :: Expression t
        , actParamLabel             :: Label t ActualParameter
        }
    | Out
        { outParam                  :: Expression t
        , actParamLabel             :: Label t ActualParameter
        }

deriving instance (ShowLabel t) => Show (ActualParameter t)
deriving instance (EqLabel t)   => Eq (ActualParameter t)

data Declaration t = Declaration
    { declVar                       :: Variable t
    , initVal                       :: Maybe (Expression t)
    , declLabel                     :: Label t Declaration
    }

deriving instance (ShowLabel t) => Show (Declaration t)
deriving instance (EqLabel t)   => Eq (Declaration t)

data Expression t
    = VarExpr
        { var                       :: Variable t
        , exprLabel                 :: Label t Expression
        }
    | ArrayElem
        { array                     :: Expression t
        , arrayIndex                :: Expression t
        , arrayLabel                :: Label t ArrayElem
        , exprLabel                 :: Label t Expression
        }
    | StructField
        { struct                    :: Expression t
        , fieldName                 :: String
        , structFieldLabel          :: Label t StructField
        , exprLabel                 :: Label t Expression
        }
    | UnionField
        { union                     :: Expression t
        , fieldName                 :: String
        , unionFieldLabel           :: Label t UnionField
        , exprLabel                 :: Label t Expression
        }
    | ConstExpr
        { constExpr                 :: Constant t
        , exprLabel                 :: Label t Expression
        }
    | FunctionCall
        { funCallName               :: String
        , returnType                :: Type
        , funRole                   :: FunctionRole
        , funCallParams             :: [Expression t]
        , funCallLabel              :: Label t FunctionCall
        , exprLabel                 :: Label t Expression
        }
    | Cast
        { castType                  :: Type
        , castExpr                  :: Expression t
        , castLabel                 :: Label t Cast
        , exprLabel                 :: Label t Expression
        }
    | SizeOf
        { sizeOf                    :: Either Type (Expression t)
        , sizeOfLabel               :: Label t SizeOf
        , exprLabel                 :: Label t Expression
        }

deriving instance (ShowLabel t) => Show (Expression t)
deriving instance (EqLabel t)   => Eq (Expression t)

data Constant t
    = IntConst
        { intValue                  :: Integer
        , intConstLabel             :: Label t IntConst
        , constLabel                :: Label t Constant
        }
    | FloatConst
        { floatValue                :: Double
        , floatConstLabel           :: Label t FloatConst
        , constLabel                :: Label t Constant
        }
    | BoolConst
        { boolValue                 :: Bool
        , boolConstLabel            :: Label t BoolConst
        , constLabel                :: Label t Constant
        }
    | ArrayConst
        { arrayValues               :: [Constant t]
        , arrayConstLabel           :: Label t ArrayConst
        , constLabel                :: Label t Constant
        }
    | ComplexConst
        { realPartComplexValue       :: Constant t
        , imagPartComplexValue       :: Constant t
        , complexConstLabel          :: Label t ComplexConst
        , constLabel                 :: Label t Constant
        }

deriving instance (ShowLabel t) => Show (Constant t)
deriving instance (EqLabel t)   => Eq (Constant t)

data Variable t = Variable
    { varName                        :: String
    , varType                        :: Type
    , varRole                        :: VariableRole
    , varLabel                       :: Label t Variable
    }

deriving instance (ShowLabel t) => Show (Variable t)
deriving instance (EqLabel t)   => Eq (Variable t)

-- ======================
-- == Basic structures ==
-- ======================

data Length =
      LiteralLen Int
    | IndirectLen String
    | UndefinedLen
    deriving (Eq,Show)

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

data Signedness = Signed | Unsigned
    deriving (Eq,Show)

data Type =
      VoidType
    | BoolType
    | BitType
    | FloatType
    | NumType Signedness Size
    | ComplexType Type
    | UserType String
    | ArrayType Length Type
    | StructType [(String, Type)]
    | UnionType [(String, Type)]
    deriving (Eq,Show)

data FunctionRole = SimpleFun | InfixOp | PrefixOp
    deriving (Eq,Show)

data VariableRole =
      Value
    | Pointer
    deriving (Eq,Show)

-- =====================
-- == Technical types ==
-- =====================

data Struct t
data Union t    
data Procedure t
data Prototype t
data GlobalVar t
data Empty t
data Comment t
data Assign t
data ProcedureCall t
data Sequence t
data Branch t
data Switch t
data SeqLoop t
data ParLoop t
data FunctionCall t
data Cast t
data SizeOf t
data ArrayElem t
data StructField t
data UnionField t
data LeftFunCall t
data IntConst t
data FloatConst t
data BoolConst t
data ArrayConst t
data ComplexConst t

-- ==========================
-- == Show and Eq instance ==
-- ==========================

class ( Show (Label t Module)
      , Show (Label t Definition)
      , Show (Label t Struct)
      , Show (Label t Union)
      , Show (Label t Procedure)
      , Show (Label t Prototype)
      , Show (Label t GlobalVar)
      , Show (Label t StructMember)
      , Show (Label t UnionMember)
      , Show (Label t Block)
      , Show (Label t Program)
      , Show (Label t Empty)
      , Show (Label t Comment)
      , Show (Label t Assign)
      , Show (Label t ProcedureCall)
      , Show (Label t Sequence)
      , Show (Label t Branch)
      , Show (Label t Switch)
      , Show (Label t SeqLoop)
      , Show (Label t ParLoop)
      , Show (Label t SwitchCase)
      , Show (Label t ActualParameter)
      , Show (Label t Declaration)
      , Show (Label t Expression)
      , Show (Label t FunctionCall)
      , Show (Label t Cast)
      , Show (Label t SizeOf)
      , Show (Label t ArrayElem)
      , Show (Label t StructField)
      , Show (Label t UnionField)
      , Show (Label t Constant)
      , Show (Label t IntConst)
      , Show (Label t FloatConst)
      , Show (Label t BoolConst)
      , Show (Label t ArrayConst)
      , Show (Label t ComplexConst)
      , Show (Label t Variable)
      ) => ShowLabel t

instance ( Show (Label t Module)
         , Show (Label t Definition)
         , Show (Label t Struct)
         , Show (Label t Union)
         , Show (Label t Procedure)
         , Show (Label t Prototype)
         , Show (Label t GlobalVar)
         , Show (Label t StructMember)
         , Show (Label t UnionMember)
         , Show (Label t Block)
         , Show (Label t Program)
         , Show (Label t Empty)
         , Show (Label t Comment)
         , Show (Label t Assign)
         , Show (Label t ProcedureCall)
         , Show (Label t Sequence)
         , Show (Label t Branch)
         , Show (Label t Switch)
         , Show (Label t SeqLoop)
         , Show (Label t ParLoop)
         , Show (Label t SwitchCase)
         , Show (Label t ActualParameter)
         , Show (Label t Declaration)
         , Show (Label t Expression)
         , Show (Label t FunctionCall)
         , Show (Label t Cast)
         , Show (Label t SizeOf)
         , Show (Label t ArrayElem)
         , Show (Label t StructField)
         , Show (Label t UnionField)
         , Show (Label t Constant)
         , Show (Label t IntConst)
         , Show (Label t FloatConst)
         , Show (Label t BoolConst)
         , Show (Label t ArrayConst)
         , Show (Label t ComplexConst)
         , Show (Label t Variable)
         ) => ShowLabel t

class ( Eq (Label t Module)
      , Eq (Label t Definition)
      , Eq (Label t Struct)
      , Eq (Label t Union)
      , Eq (Label t Procedure)
      , Eq (Label t Prototype)
      , Eq (Label t GlobalVar)
      , Eq (Label t StructMember)
      , Eq (Label t UnionMember)
      , Eq (Label t Block)
      , Eq (Label t Program)
      , Eq (Label t Empty)
      , Eq (Label t Comment)
      , Eq (Label t Assign)
      , Eq (Label t ProcedureCall)
      , Eq (Label t Sequence)
      , Eq (Label t Branch)
      , Eq (Label t Switch)
      , Eq (Label t SeqLoop)
      , Eq (Label t ParLoop)
      , Eq (Label t SwitchCase)
      , Eq (Label t ActualParameter)
      , Eq (Label t Declaration)
      , Eq (Label t Expression)
      , Eq (Label t FunctionCall)
      , Eq (Label t Cast)
      , Eq (Label t SizeOf)
      , Eq (Label t StructField)
      , Eq (Label t UnionField)
      , Eq (Label t ArrayElem)
      , Eq (Label t Constant)
      , Eq (Label t IntConst)
      , Eq (Label t FloatConst)
      , Eq (Label t BoolConst)
      , Eq (Label t ArrayConst)
      , Eq (Label t ComplexConst)
      , Eq (Label t Variable)
      ) => EqLabel t

instance ( Eq (Label t Module)
         , Eq (Label t Definition)
         , Eq (Label t Struct)
         , Eq (Label t Union)
         , Eq (Label t Procedure)
         , Eq (Label t Prototype)
         , Eq (Label t GlobalVar)
         , Eq (Label t StructMember)
         , Eq (Label t UnionMember)
         , Eq (Label t Block)
         , Eq (Label t Program)
         , Eq (Label t Empty)
         , Eq (Label t Comment)
         , Eq (Label t Assign)
         , Eq (Label t ProcedureCall)
         , Eq (Label t Sequence)
         , Eq (Label t Branch)
         , Eq (Label t Switch)
         , Eq (Label t SeqLoop)
         , Eq (Label t ParLoop)
         , Eq (Label t SwitchCase)
         , Eq (Label t ActualParameter)
         , Eq (Label t Declaration)
         , Eq (Label t Expression)
         , Eq (Label t FunctionCall)
         , Eq (Label t Cast)
         , Eq (Label t SizeOf)
         , Eq (Label t StructField)
         , Eq (Label t UnionField)
         , Eq (Label t ArrayElem)
         , Eq (Label t Constant)
         , Eq (Label t IntConst)
         , Eq (Label t FloatConst)
         , Eq (Label t BoolConst)
         , Eq (Label t ArrayConst)
         , Eq (Label t ComplexConst)
         , Eq (Label t Variable)
         ) => EqLabel t