/* libsizzle/capi.c - C API functions
 
  Copyright (C) 2000 Martin Grabmueller <mgrabmue@cs.tu-berlin.de>
 
  This is free software; you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation; either version 2, or (at your option)
  any later version.
  
  This software is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.
  
  You should have received a copy of the GNU General Public License
  along with this package; see the file COPYING.  If not, write to
  the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  Boston, MA 02111-1307, USA.  */

#if HAVE_CONFIG_H
# include <config.h>
#endif 

#include <assert.h>
#include <fcntl.h>
#if HAVE_UNISTD_H
# include <unistd.h>
#endif

#ifdef __MINGW32__
# include <io.h>
#endif

#if ENABLE_NLS
# include <libintl.h>
# define _(String) gettext(String)
#else
# define _(String) (String)
#endif

#include "sport.h"
#include "fdport.h"
#include "port.h"
#include "eval.h"
#include "read.h"
#include "modules.h"
#include "capi.h"

#ifndef O_BINARY
# define O_BINARY 0
#endif

#if defined (__MINGW32__) || defined (__CYGWIN__)
#include <windows.h>
/*
 * DLL entry point for Win32.
 */
BOOL APIENTRY 
DllMain (HANDLE hModule, DWORD reason_for_call, LPVOID reserved)
{
  switch (reason_for_call)
    {
    case DLL_PROCESS_ATTACH:
      break;

    case DLL_THREAD_ATTACH:
      break;

    case DLL_THREAD_DETACH:
      break;

    case DLL_PROCESS_DETACH:
      break;
    }

  return TRUE;
}
#endif /* neither __MINGW32__ nor __CYGWIN__ */

result_t
zzz_get_variable (zzz_scm_t sym, zzz_scm_t * result)
{
  assert (symbol_p (sym));
  return zzz_get_symbol_value (NULL, sym, result);
}

result_t
zzz_set_variable (zzz_scm_t sym, zzz_scm_t value, zzz_scm_t * result)
{
  assert (symbol_p (sym));
  return zzz_set_symbol_value (NULL, sym, value, result);
}

zzz_scm_t
zzz_define_variable (char * name, zzz_scm_t value)
{
  zzz_scm_t sym;

  assert (name != NULL);
  sym = zzz_make_symbol (name, -1);
  set_symbol_value (sym, value);
  return sym;
}

zzz_scm_t
zzz_define_constant (char * name, zzz_scm_t value)
{
  zzz_scm_t sym;
  zzz_scm_t val;

  assert (name != NULL);
  val = zzz_make_constant (value);
  sym = zzz_make_symbol (name, -1);
  set_symbol_value (sym, val);
  return sym;
}

zzz_scm_t
zzz_c_define_constant (zzz_scm_t module, char * name, zzz_scm_t value)
{
  zzz_scm_t val;
  zzz_scm_t dummy;
  zzz_scm_t sym;
  
  assert (module_p (module));
  assert (name != NULL);
  sym = zzz_make_symbol (name, -1);
  val = zzz_make_constant (value);
  zzz_c_module_define (module, name, val, 1, &dummy);
  return sym;
}

zzz_scm_t
zzz_define_function (char * name, zzz_prim_t func, int param_format)
{
  zzz_scm_t sym;
  zzz_scm_t f;

  assert (name != NULL);
  sym = zzz_make_symbol (name, -1);
  f = zzz_make_func (func, name, 0, param_format);
  set_symbol_value (sym, f);
  return sym;
}

zzz_scm_t
zzz_c_define_function (zzz_scm_t module, char * name, zzz_prim_t func,
		       int param_format)
{
  zzz_scm_t sym;
  zzz_scm_t f;
  zzz_scm_t dummy;

  assert (module_p (module));
  assert (name != NULL);
  sym = zzz_make_symbol (name, -1);
  f = zzz_make_func (func, name, 0, param_format);
  zzz_c_module_define (module, name, f, 1, &dummy);
  return sym;
}

zzz_scm_t
zzz_define_form (char * name, zzz_prim_t func, int preprocessing)
{
  zzz_scm_t sym;

  assert (name != NULL);
  sym = zzz_make_symbol (name, -1);
  set_symbol_value (sym, zzz_make_func
		    (func, name, 1, (preprocessing ? argv_prep_form : 0)));
  return sym;
}

zzz_scm_t
zzz_c_define_form (zzz_scm_t module, char * name, zzz_prim_t func,
		   int preprocessing)
{
  zzz_scm_t sym;
  zzz_scm_t dummy;

  assert (module_p (module));
  assert (name != NULL);
  sym = zzz_make_symbol (name, -1);
  zzz_c_module_define (module, name,
		       zzz_make_func
		       (func, name, 1, (preprocessing ? argv_prep_form : 0)),
		       1, &dummy);
  return sym;
}

int
zzz_evaluate_string (zzz_scm_t env, char * str)
{
  zzz_scm_t port;
  zzz_scm_t result = NULL;
  int err;

  assert (env_p (env));
  assert (str != NULL);
  port = zzz_make_sport_str(str);
  err = zzz_load_port (env, port, &result);
  if (err == RESULT_QUIT)
    return integer_val (result);
  else if (err == RESULT_SUCCESS)
    return 0;
  else
    {
      zzz_report_error (err, result, 0);
      return -2;
    }
}

int
zzz_evaluate_file (zzz_scm_t env, char * filename)
{
  zzz_scm_t port;
  zzz_scm_t result = NULL;
/*    zzz_scm_t old_name = zzz_state.current_input_file_name; */
  int rc_file;
  int err;

  assert (env_p (env));
  assert (filename != NULL);
  rc_file = open (filename, O_RDONLY | O_BINARY);
  if (rc_file < 0)
    return -1;
/*    zzz_state.current_input_file_name = zzz_make_ro_string (filename, -1); */
  port = zzz_make_fdport (rc_file, 1, 0);
  port_filename (port) = zzz_make_ro_string (filename, -1);
  err = zzz_load_port (env, port, &result);
/*    zzz_state.current_input_file_name = old_name; */
  if (err == RESULT_QUIT)
    return integer_val (result);
  else if (err == RESULT_SUCCESS)
    return 0;
  else
    {
      zzz_report_error (err, result, 0);
      return -2;
    }
}
