-- | Functions.
--
-- 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.Function where

import Binaryen.Expression
import Binaryen.Index
import {-# SOURCE #-} Binaryen.Module
import Binaryen.Type
import Foreign (Ptr, Storable)
import Foreign.C (CChar(..), CUIntPtr(..))

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

foreign import ccall unsafe "BinaryenFunctionGetName"
  getName ::
    Function -> IO (Ptr CChar)

foreign import ccall unsafe "BinaryenFunctionGetParams"
  getParams ::
    Function -> IO Type

foreign import ccall unsafe "BinaryenFunctionGetResults"
  getResults ::
    Function -> IO Type

foreign import ccall unsafe "BinaryenFunctionGetNumVars"
  getNumVars ::
    Function -> IO Index

foreign import ccall unsafe "BinaryenFunctionGetVar"
  getVar ::
    Function -> Index -> IO Type

foreign import ccall unsafe "BinaryenFunctionGetBody"
  getBody ::
    Function -> IO Expression

foreign import ccall unsafe "BinaryenFunctionSetDebugLocation"
  setDebugLocation ::
    Function ->
    Expression ->
    Index ->
    Index ->
    Index ->
    IO ()

foreign import ccall unsafe "BinaryenFunctionImportGetModule"
  importGetModule ::
    Function -> IO (Ptr CChar)

foreign import ccall unsafe "BinaryenFunctionImportGetBase"
  importGetBase ::
    Function -> IO (Ptr CChar)

foreign import ccall unsafe "BinaryenFunctionOptimize"
  optimize ::
    Function -> Module -> IO ()

foreign import ccall unsafe "BinaryenFunctionRunPasses"
  runPasses ::
    Function ->
    Module ->
    Ptr (Ptr CChar) ->
    Index ->
    IO ()