/*
================================================================================
  RPL/2 (R) version 4.1.1
  Copyright (C) 1989-2011 Dr. BERTRAND Joël

  This file is part of RPL/2.

  RPL/2 is free software; you can redistribute it and/or modify it
  under the terms of the CeCILL V2 License as published by the french
  CEA, CNRS and INRIA.
 
  RPL/2 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 CeCILL V2 License
  for more details.
 
  You should have received a copy of the CeCILL License
  along with RPL/2. If not, write to info@cecill.info.
================================================================================
*/


#ifdef RPLCAS
#	include "giac.h"

#	undef PACKAGE
#	undef PACKAGE_NAME
#	undef PACKAGE_STRING
#	undef PACKAGE_TARNAME
#	undef PACKAGE_VERSION
#	undef VERSION
#endif

extern "C"
{
#	define __RPLCAS
#	include "rpl-conv.h"
}

#include <iostream>

using namespace std;

#ifdef RPLCAS
	using namespace giac;
#endif


static unsigned char *
conversion_rpl_vers_cas(struct_processus *s_etat_processus,
		struct_objet **s_objet)
{
	struct_liste_chainee	*l_element_courant;

	struct_objet			*s_objet_temporaire;

	t_8_bits				registre[8];

	unsigned char			*resultat;

	for(int i = 0; i < 8; i++)
	{
		registre[i] = s_etat_processus->drapeaux_etat[i];
	}

	cf(s_etat_processus, 48);
	cf(s_etat_processus, 49);
	cf(s_etat_processus, 50);
	cf(s_etat_processus, 53);
	cf(s_etat_processus, 54);
	cf(s_etat_processus, 55);
	cf(s_etat_processus, 56);

	// GIAC considère que les fonctions sont écrites en minuscules. Le RPL/2
	// part de l'hypothèse inverse. Il faut donc convertir en minuscules tous
	// les noms de fonction. Les fonctions ne peuvent apparaître que dans le
	// cas d'un objet de type ALG.

	if ((*s_objet)->type == ALG)
	{
		if ((*s_objet)->nombre_occurrences > 1)
		{
			if ((s_objet_temporaire = copie_objet(s_etat_processus,
					(*s_objet), 'O')) == NULL)
			{
				s_etat_processus->erreur_systeme = d_es_allocation_memoire;
				return(NULL);
			}

			liberation(s_etat_processus, (*s_objet));
			(*s_objet) = s_objet_temporaire;
		}

		l_element_courant = reinterpret_cast<struct_liste_chainee *>(
				(*s_objet)->objet);

		while(l_element_courant != NULL)
		{
			if (l_element_courant->donnee->type == FCT)
			{
				unsigned char		*ptr;

				ptr = reinterpret_cast<unsigned char *>(
						reinterpret_cast<struct_fonction *>(
						l_element_courant->donnee->objet)->nom_fonction);

				while((*ptr) != d_code_fin_chaine)
				{
					int c = (*ptr);

					if (isalpha(c))
					{
						c = tolower(c);
						(*ptr) = (unsigned char) c;
					}

					ptr++;
				}
			}

			l_element_courant = l_element_courant->suivant;
		}
	}

	resultat = formateur(s_etat_processus, 0, (*s_objet));
	resultat[0] = ' ';
	resultat[strlen((const char *) resultat) - 1] = ' ';

	for(int i = 0; i < 8; i++)
	{
		s_etat_processus->drapeaux_etat[i] = registre[i];
	}

	return(resultat);
}


static void
conversion_cas_vers_rpl(struct_processus *s_etat_processus,
		struct_objet *s_objet)
{
	struct_liste_chainee		*l_element_courant;
	struct_liste_chainee		*l_element_precedent;

	if ((s_objet->type == ALG) || (s_objet->type == RPN))
	{
		// On transcrit les fonctions de GIAC vers le RPL/2.

		l_element_precedent = NULL;
		l_element_courant = reinterpret_cast<struct_liste_chainee *>(
				s_objet->objet);

		while(l_element_courant != NULL)
		{
			if (l_element_courant->donnee->type == FCT)
			{
				// Nous sommes en présence d'un nom, donc de quelque chose
				// qui n'est pas reconnu comme un mot-clef du RPL/2. S'il
				// s'agit d'un mot-clef de GIAC, on le convertit.

				if (strcmp((const char *)
						reinterpret_cast<struct_fonction *>(l_element_courant
						->donnee->objet)->nom_fonction, "quote") == 0)
				{
					liberation(s_etat_processus, l_element_courant->donnee);

					if ((l_element_courant->donnee =
							allocation(s_etat_processus, FCT)) == NULL)
					{
						s_etat_processus->erreur_systeme =
								d_es_allocation_memoire;
						return;
					}

					if ((((struct_fonction *) l_element_courant->donnee->objet)
							->nom_fonction = reinterpret_cast<unsigned char *>(
							malloc(6 * sizeof(unsigned char))))
							== NULL)
					{
						s_etat_processus->erreur_systeme =
								d_es_allocation_memoire;
						return;
					}

					strcpy(reinterpret_cast<char *>(
							reinterpret_cast<struct_fonction *>(
							l_element_courant->donnee->objet)->nom_fonction),
							"RELAX");
				}
			}

			l_element_precedent = l_element_courant;
			l_element_courant = l_element_courant->suivant;
		}
	}

	return;
}


/*
================================================================================
  Fonction 'interface_cas'
================================================================================
  Entrées : commande à effectuer.
  Le contrôle des types est effectué dans la fonction appelant interface_cas().
--------------------------------------------------------------------------------
  Sorties : retour par la pile.
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
interface_cas(struct_processus *s_etat_processus,
		enum t_rplcas_commandes commande)
{
#	ifdef RPLCAS
	struct_objet			*s_objet_argument_1;
	struct_objet			*s_objet_argument_2;

	unsigned char			*argument_1;
	unsigned char			*argument_2;
	unsigned char			*registre;

	switch(commande)
	{
		case RPLCAS_INTEGRATION:
		{
			if (depilement(s_etat_processus, &(s_etat_processus->l_base_pile),
					&s_objet_argument_1) == d_erreur)
			{
				(*s_etat_processus).erreur_execution = d_ex_manque_argument;
				return;
			}

			if (depilement(s_etat_processus, &(s_etat_processus->l_base_pile),
					&s_objet_argument_2) == d_erreur)
			{
				liberation(s_etat_processus, s_objet_argument_1);
				(*s_etat_processus).erreur_execution = d_ex_manque_argument;
				return;
			}

			if ((argument_1 = conversion_rpl_vers_cas(s_etat_processus,
					&s_objet_argument_1)) == NULL)
			{
				s_etat_processus->erreur_systeme = d_es_allocation_memoire;
				return;
			}

			if ((argument_2 = conversion_rpl_vers_cas(s_etat_processus,
					&s_objet_argument_2)) == NULL)
			{
				s_etat_processus->erreur_systeme = d_es_allocation_memoire;
				return;
			}

			liberation(s_etat_processus, s_objet_argument_1);
			liberation(s_etat_processus, s_objet_argument_2);

			try
			{
				giac::context 	contexte;

				gen variable(
						string(reinterpret_cast<const char *>(argument_1)),
						&contexte);
				gen expression(
						string(reinterpret_cast<const char *>(argument_2)),
						&contexte);

				gen resultat = integrate(expression, variable, &contexte);
				string chaine = "'" + resultat.print() + "'";

				registre = s_etat_processus->instruction_courante;
				s_etat_processus->instruction_courante =
						reinterpret_cast<unsigned char *>(const_cast<char *>
						(chaine.c_str()));

				recherche_type(s_etat_processus);

				if (s_etat_processus->l_base_pile != NULL)
				{
					conversion_cas_vers_rpl(s_etat_processus,
							s_etat_processus->l_base_pile->donnee);
				}

				s_etat_processus->instruction_courante = registre;
			}
			catch(bad_alloc exception)
			{
				s_etat_processus->erreur_systeme = d_es_allocation_memoire;
			}
			catch(...)
			{
				s_etat_processus->erreur_execution = d_ex_erreur_interne_rplcas;
			}

			free(argument_1);
			free(argument_2);

			break;
		}

		case RPLCAS_LIMITE:
		{
			break;
		}
	}

	return;

#else

	if (s_etat_processus->langue == 'F')
	{
		printf("+++Attention : RPL/CAS non compilé !\n");
	}
	else
	{
		printf("+++Warning : RPL/CAS not available !\n");
	}

	fflush(stdout);

	return;

#endif
}

// vim: ts=4