-- | Core types.
--
-- See <https://github.com/WebAssembly/binaryen/blob/master/src/binaryen-c.h>
-- for API documentation.
--
-- This module is intended to be imported qualified.

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Binaryen.Type where

import Data.Word (Word32)
import Foreign (Ptr, Storable)
import Foreign.C (CUIntPtr(..))

newtype Type = Type CUIntPtr
  deriving (Type -> Type -> Bool
(Type -> Type -> Bool) -> (Type -> Type -> Bool) -> Eq Type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c== :: Type -> Type -> Bool
Eq, Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
(Int -> Type -> ShowS)
-> (Type -> String) -> ([Type] -> ShowS) -> Show Type
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type] -> ShowS
$cshowList :: [Type] -> ShowS
show :: Type -> String
$cshow :: Type -> String
showsPrec :: Int -> Type -> ShowS
$cshowsPrec :: Int -> Type -> ShowS
Show, Ptr b -> Int -> IO Type
Ptr b -> Int -> Type -> IO ()
Ptr Type -> IO Type
Ptr Type -> Int -> IO Type
Ptr Type -> Int -> Type -> IO ()
Ptr Type -> Type -> IO ()
Type -> Int
(Type -> Int)
-> (Type -> Int)
-> (Ptr Type -> Int -> IO Type)
-> (Ptr Type -> Int -> Type -> IO ())
-> (forall b. Ptr b -> Int -> IO Type)
-> (forall b. Ptr b -> Int -> Type -> IO ())
-> (Ptr Type -> IO Type)
-> (Ptr Type -> Type -> IO ())
-> Storable Type
forall b. Ptr b -> Int -> IO Type
forall b. Ptr b -> Int -> Type -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr Type -> Type -> IO ()
$cpoke :: Ptr Type -> Type -> IO ()
peek :: Ptr Type -> IO Type
$cpeek :: Ptr Type -> IO Type
pokeByteOff :: Ptr b -> Int -> Type -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Type -> IO ()
peekByteOff :: Ptr b -> Int -> IO Type
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Type
pokeElemOff :: Ptr Type -> Int -> Type -> IO ()
$cpokeElemOff :: Ptr Type -> Int -> Type -> IO ()
peekElemOff :: Ptr Type -> Int -> IO Type
$cpeekElemOff :: Ptr Type -> Int -> IO Type
alignment :: Type -> Int
$calignment :: Type -> Int
sizeOf :: Type -> Int
$csizeOf :: Type -> Int
Storable)

foreign import ccall unsafe "BinaryenTypeNone" none :: Type
foreign import ccall unsafe "BinaryenTypeInt32" int32 :: Type
foreign import ccall unsafe "BinaryenTypeInt64" int64 :: Type
foreign import ccall unsafe "BinaryenTypeFloat32" float32 :: Type
foreign import ccall unsafe "BinaryenTypeFloat64" float64 :: Type
foreign import ccall unsafe "BinaryenTypeVec128" vec128 :: Type
foreign import ccall unsafe "BinaryenTypeFuncref" funcref :: Type
foreign import ccall unsafe "BinaryenTypeExternref" externref :: Type
foreign import ccall unsafe "BinaryenTypeNullref" nullref :: Type
foreign import ccall unsafe "BinaryenTypeExnref" exnref :: Type
foreign import ccall unsafe "BinaryenTypeUnreachable" unreachable :: Type
foreign import ccall unsafe "BinaryenTypeAuto" auto :: Type

foreign import ccall unsafe "BinaryenTypeCreate"
  create :: Ptr Type -> Word32 -> IO Type

foreign import ccall unsafe "BinaryenTypeArity"
  arity :: Type -> IO Word32

foreign import ccall unsafe "BinaryenTypeExpand"
  expand :: Type -> Ptr Type -> IO ()