/* --------------------------------------------------------------------------
 * GreenCard / HaskellDirect include file.
 *
 * Hugs 98 is Copyright (c) Mark P Jones, Alastair Reid and the Yale
 * Haskell Group 1994-99, and is distributed as Open Source software
 * under the Artistic License; see the file "Artistic" that is included
 * in the distribution for details.
 *
 * sof 4/99 - changed to make it useable with HaskellDirect.
 *
 * $RCSfile: HDirect.h,v $
 * $Revision: 1.1 $
 * $Date: 2007-08-16 22:01:07 $
 * ------------------------------------------------------------------------*/

/* --------------------------------------------------------------------------
 *
 *                                  WARNING
 *
 * Most of the code in this file must exactly match corresponding definitions
 * in the Hugs source code.
 *
 * We have chosen to copy this code over to avoid the need to #include huge
 * chunks of the Hugs internal definitions (which sometimes conflict with
 * Xlib, Win32 or other libraries which we might also have to #include).
 *
 *
 * sof 4/99 - removed #include of config.h and options.h, since its only use
 *            appeared to be to pick up whether the host C compiler supported
 *            prototypes or not. Most do nowadays.
 * ------------------------------------------------------------------------*/

#ifndef __HDIRECT_H__
#define __HDIRECT_H__

#if 1 /* PROTOTYPES */ /* To enable use of prototypes whenever possible */
#define Args(x) x
#else
#define Args(x) ()
#endif

typedef unsigned char hugs_uint8_t;
typedef unsigned short hugs_uint16_t;
typedef unsigned int hugs_uint32_t;
typedef signed char hugs_int8_t;
typedef signed short hugs_int16_t;
typedef signed int hugs_int32_t;
#ifdef _MSC_VER
typedef unsigned __int64 hugs_uint64_t;
typedef __int64 hugs_int64_t;
#else
typedef unsigned long long hugs_uint64_t;
typedef signed long long hugs_int64_t;
#endif

typedef int HsInt;
typedef hugs_int8_t HsInt8;
typedef hugs_int16_t HsInt16;
typedef hugs_int32_t HsInt32;
typedef unsigned int HsWord;
typedef hugs_uint8_t HsWord8;
typedef hugs_uint16_t HsWord16;
typedef hugs_uint32_t HsWord32;

/*
 * Here we deviate from the FFI specification:
 * If we make them both float, then there's no way to pass a double
 * to C which means we can't call common C functions like sin.
 */
typedef float HsFloat;
typedef double HsDouble;

typedef hugs_int64_t HsInt64;
typedef hugs_uint64_t HsWord64;
typedef char HsChar;
typedef int HsBool;
typedef void *HsAddr;
typedef void *HsPtr;
typedef void (*HsFunPtr)(void);
typedef void *HsForeignPtr;
typedef void *HsStablePtr;

typedef int HugsStackPtr;
typedef int HugsStablePtr;
typedef void *HugsForeign;

#define primFun(name) static void name(HugsStackPtr hugs_root)
#define hugs_returnIO(n) hugs->returnIO(hugs_root, n)
#define hugs_returnId(n) hugs->returnId(hugs_root, n)

/* These declarations must exactly match those in storage.h */

typedef void(*Prim) Args((HugsStackPtr)); /* primitive function	   */

extern struct hugs_primitive
{              /* table of primitives		   */
    char *ref; /* primitive reference string	   */
    int arity; /* primitive function arity	   */
    Prim imp;  /* primitive implementation	   */
} primitives[];

struct hugs_primInfo
{
    void(*controlFun) Args((int));
    struct hugs_primitive *primFuns;
    struct hugs_primInfo *nextPrimInfo;
};

/* This is an exact copy of the declaration found in storage.h */

typedef struct
{

    /* evaluate next argument */
    HsInt (*getInt)(void);
    HsWord (*getWord)(void);
    HsAddr (*getAddr)(void);
    HsFloat (*getFloat)(void);
    HsDouble (*getDouble)(void);
    HsChar (*getChar)(void);
    HugsForeign (*getForeign)(void);
    HugsStablePtr (*getStablePtr)(void); /* deprecated */

    /* push part of result   */
    void (*putInt)(HsInt);
    void (*putWord)(HsWord);
    void (*putAddr)(HsAddr);
    void (*putFloat)(HsFloat);
    void (*putDouble)(HsDouble);
    void (*putChar)(HsChar);
    void (*putForeign)(HugsForeign, void (*)(HugsForeign));
    void (*putStablePtr)(HugsStablePtr); /* deprecated */

    /* return n values in IO monad or Id monad */
    void (*returnIO)(HugsStackPtr, int);
    void (*returnId)(HugsStackPtr, int);
    int (*runIO)(int);

    /* free a stable pointer */
    void (*freeStablePtr)(HugsStablePtr); /* deprecated */

    /* register the prim table */
    void (*registerPrims)(struct hugs_primInfo *);

    /* garbage collect */
    void (*garbageCollect)(void);

    /* API3 additions follow */
    HugsStablePtr (*lookupName)(char *, char *);
    void (*ap)(int);
    void (*getUnit)(void);
    void *(*mkThunk)(HsFunPtr, HugsStablePtr);
    void (*freeThunk)(void *);
    HsBool (*getBool)(void);
    void (*putBool)(HsBool);

    /* API4 additions follow */
    HsInt8 (*getInt8)(void);
    HsInt16 (*getInt16)(void);
    HsInt32 (*getInt32)(void);
    HsInt64 (*getInt64)(void);
    HsWord8 (*getWord8)(void);
    HsWord16 (*getWord16)(void);
    HsWord32 (*getWord32)(void);
    HsWord64 (*getWord64)(void);
    HsPtr (*getPtr)(void);
    HsFunPtr (*getFunPtr)(void);
    HsForeignPtr (*getForeignPtr)(void);

    void (*putInt8)(HsInt8);
    void (*putInt16)(HsInt16);
    void (*putInt32)(HsInt32);
    void (*putInt64)(HsInt64);
    void (*putWord8)(HsWord8);
    void (*putWord16)(HsWord16);
    void (*putWord32)(HsWord32);
    void (*putWord64)(HsWord64);
    void (*putPtr)(HsPtr);
    void (*putFunPtr)(HsFunPtr);
    void (*putForeignPtr)(HsForeignPtr);

    HugsStablePtr (*makeStablePtr4)(void);
    void (*derefStablePtr4)(HugsStablePtr);

    void (*putStablePtr4)(HsStablePtr);
    HsStablePtr (*getStablePtr4)(void);
    void (*freeStablePtr4)(HsStablePtr);

    int (*runId)(int);
} HugsAPI4;

HugsAPI4 *hugs; /* pointer to virtual function table */

/*
  copyBytes() is needed when dealing with
  functions that return structs

  Note: we're (intentionally!) relying on memcpy() to handle
  malloc() failure for us.
*/
#define copyBytes(len, struct_ptr) memcpy((char *)malloc(len * sizeof(char)), (char *)(struct_ptr), len)

/* Copied verbatim from prelude.h */

#ifdef _MSC_VER /* Microsoft Visual C++ */
#define DLLIMPORT(rty) __declspec(dllimport) rty
#define DLLEXPORT(rty) __declspec(dllexport) rty
#elif defined __BORLANDC__
#define DLLIMPORT(rty) rty far _import
#define DLLEXPORT(rty) rty far _export
#else
#define DLLIMPORT(rty) rty
#define DLLEXPORT(rty) rty
#endif /* Don't need to declare DLL exports */

#endif /* __HDIRECT_H__ */