BasicAnnot.hs

module UHC.Light.Compiler.CodeGen.BasicAnnot
( BasicSize (..)
, basicSizeOf
, basicSizeIsSigned
, BasicTy (..)
, BasicAnnot (..)
, basicSizeDouble, basicSizeFloat )
where
import qualified Data.Map as Map
import Data.Bits
import Data.List
import UHC.Util.Pretty
import UHC.Util.Utils
import qualified UHC.Light.Compiler.Config as Cfg
import UHC.Light.Compiler.CodeGen.Bits
import Control.Monad
import UHC.Util.Binary
import UHC.Util.Serialize



{-# LINE 25 "src/ehc/CodeGen/BasicAnnot.chs" #-}
data BasicSize
  = -- Word variants, bitsize explicit
    BasicSize_Word8
  | BasicSize_Word16
  | BasicSize_Word32
  | BasicSize_Word64
  -- Int variants, bitsize explicit
  | BasicSize_Int8
  | BasicSize_Int16
  | BasicSize_Int32
  | BasicSize_Int64
  -- Float variants, bitsize explicit
  | BasicSize_Float
  | BasicSize_Double
  deriving (Eq,Ord,Enum)

{-# LINE 45 "src/ehc/CodeGen/BasicAnnot.chs" #-}
deriving instance Typeable BasicSize
deriving instance Data BasicSize

{-# LINE 53 "src/ehc/CodeGen/BasicAnnot.chs" #-}
instance Show BasicSize where
  show BasicSize_Word8   = "w1"
  show BasicSize_Word16  = "w2"
  show BasicSize_Word32  = "w4"
  show BasicSize_Word64  = "w8"
  show BasicSize_Int8    = "i1"
  show BasicSize_Int16   = "i2"
  show BasicSize_Int32   = "i4"
  show BasicSize_Int64   = "i8"
  show BasicSize_Float   = "f4"
  show BasicSize_Double  = "f8"

{-# LINE 69 "src/ehc/CodeGen/BasicAnnot.chs" #-}
instance PP BasicSize where
  pp = pp . show

{-# LINE 75 "src/ehc/CodeGen/BasicAnnot.chs" #-}
basicSizeOfMp :: Map.Map Int BasicSize
basicSizeOfMp
  = Map.fromList
      [ (1, BasicSize_Word8 )
      , (2, BasicSize_Word16)
      , (4, BasicSize_Word32)
      , (8, BasicSize_Word64)
      ]

basicSizeOf :: Int -> BasicSize
basicSizeOf i = panicJust "BasicAnnot.basicSizeOf" $ Map.lookup i basicSizeOfMp

{-# LINE 111 "src/ehc/CodeGen/BasicAnnot.chs" #-}
basicSizeIsSigned :: BasicSize -> Bool
basicSizeIsSigned BasicSize_Int8  = True
basicSizeIsSigned BasicSize_Int16 = True
basicSizeIsSigned BasicSize_Int32 = True
basicSizeIsSigned BasicSize_Int64 = True
basicSizeIsSigned _               = False

{-# LINE 120 "src/ehc/CodeGen/BasicAnnot.chs" #-}
basicSizeDouble, basicSizeFloat :: BasicSize
basicSizeFloat  = BasicSize_Float
basicSizeDouble = BasicSize_Double

{-# LINE 291 "src/ehc/CodeGen/BasicAnnot.chs" #-}
-- the defs in basicTyGBTy must be at the beginning, as Enum uses the relative ordering
data BasicTy
  = BasicTy_Word				-- base case: pointer, word, int, ...
  | BasicTy_SWord				-- base case: signed word
  | BasicTy_SHWord				-- base case: signed half word
  | BasicTy_Float				-- C: float
  | BasicTy_Double				-- C: double
  | BasicTy_SignedHalfWord		-- as BasicTy_Word, but for FFI half the size of a word, and signed. Special case for sign extend.
  deriving (Eq,Ord,Enum)

{-# LINE 305 "src/ehc/CodeGen/BasicAnnot.chs" #-}
deriving instance Typeable BasicTy
deriving instance Data BasicTy

{-# LINE 313 "src/ehc/CodeGen/BasicAnnot.chs" #-}
instance Show BasicTy where
  show BasicTy_Word   			= "word"
  show BasicTy_SWord            = "sword"
  show BasicTy_SHWord           = "shword"
  show BasicTy_Float  			= "float"
  show BasicTy_Double 			= "double"
  show BasicTy_SignedHalfWord   = "int"

{-# LINE 325 "src/ehc/CodeGen/BasicAnnot.chs" #-}
instance PP BasicTy where
  pp = pp . show

{-# LINE 352 "src/ehc/CodeGen/BasicAnnot.chs" #-}
data BasicAnnot
  = BasicAnnot_None
  deriving (Show,Eq)

{-# LINE 411 "src/ehc/CodeGen/BasicAnnot.chs" #-}
instance PP BasicAnnot where
  pp _                                     = pp "ANNOT"

{-# LINE 424 "src/ehc/CodeGen/BasicAnnot.chs" #-}
instance Serialize BasicTy where
  sput = sputEnum8
  sget = sgetEnum8

instance Serialize BasicSize where
  sput = sputEnum8
  sget = sgetEnum8

{-# LINE 434 "src/ehc/CodeGen/BasicAnnot.chs" #-}
instance Serialize BasicAnnot where
  sput (BasicAnnot_None                 ) = sputWord8 0
  sget = do
    t <- sgetWord8
    case t of
      0 -> return BasicAnnot_None