ERPL/erpli.c

// common state:

// TODO check internal functions considering the atoms admit tables now

static int lastchar = -1;

static Table *globals = NULL;
static List *stack = NULL;

static int nil_symb[] = {3,'n','i','l'};

// basic input:

int _getchar () {
   int ch = getchar();
   if (ch == -1)
      exit(0);
   return ch;
}

Atom* _warning (char* msg) {
   puts(msg);
   return NULL;
}

Atom* _error (char* msg) {
   puts(msg);
   exit(1);
   return NULL;
}

// printing:

void print_symbol (int* symb) {
   for (int a = 1; a <= symb[0]; a++)
      putchar(symb[a]);
}

void print_expression (Atom* expr) {
   if (!expr) {
      printf("nil");
      return;
   }
   if (expr->type == NUM) {
      printf("%d", expr->num);
      return;
   }
   if (expr->type == SYMB) {
      print_symbol(expr->symb);
      return;
   }
   putchar('(');
   if (expr->type == LAMBDA) {
      printf("lambda ");
      List *li = expr->list;
      while (li) {
         print_expression(li->head);
         li = li->tail;
         if (li)
            putchar(' ');
      }
   }
   if (expr->type == TABLE) {
      printf("table ");
      Table *ta = expr->table;
      while (ta) {
         print_symbol(ta->key);
         putchar(' ');
         print_expression(ta->value);
         ta = ta->next;
         if (ta)
            putchar(' ');
      }
   }
   putchar(')');
}

// stack manipulation:

void stack_push (Atom* at, List** st) {
   List *nl = cons(duplicate_atom(at),*st);
   *st = nl;
}

void stack_pop (int how_much, List** st) {
   if (how_much < 0) {
      _error("STACK_POP: Invalid value");
      return;
   }
   if (how_much == 0) {
      free_list(*st);
      *st = NULL;
      return;
   }
   List *st2 = *st;
   while (how_much && st2) {
      how_much --;
      if (!how_much) {
         *st = st2->tail;
         st2->tail = NULL;
         break;
      }
      st2 = st2->tail;
   }
   free_list(st2);
}

// type operations:

// test for nil before using this:
int is_simple (Atom* at) {
   return at->type != LIST && at->type != LAMBDA;
}

int is_list (Atom* at) {
   return at == NULL || at->type == LIST;
}

// there are multiline symbols and simple symbols
// multiline symbols carries a '"' as their first character, simple symbols don't
int is_symbol (Atom* at) {
   return at != NULL &&
      at->type == SYMB &&
      at->symb[0] >= 1 &&
      at->symb[1] != '"';
}

int valid_lambda (List* body) {
   if (list_size(body) < 1)
      return (int)_warning("LAMBDA" TOO_SHORT);
   if (!is_list(body->head))
      return (int)_warning("LAMBDA" MUST_BE_LIST " (element 1)");
   if (body->head) {
      if (!is_symbol_list(body->head->list))
         return (int)_warning("LAMBDA" MUST_BE_SYMLIST " (element 1)");
   }
   return 1;
}

unsigned is_symbol_list (List* list) {
   while (list) {
      if (!is_symbol(list->head)) return 0;
      list = list->tail;
   }
   return 1;
}

// object comparation:

unsigned equal (Atom* le, Atom* ri) {
   if (le == ri)
      return 1;
   if (le == NULL || ri == NULL)
      return 0;
   if (le->type != ri->type)
      return 0;
   if (le->type == NUM)
      return le->num == ri->num;
   if (le->type == SYMB)
      return symbols_are_equal(le->symb, ri->symb);
   return lists_are_equal(le->list, ri->list);
}

unsigned lists_are_equal (List* le, List* ri) {
   while (le && ri) {
      if (!equal(le->head, ri->head))
         return 0;
      le = le->tail;
      ri = ri->tail;
   }
   return le == NULL && ri == NULL;
}

int list_size (List* li) {
   int size = 0;
   while (li) {
      li = li->tail;
      size++;
   }
   return size;
}

#include "erplm.c" // memory operations
#include "erplt.c" // table operations
#include "erplp.c" // parsing