-- | Globals.
--
-- 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.Global where

import Binaryen.Type
import Binaryen.Expression
import Foreign (Ptr, Storable)
import Foreign.C (CChar(..), CInt(..), CUIntPtr(..))

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

foreign import ccall unsafe "BinaryenGlobalGetName"
  getName ::
    Global -> IO (Ptr CChar)

foreign import ccall unsafe "BinaryenGlobalGetType"
  getType ::
    Global -> IO Type

foreign import ccall unsafe "BinaryenGlobalIsMutable"
  isMutable ::
    Global -> IO CInt

foreign import ccall unsafe "BinaryenGlobalGetInitExpr"
  getInitExpr ::
    Global -> IO Expression

foreign import ccall unsafe "BinaryenGlobalImportGetModule"
  importGetModule ::
    Global -> IO (Ptr CChar)

foreign import ccall unsafe "BinaryenGlobalImportGetBase"
  globalImportGetBase ::
    Global -> IO (Ptr CChar)