-- This file is part of Hoppy.
--
-- Copyright 2015-2021 Bryan Gardiner <bog@khumba.net>
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU Affero General Public License for more details.
--
-- You should have received a copy of the GNU Affero General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

-- | Module for computed data for an interface.
module Foreign.Hoppy.Generator.Spec.Computed (
  ComputedInterfaceData (..),
  EvaluatedEnumData (..),
  EvaluatedEnumValueMap,
  getEvaluatedEnumData,
  -- * Numeric types
  NumericTypeInfo,
  numType, numBytes, numMinBound, numMaxBound,
  findNumericTypeInfo,
  pickNumericType,
  ) where

import qualified Data.Map as M
import Data.Map (Map)
import Data.Maybe (listToMaybe)
import Foreign.C (CInt, CLong, CLLong, CUInt, CULong, CULLong)
import Foreign.Hoppy.Generator.Spec.Base (ExtName, Type)
import Foreign.Hoppy.Generator.Types (intT, llongT, longT, uintT, ullongT, ulongT)
import Foreign.Storable (Storable, sizeOf)
import GHC.Stack (HasCallStack)

-- | Holds "computed data" for an interface.  This is data that is calculated by
-- Hoppy, beyond what is directly specified in the interface.
data ComputedInterfaceData = ComputedInterfaceData
  { ComputedInterfaceData -> String
computedInterfaceName :: String
    -- ^ The name of the interface.
  , ComputedInterfaceData -> Map ExtName EvaluatedEnumData
evaluatedEnumMap :: Map ExtName EvaluatedEnumData
    -- ^ Evaluated numeric types and values for all enums in the interface.
  }

-- | Information about the enum that has been completed beyond what the
-- interface definition provides, possibly by building actual C++ code.
data EvaluatedEnumData = EvaluatedEnumData
  { EvaluatedEnumData -> NumericTypeInfo
evaluatedEnumNumericType :: NumericTypeInfo
    -- ^ The numeric type that C++ uses to hold the enum's values, or an
    -- equivalently-sized type.
  , EvaluatedEnumData -> EvaluatedEnumValueMap
evaluatedEnumValueMap :: EvaluatedEnumValueMap
    -- ^ Calculated values for all of the enum's entries.
  } deriving (ReadPrec [EvaluatedEnumData]
ReadPrec EvaluatedEnumData
Int -> ReadS EvaluatedEnumData
ReadS [EvaluatedEnumData]
(Int -> ReadS EvaluatedEnumData)
-> ReadS [EvaluatedEnumData]
-> ReadPrec EvaluatedEnumData
-> ReadPrec [EvaluatedEnumData]
-> Read EvaluatedEnumData
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EvaluatedEnumData]
$creadListPrec :: ReadPrec [EvaluatedEnumData]
readPrec :: ReadPrec EvaluatedEnumData
$creadPrec :: ReadPrec EvaluatedEnumData
readList :: ReadS [EvaluatedEnumData]
$creadList :: ReadS [EvaluatedEnumData]
readsPrec :: Int -> ReadS EvaluatedEnumData
$creadsPrec :: Int -> ReadS EvaluatedEnumData
Read, Int -> EvaluatedEnumData -> ShowS
[EvaluatedEnumData] -> ShowS
EvaluatedEnumData -> String
(Int -> EvaluatedEnumData -> ShowS)
-> (EvaluatedEnumData -> String)
-> ([EvaluatedEnumData] -> ShowS)
-> Show EvaluatedEnumData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EvaluatedEnumData] -> ShowS
$cshowList :: [EvaluatedEnumData] -> ShowS
show :: EvaluatedEnumData -> String
$cshow :: EvaluatedEnumData -> String
showsPrec :: Int -> EvaluatedEnumData -> ShowS
$cshowsPrec :: Int -> EvaluatedEnumData -> ShowS
Show)

-- | Contains the numeric values for each of the entries in a C++ enum.
type EvaluatedEnumValueMap = Map [String] Integer

-- | Returns the map containing the calculated values for all entries in the
-- enum with the given 'ExtName'.  This requires hooks to have been run.
getEvaluatedEnumData ::
     HasCallStack
  => ComputedInterfaceData
  -> ExtName
  -> EvaluatedEnumData
getEvaluatedEnumData :: ComputedInterfaceData -> ExtName -> EvaluatedEnumData
getEvaluatedEnumData ComputedInterfaceData
computed ExtName
extName = case ExtName -> Map ExtName EvaluatedEnumData -> Maybe EvaluatedEnumData
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ExtName
extName (ComputedInterfaceData -> Map ExtName EvaluatedEnumData
evaluatedEnumMap ComputedInterfaceData
computed) of
  Maybe EvaluatedEnumData
Nothing -> String -> EvaluatedEnumData
forall a. HasCallStack => String -> a
error (String -> EvaluatedEnumData) -> String -> EvaluatedEnumData
forall a b. (a -> b) -> a -> b
$ String
"interfaceGetEvaluatedEnumData: No data found for " String -> ShowS
forall a. [a] -> [a] -> [a]
++
             ExtName -> String
forall a. Show a => a -> String
show ExtName
extName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" in interface '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ComputedInterfaceData -> String
computedInterfaceName ComputedInterfaceData
computed String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'."
  Just EvaluatedEnumData
info -> EvaluatedEnumData
info

-- | Bound information about numeric types.
data NumericTypeInfo = NumericTypeInfo
  { NumericTypeInfo -> Type
numType :: Type
    -- ^ The numeric data type described by the record.
  , NumericTypeInfo -> Int
numBytes :: Int
    -- ^ The number of bytes in a value of the type.
  , NumericTypeInfo -> Integer
numMinBound :: Integer
    -- ^ The lowest (most negative) value representable by the type.
  , NumericTypeInfo -> Integer
numMaxBound :: Integer
    -- ^ The highest (most positive) value representable by the type.
  }

instance Show NumericTypeInfo where
  show :: NumericTypeInfo -> String
show NumericTypeInfo
info = (Int, Integer, Integer) -> String
forall a. Show a => a -> String
show (NumericTypeInfo -> Int
numBytes NumericTypeInfo
info, NumericTypeInfo -> Integer
numMinBound NumericTypeInfo
info, NumericTypeInfo -> Integer
numMaxBound NumericTypeInfo
info)

instance Read NumericTypeInfo where
  readsPrec :: Int -> ReadS NumericTypeInfo
readsPrec Int
p String
s =
    case Int -> ReadS (Int, Integer, Integer)
forall a. Read a => Int -> ReadS a
readsPrec Int
p String
s of
      [((Int
bytes, Integer
minBound, Integer
maxBound), String
rest)] ->
        case Int -> Integer -> Integer -> Maybe NumericTypeInfo
pickNumericType Int
bytes Integer
minBound Integer
maxBound of
          Just NumericTypeInfo
info -> [(NumericTypeInfo
info, String
rest)]
          Maybe NumericTypeInfo
Nothing -> []
      [] -> []
      [((Int, Integer, Integer), String)]
other ->
        ReadS NumericTypeInfo
forall a. HasCallStack => String -> a
error ReadS NumericTypeInfo -> ReadS NumericTypeInfo
forall a b. (a -> b) -> a -> b
$ String
"Read NumericTypeInfo: Unexpected readsPrec result: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [((Int, Integer, Integer), String)] -> String
forall a. Show a => a -> String
show [((Int, Integer, Integer), String)]
other

-- | Numeric types usable to hold enum values.  These are ordered by decreasing
-- precedence (increasing word size).
numericTypeInfo :: [NumericTypeInfo]
numericTypeInfo :: [NumericTypeInfo]
numericTypeInfo =
  [ Type -> CInt -> NumericTypeInfo
forall a.
(Bounded a, Integral a, Storable a) =>
Type -> a -> NumericTypeInfo
mk Type
intT (CInt
forall a. HasCallStack => a
undefined :: CInt)
  , Type -> CUInt -> NumericTypeInfo
forall a.
(Bounded a, Integral a, Storable a) =>
Type -> a -> NumericTypeInfo
mk Type
uintT (CUInt
forall a. HasCallStack => a
undefined :: CUInt)
  , Type -> CLong -> NumericTypeInfo
forall a.
(Bounded a, Integral a, Storable a) =>
Type -> a -> NumericTypeInfo
mk Type
longT (CLong
forall a. HasCallStack => a
undefined :: CLong)
  , Type -> CULong -> NumericTypeInfo
forall a.
(Bounded a, Integral a, Storable a) =>
Type -> a -> NumericTypeInfo
mk Type
ulongT (CULong
forall a. HasCallStack => a
undefined :: CULong)
  , Type -> CLLong -> NumericTypeInfo
forall a.
(Bounded a, Integral a, Storable a) =>
Type -> a -> NumericTypeInfo
mk Type
llongT (CLLong
forall a. HasCallStack => a
undefined :: CLLong)
  , Type -> CULLong -> NumericTypeInfo
forall a.
(Bounded a, Integral a, Storable a) =>
Type -> a -> NumericTypeInfo
mk Type
ullongT (CULLong
forall a. HasCallStack => a
undefined :: CULLong)
  ]
  where mk :: forall a. (Bounded a, Integral a, Storable a) => Type -> a -> NumericTypeInfo
        mk :: Type -> a -> NumericTypeInfo
mk Type
t a
_ = NumericTypeInfo :: Type -> Int -> Integer -> Integer -> NumericTypeInfo
NumericTypeInfo
                 { numType :: Type
numType = Type
t
                 , numBytes :: Int
numBytes = a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a)
                 , numMinBound :: Integer
numMinBound = a -> Integer
forall a. Integral a => a -> Integer
toInteger (a
forall a. Bounded a => a
minBound :: a)
                 , numMaxBound :: Integer
numMaxBound = a -> Integer
forall a. Integral a => a -> Integer
toInteger (a
forall a. Bounded a => a
maxBound :: a)
                 }

-- | Searches the list of known numeric types usable for enum values, and
-- returns the record for the given type.
findNumericTypeInfo :: Type -> Maybe NumericTypeInfo
findNumericTypeInfo :: Type -> Maybe NumericTypeInfo
findNumericTypeInfo Type
t = [NumericTypeInfo] -> Maybe NumericTypeInfo
forall a. [a] -> Maybe a
listToMaybe ([NumericTypeInfo] -> Maybe NumericTypeInfo)
-> [NumericTypeInfo] -> Maybe NumericTypeInfo
forall a b. (a -> b) -> a -> b
$ (NumericTypeInfo -> Bool) -> [NumericTypeInfo] -> [NumericTypeInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter (\NumericTypeInfo
i -> NumericTypeInfo -> Type
numType NumericTypeInfo
i Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
t) [NumericTypeInfo]
numericTypeInfo

-- | Selects the preferred numeric type for holding numeric values in the given
-- range.
pickNumericType :: Int -> Integer -> Integer -> Maybe NumericTypeInfo
pickNumericType :: Int -> Integer -> Integer -> Maybe NumericTypeInfo
pickNumericType Int
bytes Integer
low Integer
high =
  [NumericTypeInfo] -> Maybe NumericTypeInfo
forall a. [a] -> Maybe a
listToMaybe ([NumericTypeInfo] -> Maybe NumericTypeInfo)
-> [NumericTypeInfo] -> Maybe NumericTypeInfo
forall a b. (a -> b) -> a -> b
$ ((NumericTypeInfo -> Bool)
 -> [NumericTypeInfo] -> [NumericTypeInfo])
-> [NumericTypeInfo]
-> (NumericTypeInfo -> Bool)
-> [NumericTypeInfo]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (NumericTypeInfo -> Bool) -> [NumericTypeInfo] -> [NumericTypeInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter [NumericTypeInfo]
numericTypeInfo ((NumericTypeInfo -> Bool) -> [NumericTypeInfo])
-> (NumericTypeInfo -> Bool) -> [NumericTypeInfo]
forall a b. (a -> b) -> a -> b
$ \NumericTypeInfo
info ->
  NumericTypeInfo -> Int
numBytes NumericTypeInfo
info Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
bytes Bool -> Bool -> Bool
&&
  NumericTypeInfo -> Integer
numMinBound NumericTypeInfo
info Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
low Bool -> Bool -> Bool
&&
  NumericTypeInfo -> Integer
numMaxBound NumericTypeInfo
info Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
high