/* Polymorphic lists in C, with truly polymorphic bodies
 *
 * No widening and otherwise unsafe casts are used.
 * Note how sscanf() and friends are used as "coercion" operators:
 * I never thought of them that way before. Indeed, serialization (pickling)
 * is a polymorphic type conversion operation: from a concrete type
 * to a universal character String type.
 * If we continue this exercise further, we'll eventually come to Tcl.
 *
 * Note the definition and use of a FOLD combinator.
 *
 * We are a bit lax on collecting the garbage. Let's assume Boehm collector
 * installed, for simplicity. We don't do as much error checking as we should.
 *
 * Note, this code tries to be as strictly ANSI-C compliant as I could
 * manage. No casts except trivial (char *)0 and (LHead *)0 are used at all!
 *
 * $Id: poly-list.c,v 2.1 2000/10/02 21:36:39 oleg Exp oleg $
 */


/* Standard Library functions. To avoid introducing even implicit casts,
   we declare functions we use.
*/
#include <float.h>		/* for DBL_DIG */
#include <stdio.h>		/* for FILE* and printf */
#include <assert.h>

char	*strcpy(char *, const char *);	/* from strings.h */
int	 atoi(const char *);		/* from stdlib.h  */
double	 atof(const char *);
size_t	 strlen(const char *);

/* printf() may raise concern. It is always possible however to
 * convert integers and doubles to ASCII in a type-safe
 * manner. printf() is a mighty convenient _shortcut_. Besides, some
 * compilers, e.g., gcc, actually check to see that printf() arguments
 * match in type to the correspondent format specifiers.
 */


typedef struct s_LHead {
  struct s_LHead * next;
  int type_tag;
  int size;		/* The size of the data below */
  char * data;		/* The data themselves, in an _external_ form
			   as a character string */
} LHead;

#define NIL ((LHead *)0)


/* Allocator for strings. It's very primitive, but will do for the
 * exercise. We stress that it's a type-safe allocator -- and
 * a type-safe allocator is expressible in strict ANSI C. 
 */

#define STR_POOL_SIZE  (1<<16)
static char String_Pool[STR_POOL_SIZE];
static char * String_pool_p = String_Pool;
static char * String_pool_end = String_Pool + STR_POOL_SIZE;

	/* len must account for the \0 terminator */
char * new_str(const size_t len)
{
  char * p = String_pool_p;
  assert( (String_pool_p+=len) < String_pool_end );
  return p;
}

char * clone_str(const char * str)
{
  assert( str != (char *)0 );
  return strcpy(new_str(strlen(str)+1),str);
}

/* It's a very primitive allocator: enough for this exercise */
void free_str(char * str)
{
  /* free(str); */
}

/* Allocate a new LHead. The following allocator is very primitive and
 * garbage-producing. It is type-safe however. It can be improved
 * without losing the type safety.
 */

#define LHEAD_POOL_SIZE  (1<<16)
static LHead LHead_Pool[LHEAD_POOL_SIZE];
static LHead * LHead_pool_p =  LHead_Pool;
static LHead * LHead_pool_end =  LHead_Pool + LHEAD_POOL_SIZE;

static LHead * new_elem(LHead * next, const int type_tag,
			const char * data)
{
  const int size = strlen(data) + 1;
  LHead * p = LHead_pool_p;
  assert( (LHead_pool_p++) < LHead_pool_end );
  p->next = next;
  p->type_tag = type_tag;
  p->size = size;
  p->data = clone_str(data);
  return p;
}


/* Find the length of _any_ List */
/* Note this function is declared ahead of any particular list */

static int length(const LHead * list)
{
  int count = 0;
  for(; list != NIL; list = list->next)
    count++;
  return count;
}

/* Create a new list that has the same type and elements as the source
   list but in the reverse order. Again, this function operates on _any_
   list, regardless of its type.
*/

static LHead * reverse(const LHead * src)
{
  LHead * p = NIL;
  for(; src != NIL; src = src->next )
  {				/* Clone the current list element */
    p = new_elem(p,src->type_tag,src->data);
  }
  return p;
}

/* Fold iterator. It takes a List, a Functor, and a Seed variable.
   The functor should have the signature:

   typeof(Seed_var) functor(LHead *,typeof(Seed_var))

   If the list is empty, the Seed_var is not modified.
   Otherwise, it is set to be
     functor(list.e1,functor(list.e2, ... functor(list.en,seed)))

   The iterator is not meant to be used by itself but rather instantiated
   into functions that need it. Therefore, it is a macro.
   Compare to STL for_each(), which is a template (read: elevated macro).
*/
#define XY(X,Y) X##Y
#define MakeNameXY(FX,LINE) XY(FX,LINE)
#define MakeName(FX) MakeNameXY(FX,__LINE__)

#define FOLD(List, Functor, Seed_var) \
  { LHead * MakeName(L_H_e_a_d) = List; \
    for(;MakeName(L_H_e_a_d) != NIL; MakeName(L_H_e_a_d)=MakeName(L_H_e_a_d)->next) \
      Seed_var = Functor(MakeName(L_H_e_a_d),Seed_var); }

  
/* For-each iterator of non-closures. It applies the function
   void f(LHead *)
   This could be a real function, but we make it a macro to resemble
   a more generic fold iterator above. This also helps efficiency.
*/

#define FOR_EACH(List,Functor) \
 { LHead * __p = List; \
   for(;__p != NIL; __p=__p->next) Functor(p); }


static int count_elem_size(LHead * elem, int old_total)
{
  return old_total + elem->size;
}

/* Return a string which is concatenation of all the bodies
   of the list, separated by a delim character.
   The return string is always heap-allocated.
*/
static char * LHead_to_str(LHead * list, const char delim)
{
  char *str = (char *)0, *p = (char *)0;
  int total_size = 0;
  if( list == NIL )
    return clone_str("");
  FOLD(list,count_elem_size,total_size);
  str = new_str(total_size);
  for(p=str; list != NIL; list = list->next)
    strcpy(p,list->data), p+=strlen(list->data),
      *p++ = delim;
  *--p = '\0';
  return str;
}

/* List of integers */

#define LInt_type 1

/* List of numbers i_from .. i_to-1 */
static LHead * range(const int i_from, const int i_to)
{
  register int i;
  register LHead * p = NIL;
  char buffer [(24*sizeof(int)+27)/10+3];	/* enough for MAXINT */
  for(i=i_to; --i>=i_from;)
  {
    snprintf(buffer,sizeof(buffer)-1, "%d",i);
    p = new_elem(p,LInt_type,buffer);
  }
  return p;
}


static void LInt_print(LHead * list)
{
  char * str = LHead_to_str(list,' ');
  printf("{%s}",str);
  free_str(str);
}

static int LInt_add(LHead * elem, const int old_total)
{
  assert( elem != NIL && elem->type_tag == LInt_type );
  return old_total + atoi(elem->data);
}

/* Sum all elements of the list */
static int LInt_sum(LHead * list)
{
  int total = 0;
  FOLD(list,LInt_add,total);
  return total;
}

/* List  of floats */
#define LFl_type 2

/* List of numbers [from,to,step] */
/* Note that I went out of my way to avoid even implicit casts */
/* Note the use of reverse() */

static LHead * range_step
(const double from, const double to, const double step)
{
  register double f;
  register LHead * p = NIL;
  char buffer [DBL_DIG+5];		/* enough for MAXDOUBLE */
  for(f=from; f<to; f+=step)
  {
    snprintf(buffer,sizeof(buffer)-1, "%g",f);
    p = new_elem(p,LFl_type,buffer);
  }
  return reverse(p);
}


static void LFl_print(LHead * list)
{
  char * str = LHead_to_str(list,' ');
  printf("{%s}",str);
  free_str(str);
}

static double LFl_add(LHead * elem, const double old_total)
{
  assert( elem != NIL && elem->type_tag == LFl_type );
  return old_total + atof(elem->data);
}

/* Sum all elements of the list */
static double LFl_sum(LHead * list)
{
  double total = 0;
  FOLD(list,LFl_add,total);
  return total;
}


/* The test driver */

int main(void)
{
  LHead * int_l = range(1,11);
  LHead * fl_l = range_step(0.1,10.1,0.5);

  printf("Testing Polymorphic lists\n");
  printf("\nThe length of an empty list: %d\n",length(NIL));

  printf("\nA list of integers: "); LInt_print(int_l);
  printf("\nIts length is %d", length(int_l));
  printf("\nIts reverse is: "); LInt_print(reverse(int_l));
  printf("\nIts sum is %d\n",LInt_sum(int_l));

  printf("\nA list of floats: "); LFl_print(fl_l);
  printf("\nIts length is %d", length(fl_l));
  printf("\nIts reverse is: "); LFl_print(reverse(fl_l));
  printf("\nIts sum is %g\n",LFl_sum(fl_l));
  return 0;
}