/*
    This file is part of GNU APL, a free implementation of the
    ISO/IEC Standard 13751, "Programming Language APL, Extended"

    Copyright (C) 2008-2013  Dr. Jürgen Sauermann

    This program 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 3 of the License, or
    (at your option) any later version.

    This program 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 program.  If not, see <http://www.gnu.org/licenses/>.
*/

/** @file
*/

#include <stdio.h>
#include <errno.h>
#include <string.h>

#include "../Native_interface.hh"
#include "../Value.hh"

class NativeFunction;

/**
   This file demonstrates how to write native APL functions. A native
   APL function is a function that is written in C++ but can be called
   in APL like a user-defined APL function.
   
   In GNU APL a native function is created by using a variant of dyadic ⎕FX:

	soname ⎕FX funname

   soname is the path to a shared library
   funname is the name of the function

   For example:

   'native/.libs/lib_file_io.so' ⎕FX 'FILE_IO'
FILE_IO

   creates a native function FILE_IO. FILE_IO can then be called (the
   convention for FILE_IO is that the axis is a sub-function number (and
   sub-function 1 returns the error string for a numeric error code provided
   as right argument for FILE_IO):

      FILE_IO[1] 0   ⍝  error string for error code 0
Success

      FILE_IO[1] 1   ⍝  error string for error code 1
Operation not permitted

      FILE_IO[1] 2   ⍝  error string for error code 2
No such file or directory

      FILE_IO[1] 3   ⍝  error string for error code 3
No such process

   It is up to the native function to decide which function signatures
   it implements (and not implemented signatures will throw a SYNTAX ERROR).
   In the case of FILE_IO, the signatures Z←A FILE_IO[X] B and Z←FILE_IO[X] B
   i.e. monadic and dyadic function with axis were implemented.

   The native function implementated in this file is a template for your
   own native function. It implements all function signatures supported by
   GNU APL and simply returns ia character vector telling how it was called.

**/

// mandatory functios
extern "C" void * get_function_mux(const char * function_name);
static Fun_signature get_signature();
static bool close_fun(Cause cause, const NativeFunction * caller);
static Token eval_fill_B(Value_P B, const NativeFunction * caller);
static Token eval_fill_AB(Value_P A, Value_P B, const NativeFunction * caller);
static Token eval_ident_Bx(Value_P B, sAxis x, const NativeFunction * caller);

#if defined TEMPLATE_F0

Fun_signature get_signature() { return SIG_Z_F0; }

static Token eval_(const NativeFunction * caller);

void *
get_function_mux(const char * function_name)
{
   if (!strcmp(function_name, "get_signature"))
      return reinterpret_cast<void *>(&get_signature);
   if (!strcmp(function_name, "eval_"))
      return reinterpret_cast<void *>(&eval_);
   if (!strcmp(function_name, "eval_fill_B"))
      return reinterpret_cast<void *>(&eval_fill_B);
   if (!strcmp(function_name, "eval_fill_AB"))
      return reinterpret_cast<void *>(&eval_fill_AB);
   if (!strcmp(function_name, "eval_ident_Bx"))
      return reinterpret_cast<void *>(&eval_ident_Bx);
   return 0;
}

Token
eval_(const NativeFunction * caller)
{
UCS_string ucs(UTF8_string("eval_() called"));
Value_P Z(ucs, LOC);
   Z->check_value(LOC);
   return Token(TOK_APL_VALUE1, Z);
}
//-----------------------------------------------------------------------------

#elif defined TEMPLATE_F12

Fun_signature get_signature() { return SIG_Z_A_F2_B; }

static Token eval_B(Value_P B, const NativeFunction * caller);
static Token eval_AB(Value_P A, Value_P B, const NativeFunction * caller);
static Token eval_XB(Value_P X, Value_P B, const NativeFunction * caller);
static Token eval_AXB(Value_P A, Value_P X, Value_P B,
                      const NativeFunction * caller);

void *
get_function_mux(const char * function_name)
{
   if (!strcmp(function_name, "get_signature"))
      return reinterpret_cast<void *>(&get_signature);
   if (!strcmp(function_name, "eval_B"))
      return reinterpret_cast<void *>(&eval_B);
   if (!strcmp(function_name, "eval_AB"))
      return reinterpret_cast<void *>(&eval_AB);
   if (!strcmp(function_name, "eval_XB"))
      return reinterpret_cast<void *>(&eval_XB);
   if (!strcmp(function_name, "eval_AXB"))
      return reinterpret_cast<void *>(&eval_AXB);
   if (!strcmp(function_name, "eval_fill_B"))
      return reinterpret_cast<void *>(&eval_fill_B);
   if (!strcmp(function_name, "eval_fill_AB"))
      return reinterpret_cast<void *>(&eval_fill_AB);
   if (!strcmp(function_name, "eval_ident_Bx"))
      return reinterpret_cast<void *>(&eval_ident_Bx);
   return 0;
}
//-----------------------------------------------------------------------------
Token
eval_B(Value_P B, const NativeFunction * caller)
{
UCS_string ucs(UTF8_string(UTF8_string("eval_B() called")));
Value_P Z(ucs, LOC);
   Z->check_value(LOC);
   return Token(TOK_APL_VALUE1, Z);
}
//-----------------------------------------------------------------------------
Token
eval_AB(Value_P A, Value_P B, const NativeFunction * caller)
{
UCS_string ucs(UTF8_string("eval_AB() called"));
Value_P Z(ucs, LOC);
   Z->check_value(LOC);
   return Token(TOK_APL_VALUE1, Z);
}
//-----------------------------------------------------------------------------
Token
eval_XB(Value_P X, Value_P B, const NativeFunction * caller)
{
UCS_string ucs(UTF8_string("eval_XB() called"));
Value_P Z(ucs, LOC);
   Z->check_value(LOC);
   return Token(TOK_APL_VALUE1, Z);
}
//-----------------------------------------------------------------------------
Token
eval_AXB(Value_P A, Value_P X, Value_P B, const NativeFunction * caller)
{
UCS_string ucs(UTF8_string("eval_AXB() called"));
Value_P Z(ucs, LOC);
   Z->check_value(LOC);
   return Token(TOK_APL_VALUE1, Z);
}
//-----------------------------------------------------------------------------

#elif defined TEMPLATE_OP1

Fun_signature get_signature() { return SIG_Z_A_LO_OP1_B; }

static Token eval_LB(Function & LO, Value_P B, const NativeFunction * caller);
static Token eval_ALB(Value_P A, Function & LO, Value_P B,
                      const NativeFunction * caller);
static Token eval_LXB(Function & LO, Value_P X, Value_P B,
                      const NativeFunction * caller);
static Token eval_ALXB(Value_P A, Function & LO, Value_P X, Value_P B,
                       const NativeFunction * caller);

void *
get_function_mux(const char * function_name)
{
   if (!strcmp(function_name, "get_signature"))
      return reinterpret_cast<void *>(&get_signature);
   if (!strcmp(function_name, "eval_LB"))
      return reinterpret_cast<void *>(&eval_LB);
   if (!strcmp(function_name, "eval_ALB"))
      return reinterpret_cast<void *>(&eval_ALB);
   if (!strcmp(function_name, "eval_LXB"))
      return reinterpret_cast<void *>(&eval_LXB);
   if (!strcmp(function_name, "eval_ALXB"))
      return reinterpret_cast<void *>(&eval_ALXB);
   if (!strcmp(function_name, "eval_fill_B"))
      return reinterpret_cast<void *>(&eval_fill_B);
   if (!strcmp(function_name, "eval_fill_AB"))
      return reinterpret_cast<void *>(&eval_fill_AB);
   if (!strcmp(function_name, "eval_ident_Bx"))
      return reinterpret_cast<void *>(&eval_ident_Bx);
   return 0;
}
//-----------------------------------------------------------------------------
Token
eval_LB(Function & LO, Value_P B, const NativeFunction * caller)
{
UCS_string ucs(UTF8_string("eval_LB() called"));
Value_P Z(ucs, LOC);
   Z->check_value(LOC);
   return Token(TOK_APL_VALUE1, Z);
}
//-----------------------------------------------------------------------------
Token
eval_ALB(Value_P A, Function & LO, Value_P B, const NativeFunction * caller)
{
UCS_string ucs(UTF8_string("eval_ALB() called"));
Value_P Z(ucs, LOC);
   Z->check_value(LOC);
   return Token(TOK_APL_VALUE1, Z);
}
//-----------------------------------------------------------------------------
Token
eval_LXB(Function & LO, Value_P X, Value_P B, const NativeFunction * caller)
{
UCS_string ucs(UTF8_string("eval_LXB() called"));
Value_P Z(ucs, LOC);
   Z->check_value(LOC);
   return Token(TOK_APL_VALUE1, Z);
}
//-----------------------------------------------------------------------------
Token
eval_ALXB(Value_P A, Function & LO, Value_P X, Value_P B,
          const NativeFunction * caller)
{
UCS_string ucs(UTF8_string("eval_ALXB() called"));
Value_P Z(ucs, LOC);
   Z->check_value(LOC);
   return Token(TOK_APL_VALUE1, Z);
}
//-----------------------------------------------------------------------------

#elif defined TEMPLATE_OP2

Fun_signature get_signature() { return SIG_Z_A_LO_OP2_RO_B; }

static Token eval_LRB(Function & LO, Function & RO, Value_P B,
                      const NativeFunction * caller);
static Token eval_ALRB(Value_P A, Function & LO, Function & RO, Value_P B,
                       const NativeFunction * caller);
static Token eval_LRXB(Function & LO, Function & RO, Value_P X, Value_P B,
                       const NativeFunction * caller);
static Token eval_ALRXB(Value_P A, Function & LO, Function & RO, Value_P X,
                        Value_P B, const NativeFunction * caller);

void *
get_function_mux(const char * function_name)
{
   if (!strcmp(function_name, "get_signature"))
      return reinterpret_cast<void *>(&get_signature);
   if (!strcmp(function_name, "eval_LRB"))
      return reinterpret_cast<void *>(&eval_LRB);
   if (!strcmp(function_name, "eval_ALRB"))
      return reinterpret_cast<void *>(&eval_ALRB);
   if (!strcmp(function_name, "eval_LRXB"))
      return reinterpret_cast<void *>(&eval_LRXB);
   if (!strcmp(function_name, "eval_ALRXB"))
      return reinterpret_cast<void *>(&eval_ALRXB);
   if (!strcmp(function_name, "eval_fill_B"))
      return reinterpret_cast<void *>(&eval_fill_B);
   if (!strcmp(function_name, "eval_fill_AB"))
      return reinterpret_cast<void *>(&eval_fill_AB);
   if (!strcmp(function_name, "eval_ident_Bx"))
      return reinterpret_cast<void *>(&eval_ident_Bx);
   return 0;
}
//-----------------------------------------------------------------------------
Token
eval_LRB(Function & LO, Function & RO, Value_P B,
         const NativeFunction * caller)
{
UCS_string ucs(UTF8_string("eval_LRB() called"));
Value_P Z(ucs, LOC);
   Z->check_value(LOC);
   return Token(TOK_APL_VALUE1, Z);
}
//-----------------------------------------------------------------------------
Token
eval_ALRB(Value_P A, Function & LO, Function & RO, Value_P B,
          const NativeFunction * caller)
{
UCS_string ucs(UTF8_string("eval_ALRB() called"));
Value_P Z(ucs, LOC);
   Z->check_value(LOC);
   return Token(TOK_APL_VALUE1, Z);
}

//-----------------------------------------------------------------------------
Token
eval_LRXB(Function & LO, Function & RO, Value_P X, Value_P B,
          const NativeFunction * caller)
{
UCS_string ucs(UTF8_string("eval_LRXB() called"));
Value_P Z(ucs, LOC);
   Z->check_value(LOC);
   return Token(TOK_APL_VALUE1, Z);
}
//-----------------------------------------------------------------------------
Token
eval_ALRXB(Value_P A, Function & LO, Function & RO, Value_P X, Value_P B,
           const NativeFunction * caller)
{
UCS_string ucs(UTF8_string("eval_ALRXB() called"));
Value_P Z(ucs, LOC);
   Z->check_value(LOC);
   return Token(TOK_APL_VALUE1, Z);
}
//-----------------------------------------------------------------------------

#endif

/// an optional function that is called when the native function in the
/// APL interpreter is about to be removed. Return \b true if the caller shall
/// dlclose() this library
bool
close_fun(Cause cause, const NativeFunction * caller)
{
   return true;
}

// prevent compiler warning
bool (*close_fun_is_unused)(Cause, const NativeFunction *) = &close_fun;

//-----------------------------------------------------------------------------
Token
eval_fill_B(Value_P B, const NativeFunction * caller)
{
UCS_string ucs(UTF8_string("eval_fill_B() called"));
Value_P Z(ucs, LOC);
   Z->check_value(LOC);
   return Token(TOK_APL_VALUE1, Z);
}
//-----------------------------------------------------------------------------
Token
eval_fill_AB(Value_P A, Value_P B, const NativeFunction * caller)
{
UCS_string ucs(UTF8_string("eval_fill_AB() called"));
Value_P Z(ucs, LOC);
   Z->check_value(LOC);
   return Token(TOK_APL_VALUE1, Z);
}
//-----------------------------------------------------------------------------
Token
eval_ident_Bx(Value_P B, sAxis x, const NativeFunction * caller)
{
UCS_string ucs(UTF8_string("eval_ident_Bx() called"));
Value_P Z(ucs, LOC);
   Z->check_value(LOC);
   return Token(TOK_APL_VALUE1, Z);
}
//-----------------------------------------------------------------------------

