//
// Managed C++ wrapper class around the Hugs server API.
//
#using <mscorlib.dll>
extern "C" {
#include "prelude.h"
#include "storage.h"
#include "machdep.h"
#include "connect.h"
};
#include "prim.h"
#include "HugsServ.h"

#define ToCharString(str) \
  static_cast<char*>(System::Runtime::InteropServices::Marshal::StringToHGlobalAnsi(str).ToPointer())
#define FreeCharString(pstr) System::Runtime::InteropServices::Marshal::FreeHGlobal(pstr)

extern "C" {
extern char* lastError;
extern char* ClearError();
extern Void  setError  (char*);
extern Bool  safeEval  (Cell c);
extern Void  startEval (Void);
};

/* All server entry points set CStackBase for the benefit of the (conservative)
 * GC and do error catching.  Any calls to Hugs functions should be "protected"
 * by being placed inside this macro.
 *
 *   void entryPoint(arg1, arg2, result)
 *   T1 arg1;
 *   T2 arg2;
 *   T3 *result;
 *   {
 *       protect(doNothing(),
 *           ...
 *       );
 *   }
 *
 * Macro decomposed into BEGIN_PROTECT and END_PROTECT pieces so that i
 * can be used on some compilers (Mac?) that have limits on the size of
 * macro arguments.
 */
#define BEGIN_PROTECT \
  if (NULL == lastError) { \
      Cell dummy; \
      CStackBase = &dummy;              /* Save stack base for use in gc  */ \
      consGC = TRUE;                    /* conservative GC is the default */ \
      if (1) {
#define END_PROTECT \
      } else { \
	setError("Error occurred"); \
	normalTerminal(); \
      }	\
  }
#define protect(s)	BEGIN_PROTECT s; END_PROTECT

static Void    MkObject    Args((System::Object*));
static Object* EvalObject  Args((Void));
static Int     DoIO_Object Args((Object* __gc&));

/* Push an Object/DotNetPtr onto the stack */
static Void MkObject(Object* a) 
{
#ifndef NO_DYNAMIC_TYPES
    Cell d = getTypeableDict(type);
    if (isNull(d)) {
      setError("MkObject: can't create Typeable instance");
      return 0;
    }
    protect(push(ap(ap(nameToDynamic,d),mkDotNetPtr(a,freeNetPtr))));
#else
    protect(push(mkDotNetPtr(a,freeNetPtr)));
#endif
}

static Object* EvalObject()          /* Evaluate a cell (:: Object)    */
{
    Cell d;
    BEGIN_PROTECT
	startEval();
#ifndef NO_DYNAMIC_TYPES
	d = getTypeableDict(type);
	if (isNull(d)) {
	    setError("EvalObject: can't create Typeable instance");
	    return 0;
	}
	safeEval(ap(ap(nameToDynamic,d),pop()));
#else
	safeEval(pop());
#endif
	normalTerminal();
	return getNP(whnfHead);
    END_PROTECT
    return 0;
}

/* 
 * Evaluate a cell (:: IO DotNetPtr) return exit status
 */
static Int DoIO_Object(Object* __gc& phval)
{
    BEGIN_PROTECT
        Int exitCode = 0;
        Bool ok;
        StackPtr oldsp = sp;
        startEval();
#ifndef NO_DYNAMIC_TYPES
        ok = safeEval(ap(nameIORun,ap(nameRunDyn,pop())));
#else
        ok = safeEval(ap(nameIORun,pop()));
#endif
        if (!ok)
        {
            sp = oldsp-1;   
            exitCode = 1;
	} else if (whnfHead == nameLeft) { 
            safeEval(pop());
            exitCode = whnfInt;
        } else {   
	    if (phval) {
	      safeEval(pop());
	      phval = getNP(whnfHead);
	    } else {
	      drop();
	    }
            exitCode = 0; 
        }
        normalTerminal();
        if (sp != oldsp-1) {
            setError("doIO: unbalanced stack");
            return 1;
        }
        return exitCode;
    END_PROTECT;
    return -1; /* error code */
}

namespace Hugs {

System::String* Server::ClearError() {
  char* s = m_server->clearError();
  return new System::String(s);
}

//
// Method:  SetHugsArgs(String* argv[])
//
// Purpose: Configure the argument vector which
//          H98's System.getArgs returns.
//

void Server::SetHugsArgs(System::String* argv[]) {
  char __nogc* __nogc* args = new char*[argv.Length];
  int len = argv.Length;
  
  for (int i=0; i < len; i++) {
    args[i] = new char[argv[i]->Length + 1];
    args[i] = ToCharString(argv[i]);
  }
  m_server->setHugsArgs(len,args);
  
  /* Looks kind of silly; a better way? */
  for (int i=0; i < len; i++) {
    delete args[i];
  }
  delete args;

  return;
}

int    Server::GetNumScripts() {
  return m_server->getNumScripts();
}

void   Server::Reset(int i) {
  m_server->reset(i);
  return;
}

void   Server::SetOutputEnable (int i) {
  m_server->setOutputEnable(i);
  return;
}

void   Server::ChangeDir(System::String* dir) {
  char __nogc* dirStr = ToCharString(dir);
  m_server->changeDir(dirStr);
  FreeCharString(dirStr);
  return;
}

void   Server::LoadProject(System::String* proj) {
  char __nogc* projStr = ToCharString(proj);
  m_server->loadProject(projStr);
  FreeCharString(projStr);
  return;
}

void   Server::LoadFile(System::String* fname) {
  char __nogc* fnameStr = ToCharString(fname);
  m_server->loadProject(fnameStr);
  FreeCharString(fnameStr);
  return;
}

void   Server::LoadFromBuffer(System::String* haskMod) {
  char __nogc* hStr = ToCharString(haskMod);
  m_server->loadFromBuffer(hStr);
  FreeCharString(hStr);
  return;
}

void   Server::SetOptions(System::String* opts) {
  char __nogc* hStr = ToCharString(opts);
  m_server->setOptions(hStr);
  FreeCharString(hStr);
  return;
}

System::String* Server::GetOptions() {
  char* r = m_server->getOptions();
  return System::Runtime::InteropServices::Marshal::PtrToStringAnsi(r);
}

HVal Server::CompileExpr(System::String* mo,System::String* v) {
  char __nogc* moStr = ToCharString(mo);
  char __nogc* vStr = ToCharString(v);
  HVal res = m_server->compileExpr(moStr,vStr);
  FreeCharString(moStr);
  FreeCharString(vStr);
  return res;
}

void Server::GarbageCollect() {
  m_server->garbageCollect();
  return;
}

void  Server::LookupName(System::String* mo,System::String* v) {
  char __nogc* moStr = ToCharString(mo);
  char __nogc* vStr = ToCharString(v);
  m_server->lookupName(moStr,vStr);
  FreeCharString(moStr);
  FreeCharString(vStr);

  return;
}

void Server::mkInt(int i) {
  m_server->mkInt(i);
  return;
}

void Server::mkAddr(void* ptr) {
  m_server->mkAddr(ptr);
  return;
}

void Server::mkObject(Object* obj) {
  MkObject(obj);
  return;
}

void  Server::mkString(System::String* s) {
  char* str = ToCharString(s);
  m_server->mkString(str);
  FreeCharString(str);
  return;
}

void   Server::apply() {
  m_server->apply();
  return;
}

int Server::evalInt() {
  return m_server->evalInt();
}

void* Server::evalAddr() {
  return m_server->evalAddr();
}

Object* Server::evalObject() {
  return EvalObject();
}

System::String* Server::evalString() {
  char* str = m_server->evalString();
  return System::Runtime::InteropServices::Marshal::PtrToStringAnsi(str);
}

int Server::doIO() {
  return m_server->doIO();
}

int Server::doIO_Int(int* pRes) {
  return 0;
}

int Server::doIO_Addr(void** pRes)  {
  return 0;
}
int Server::doIO_Object(Object* __gc& pRes)  {
  return DoIO_Object(pRes);
}

HVal Server::popHVal() {
  HVal h = m_server->popHVal();
  return h;
}

void Server::pushHVal(HVal arg) {
  m_server->pushHVal(arg);
  return;
}

void Server::freeHVal(HVal arg) {
  m_server->freeHVal(arg);
  return;
}
};