{-# LANGUAGE TypeSynonymInstances #-}

module Feldspar.Compiler.Backend.C.Options where


import Feldspar.Compiler.Imperative.Representation


data Options =
    Options
    { platform          :: Platform
    , unroll            :: UnrollStrategy
    , debug             :: DebugOption
    , defaultArraySize  :: Int
    } deriving (Eq, Show)


data UnrollStrategy = NoUnroll | Unroll Int
    deriving (Eq, Show)


data DebugOption = NoDebug | NoPrimitiveInstructionHandling
    deriving (Eq, Show)



data Platform = Platform {
    name        :: String,
    types       :: [(Type, String, String)],
    values      :: [(Type, ShowValue)],
    primitives  :: [(FeldPrimDesc, Either CPrimDesc TransformPrim)],
    includes    :: [String],
    isRestrict  :: IsRestrict
} deriving (Eq, Show)


data FeldPrimDesc = FeldPrimDesc {
    fName   :: String,
    inputs  :: [TypeDesc]
} deriving (Eq, Show)


data CPrimDesc = Op1 {
    cOp         :: String
} | Op2 {
    cOp         :: String
} | Fun {
    cName       :: String,
    funPf       :: FunPostfixDescr
} | Proc {
    cName       :: String,
    funPf       :: FunPostfixDescr
} | Assig
  | Cas
  | InvalidDesc
  deriving (Eq, Show)


data TypeDesc
    = AllT
    | BoolT
    | RealT
    | FloatT
    | IntT | IntTS | IntTU | IntTS_ Size | IntTU_ Size | IntT_ Size
    | ComplexT TypeDesc
    | UserT String
  deriving (Eq, Show)


data FunPostfixDescr = FunPostfixDescr {
    useInputs   :: Int,
    useOutputs  :: Int
} deriving (Eq, Show)

noneFP      = FunPostfixDescr 0 0
firstInFP   = FunPostfixDescr 1 0
firstOutFP  = FunPostfixDescr 0 1


type ShowValue = Constant () -> String

instance Eq ShowValue where
    (==) _ _ = True

instance Show ShowValue where
    show _ = "<<ShowValue>>"


type TransformPrim
    = FeldPrimDesc
    -> [Expression ()]
    -> Type
    -> PrgDesc

instance Eq TransformPrim where
    (==) _ _ = True

instance Show TransformPrim where
    show _ = "<<TransformPrim>>"


data PrgDesc
    = PrgDesc [Crt] [Line] Rgt
  deriving (Eq, Show)

data Crt
    = Crt Type Var (Maybe Rgt)
  deriving (Eq, Show)

data Line
    = Asg Var Rgt
    | Prc CPrimDesc [Rgt] [Var]
  deriving (Eq, Show)

data Rgt
    = Exp (Expression ())
    | Fnc CPrimDesc [Rgt] Type
    | VarR Var
  deriving (Eq, Show)

data Var
    = Var String
  deriving (Eq, Show)

data IsRestrict = Restrict | NoRestrict
    deriving (Show,Eq)

machTypes :: TypeDesc -> Type -> Bool
machTypes AllT _                    = True
machTypes BoolT BoolType            = True
machTypes RealT FloatType           = True
machTypes RealT (NumType _ _)       = True
machTypes FloatT FloatType          = True
machTypes IntT (NumType _ _)        = True
machTypes IntTS (NumType Signed _)            = True
machTypes IntTU (NumType Unsigned _)          = True
machTypes (IntTS_ s) (NumType Signed s')      = s == s'
machTypes (IntTU_ s) (NumType Unsigned s')    = s == s'
machTypes (IntT_ s) (NumType _ s')            = s == s'
machTypes (ComplexT a) (ComplexType a')       = machTypes a a'
machTypes (UserT s) (UserType s')   = s == s'
machTypes _ _                       = False