--
-- 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.
--

module Feldspar.Compiler.Options where


import Feldspar.Compiler.Imperative.Representation
import Feldspar.Compiler.Imperative.Semantics(IsRestrict, PrettyPrintSemanticInfo)



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 | NoSimplification | 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
  | InvalidDesc
  deriving (Eq, Show)


data TypeDesc
    = AllT
    | BoolT
    | FloatT
    | IntT | IntTS | IntTU | IntTS_ Size | IntTU_ Size | IntT_ Size
    | 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 = (ConstantData PrettyPrintSemanticInfo -> String)

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

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


type TransformPrim
    = FeldPrimDesc
    -> [Expression ()]
    -> [LeftValue ()]
    -> [(CPrimDesc, [Expression ()], [LeftValue ()])]

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

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



machTypes :: TypeDesc -> Type -> Bool
machTypes AllT _                    = True
machTypes BoolT BoolType            = True
machTypes FloatT FloatType          = True
machTypes IntT (Numeric _ _)        = True
machTypes IntTS (Numeric ImpSigned _)         = True
machTypes IntTU (Numeric ImpUnsigned _)       = True
machTypes (IntTS_ s) (Numeric ImpSigned s')   = s == s'
machTypes (IntTU_ s) (Numeric ImpUnsigned s') = s == s'
machTypes (IntT_ s) (Numeric _ s')  = s == s'
machTypes (UserT s) (UserType s')   = s == s'
machTypes _ _                       = False