--- rpl/modules/sets/types.rplc	2017/06/29 12:32:57	1.1
+++ rpl/modules/sets/types.rplc	2018/06/01 13:02:13	1.6
@@ -5,6 +5,18 @@
 // Les objets de type ensemble sont délimités par ([ ]) et ne contiennent
 // que des entiers.
 
+// Attention : ces fonctions sont à écrire directement en C et non
+// en RPL/C car elles interviennent dans le noyau RPL/2.
+
+/*
+================================================================================
+  Fonction permettant d'extraire un objet d'une suite de caractères
+
+  Cette fonction est utilisée par la routine recherche_instruction_suivante()
+  du RPL/2.
+================================================================================
+*/
+
 declareTypeExtension(parse)
 	if ((*rptr) == '(')
 	{
@@ -57,16 +69,258 @@ declareTypeExtension(parse)
 			}
 		}
 	}
+
+	parseError;
 endTypeExtension
 
+
+/*
+================================================================================
+  La fonction declareTypeExtension(new) est utilisée par la fonction
+  recherche_type() du RPL/2. Elle se charge d'allouer et d'initialiser
+  le champ objet de la struct_objet allouée par recherche_type().
+================================================================================
+*/
+
+static int
+fonction_ordre(const void *a, const void *b)
+{
+	if ((*((integer8 *) a)) < (*((integer8 *) b)))
+	{
+		return(-1);
+	}
+	if ((*((integer8 *) a)) > (*((integer8 *) b)))
+	{
+		return(1);
+	}
+
+	return(0);
+}
+
 declareTypeExtension(new)
+	// Si le premier caractère de la chaîne est '(' et que le dernier est ')',
+	// on les retire.
+
+	char			*tmp;
+
+	integer8		current_value;
+	integer8		i;
+	integer8		j;
+	integer8		nb_elements;
+	integer8		*vecteur;
+
+	if (((*iptr) == '(') && ((*(iptr + strlen(iptr) - 1)) == ')'))
+	{
+		if ((tmp = malloc((strlen(iptr) + 1) * sizeof(unsigned char)))
+				== NULL)
+		{
+			typeSystemError;
+		}
+
+		// Sauvegarde de l'instruction courante.
+		strcpy(tmp, iptr);
+
+		// Création d'une nouvelle instruction courante amputée de ses premier
+		// et dernier caractères.
+		memmove(iptr, iptr + 1, strlen(iptr) - 2);
+		*(iptr + strlen(iptr) - 2) = 0;
+
+		searchType(strcpy(iptr, tmp), free(tmp));
+
+		// Restauration de l'instruction courante
+		strcpy(iptr, tmp);
+		free(tmp);
+
+		// On doit avoir un vecteur d'entiers au niveau 1 de la pile.
+		// Si ce n'est pas le cas, il y a une erreur.
+
+		if ((*(*(*s_etat_processus).l_base_pile).donnee).type != VIN)
+		{
+			typeError;
+		}
+
+		nb_elements = (*((struct_vecteur *) (*(*(*s_etat_processus)
+				.l_base_pile).donnee).objet)).taille;
+
+		if (nb_elements > 0)
+		{
+			if ((vecteur = malloc(nb_elements * sizeof(integer8))) == NULL)
+			{
+				typeSystemError;
+			}
+
+			for(i = 0; i < nb_elements; i++)
+			{
+				vecteur[i] = ((integer8 *) (*((struct_vecteur *)
+						(*(*(*s_etat_processus)
+						.l_base_pile).donnee).objet)).tableau)[i];
+			}
+
+			qsort(vecteur, nb_elements, sizeof(integer8), fonction_ordre);
+
+			// Élimination des doublons
+
+			current_value = vecteur[0];
+
+			for(i = 1, j = 1; i < nb_elements; i++)
+			{
+				if (vecteur[i] != current_value)
+				{
+					vecteur[j++] = vecteur[i];
+					current_value = vecteur[i];
+				}
+			}
+
+			nb_elements = j;
+
+			if ((vecteur = realloc(vecteur, nb_elements * sizeof(integer8)))
+					== NULL)
+			{
+				typeSystemError;
+			}
+		}
+		else
+		{
+			// cas de l'ensemble vide
+			if ((vecteur = malloc(0)) == NULL)
+			{
+				typeSystemError;
+			}
+		}
+
+		if (((*arg) = malloc(sizeof(set_t))) == NULL)
+		{
+			typeSystemError;
+		}
+
+		(**((set_t **) arg)).size = nb_elements;
+		(**((set_t **) arg)).values = vecteur;
+
+		instruction_drop(s_etat_processus);
+		typeFound(ISET);
+	}
+
+	typeError;
 endTypeExtension
 
+
+/*
+================================================================================
+  Fonction de duplication d'un objet.
+
+  Cet objet doit être alloué puis copié.
+================================================================================
+*/
+
 declareTypeExtension(dup)
-endTypeExtension
+	integer8		i;
 
-declareTypeExtension(disp)
+	struct_objet	*n_arg;
+
+	if ((n_arg = allocation(s_etat_processus, EXT)) == NULL)
+	{
+		typeSystemError;
+	}
+
+	if (((*n_arg).objet = malloc(sizeof(set_t))) == NULL)
+	{
+		typeSystemError;
+	}
+
+	(*((set_t *) ((*n_arg).objet))).size = (*((set_t *) (**((struct_objet **)
+			arg)).objet)).size;
+	(*n_arg).descripteur_bibliotheque =
+			(**((struct_objet **) arg)).descripteur_bibliotheque;
+	(*n_arg).extension_type =
+			(**((struct_objet **) arg)).extension_type;
+
+	if (((*((set_t *) ((*n_arg).objet))).values = malloc((*((set_t *)
+			((*n_arg).objet))).size * sizeof(integer8))) == NULL)
+	{
+		typeSystemError;
+	}
+
+	for(i = 0; i < (*((set_t *) (**((struct_objet **) arg)).objet)).size; i++)
+	{
+		(*((set_t *) ((*n_arg).objet))).values[i] =
+				(*((set_t *) (**((struct_objet **) arg)).objet)).values[i];
+	}
+
+	(*((struct_objet **) arg)) = n_arg;
+	typeSuccess;
 endTypeExtension
 
+
+/*
+================================================================================
+  Fonction de libération d'un objet. À l'instar de la fonction new qui n'alloue
+  pas la struct_objet, la fonction drop ne doit pas la libérer.
+================================================================================
+*/
+
 declareTypeExtension(drop)
+	free((*((set_t *) (**((struct_objet **) arg)).objet)).values);
+	free((**((struct_objet **) arg)).objet);
+	typeSuccess;
 endTypeExtension
+
+
+/*
+================================================================================
+  Fonction créant une chaîne de caractère depuis l'objet pour affichage
+================================================================================
+*/
+
+declareTypeExtension(disp)
+	int		i;
+
+	string	e;
+	string	s;
+	string	t;
+
+	if ((s = malloc(3 * sizeof(unsigned char))) == NULL)
+	{
+		typeSystemError;
+	}
+
+	strcpy(s, "([");
+
+	for(i = 0; i < (*((set_t *) (*((struct_objet *) (*arg))).objet)).size; i++)
+	{
+		if ((e = (string) integerFormat(&((*((set_t *)
+				(*((struct_objet *) (*arg))).objet)).values[i]))) == NULL)
+		{
+			typeSystemError;
+		}
+
+		t = s;
+
+		if ((s = malloc((strlen(t) + strlen(e) + 2) * sizeof(unsigned char)))
+				== NULL)
+		{
+			typeSystemError;
+		}
+
+		strcpy(s, t);
+		free(t);
+		strcat(s, " ");
+		strcat(s, e);
+		free(e);
+	}
+
+	t = s;
+
+	if ((s = malloc((strlen(t) + 4) * sizeof(unsigned char))) == NULL)
+	{
+		typeSystemError;
+	}
+
+	strcpy(s, t);
+	free(t);
+	strcat(s, " ])");
+
+	(*arg) = s;
+	typeSuccess;
+endTypeExtension
+
+// vim: ts=4