orangesquid (os) wrote,
orangesquid
os

lambda calculus parser

#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include <ctype.h>
#include <limits.h>

int debugdisp;
int debugatlas;
int debugparen;
int debugparse;

struct node {
  struct node *next, *prev, *parent, *list;
  int depth;
  enum {sub, lambda, term, dbterm, lterm} type;
  char value;
  int index;
  int noparen;
};

struct var;
struct ref {
  struct ref *prev, *next;
  struct var *var;
  struct node *ref;
};

struct var {
  struct var **atlas;
  struct var *prev, *next;
  char value;
  struct node *binding;
  struct ref *terms;
};

int leftwidth(struct node *tree) {
  int left, right;
  if(!tree)
    return 0;
  left = leftwidth(tree->list) + 1;
  right = leftwidth(tree->next) - 1;
  return left > right ? left : right;
}

int rightwidth(struct node *tree) {
  int left, right;
  if(!tree)
    return 0;
  left = rightwidth(tree->list) - 1;
  right = rightwidth(tree->next) + 1;
  return left > right ? left : right;
}

int height(struct node *tree) {
  if(!tree)
    return 0;
  if(tree->prev)
    return 1 + height(tree->prev);
  if(tree->parent)
    return 1 + height(tree->parent);
  return 0;
}

void dispwidths(struct node *tree) {
  if(!tree)
    return;
  dispwidths(tree->list);
  printf("%d/%c%d[%p]%d:%d%c%c\\%d\n",
    leftwidth(tree), tree->list ? '-' : ' ', height(tree), tree, tree->type,
    tree->index, tree->value ? tree->value : '-', tree->next ? '-' : ' ',
    rightwidth(tree));
  dispwidths(tree->next);
}

int tallywidths(struct node *tree, int depth, int textlen) {
  if(!tree)
    return 0;
  return tallywidths(tree->list, depth, textlen) +
    tallywidths(tree->next, depth, textlen) +
    (depth == height(tree) ? leftwidth(tree) + rightwidth(tree) + textlen : 0);
}

void dispdepthsub(struct node *tree, int d, int w, int cols, char *buf) {
  if(!tree)
    return;
  dispdepthsub(tree->list, d, w, cols, buf);
  if(height(tree) == d) {
    int left, right, length, textlen;
    left = leftwidth(tree);
    right = rightwidth(tree);
    length = cols * (left + right + 3) / w;
    if(debugdisp) {
      printf("%p:L%d,R%d (tally%d) [%dcol]: fieldsize %d\n", tree, left, right,
        w, cols, length);
    }
    snprintf(buf, cols + 1, "%d:%c", tree->type,
      tree->value ? tree->value : '-');
    buf[cols] = '\0';
    textlen = strlen(buf);
    if(debugdisp) {
      printf("%d ch: '%s'\n", textlen, buf);
    }
    length = length / 2 - textlen;
    if(debugdisp) {
      printf("offset %d -> ", length);
    }
    length -= length < 0 ? length - 1 : 0;
    if(debugdisp) {
      printf("%d -> ", length);
    }
    if(textlen + 2 * length >= cols) {
      length -= length + (textlen - cols / 2) + textlen % 2;
    }
    if(debugdisp) {
      printf("%d\n", length);
    }
    if(debugdisp) {
      printf("move %d by %d\n", textlen, length);
    }
    memmove(buf + length, buf, textlen);
    if(debugdisp) {
      printf("fill %d\n", length);
    }
    memset(buf, ' ', length);
    if(debugdisp) {
      printf("fill %d at %d\n", length, length + textlen);
    }
    memset(buf + length + textlen, ' ', length);
    buf[cols] = '\0';
    fputs(buf, stdout);
  }
  dispdepthsub(tree->next, d, w, cols, buf);
}

void dispdepth(struct node *tree, int depth, int columns, char *buf) {
  int width;
  width = tallywidths(tree, depth, 3);
  dispdepthsub(tree, depth, width, columns, buf);
  fputc('\n', stdout);
}

void disptree(struct node *tree) {
  int max, depth, columns;
  char *colstr, *buf;
  max = maxheight(tree);
  colstr = getenv("COLUMNS");
  if(colstr) {
    if(debugdisp) {
      printf("env:%s\n", colstr);
    }
    colstr = strchr(colstr, '=');
    if(colstr) {
      if(debugdisp) {
        printf("atoi(%s)=", colstr);
      }
      columns = atoi(colstr);
      if(debugdisp) {
        printf("%d\n", columns);
      }
      if(!columns)
        columns = 72;
    } else
      columns = 72;
  } else
    columns = 72;
  buf = (char *) malloc(columns + 1);
  if(!buf)
    return;
  for(depth = 0; depth <= max; ++depth) {
    dispdepth(tree, depth, columns, buf);
  }
  free(buf);
}

int maxdepth(struct node *tree) {
  int left, right;
  if(!tree)
    return 0;
  left = maxdepth(tree->list);
  right = maxdepth(tree->next);
  return left ? (right ?
                  (left > right ? left : right) : left) :
                (right ? right : tree->depth);
}

int maxheight(struct node *tree) {
  int left, right;
  if(!tree)
    return 0;
  left = maxheight(tree->list);
  right = maxheight(tree->next);
  return 1 + (left > right ? left : right);
}

void addref(struct var **atlas, struct node *term) {
  struct var *var;
  struct node *binding;
  struct ref *ref;
  if(!term || !atlas)
    return;
  for(binding = term; binding; binding = binding->parent) {
    if(binding->type == lambda && binding->list &&
       binding->list->type == lterm && binding->list->value == term->value) {
      break;
    }
  }
  for(var = *atlas; var && var->next; var = var->next) {
    if(var->next->value >= term->value)
      break;
  }
  if(!var) {
    if(debugatlas) {
      printf("start with %p=%d:%c\n", term, term->type, term->value);
    }
    var = (struct var *) malloc(sizeof(struct var));
    if(!var)
      return;
    var->next = NULL;
    var->prev = NULL;
    var->value = 0;
  } else if(var->value < term->value && !var->next) {
    if(debugatlas) {
      printf("appending %p=%d:%c\n", term, term->type, term->value);
    }
    var->next = (struct var *) malloc(sizeof(struct var));
    if(!var->next)
      return;
    var->next->next = NULL;
    var->next->prev = var;
    var->next->value = 0;
    var = var->next;
  } else if(var->value > term->value && !var->next) {
    struct var *insert;
    if(debugatlas) {
      printf("prepending %p=%d:%c\n", term, term->type, term->value);
    }
    insert = (struct var *) malloc(sizeof(struct var));
    if(!insert)
      return;
    insert->next = var;
    insert->prev = var->prev;
    var->prev = insert;
    insert->value = 0;
    var = insert;
  } else if(var->value == term->value && !var->next) {
    if(var->binding != binding) {
      struct var *insert;
      if(debugatlas) {
        printf("b-appending %p=%d:%c\n", term, term->type, term->value);
      }
      insert = (struct var *) malloc(sizeof(struct var));
      if(!insert)
        return;
      insert->next = var->next;
      var->next = insert;
      insert->prev = var;
      insert->value = 0;
      var = insert;
    } else
      if(debugatlas) {
        printf("head has [%p]%c\n", binding, term->value);
      }
  } else if(var->next->value > term->value) {
    struct var *insert;
    if(debugatlas) {
      printf("inserting %p=%d:%c\n", term, term->type, term->value);
    }
    insert = (struct var *) malloc(sizeof(struct var));
    if(!insert)
      return;
    insert->next = var->next;
    var->next->prev = insert;
    insert->prev = var;
    insert->value = 0;
    var->next = insert;
    var = insert;
  } else {
    if(var->next->binding != binding) {
      struct var *insert;
      if(debugatlas) {
        printf("b-inserting %p=%d:%c\n", term, term->type, term->value);
      }
      insert = (struct var *) malloc(sizeof(struct var));
      if(!insert)
        return;
      insert->next = var->next;
      var->next->prev = insert;
      insert->prev = var;
      insert->value = 0;
      var->next = insert;
      var = insert;
    } else
      if(debugatlas) {
        printf("found [%p]%c\n", binding, term->value);
      }
  }
  if(!*atlas)
    *atlas = var;
  var->binding = binding;
  if(!var->value) {
    var->atlas = atlas;
    var->value = term->value;
  }
  ref = (struct ref *) malloc(sizeof(struct ref));
  if(!ref)
    return;
  ref->prev = NULL;
  ref->next = var->terms;
  if(var->terms) {
    if(debugatlas) {
      printf("new ref [%p]%d:%c\n", binding, term->type, term->value);
    }
    var->terms->prev = ref;
  } else
    if(debugatlas) {
      printf("1st ref [%p]%d:%c\n", binding, term->type, term->value);
    }
  var->terms = ref;
  ref->var = var;
  ref->ref = term;
}

void buildatlassub(struct var **atlas, struct node *tree) {
  if(!tree || !atlas)
    return;
  if(tree->type == term || tree->type == lterm || tree->type == dbterm) {
    printf("atlas %p: adding %p=%d:%c\n", atlas, tree,
      tree->type, tree->value);
    addref(atlas, tree);
  }
  buildatlassub(atlas, tree->list);
  buildatlassub(atlas, tree->next);
}

void displayatlas(struct var *atlas) {
  struct var *var;
  struct ref *ref;
  for(var = atlas; var; var = var->next) {
    printf("[%p]%c:\n", var->binding, var->value);
    for(ref = var->terms; ref; ref = ref->next) {
      printf("* [%p]%d:%c\n", ref->ref, ref->ref ? ref->ref->type : -1,
        ref->ref ? ref->ref->value : '-');
    }
  }
}

struct node *newchild(struct node *parent) {
  struct node *rv;
  rv = (struct node *) malloc(sizeof(struct node));
  if(rv) {
    rv->list = NULL;
    rv->noparen = 0;
    rv->type = sub;
    rv->value = 0;
    rv->prev = NULL;
    rv->next = NULL;
    rv->index = -1;
    if(parent) {
      rv->depth = 1 + parent->depth;
      rv->parent = parent;
      parent->list = rv;
    } else {
      rv->depth = 0;
      rv->parent = NULL;
    }
  }
  return rv;
}

struct node *newnode(struct node *prev) {
  struct node *rv;
  if(prev && (prev->type != term && prev->type != dbterm) && !prev->list)
    return newchild(prev);
  rv = (struct node *) malloc(sizeof(struct node));
  if(rv) {
    rv->list = NULL;
    rv->noparen = 0;
    rv->type = sub;
    rv->value = 0;
    rv->index = -1;
    if(prev) {
      rv->prev = prev;
      rv->depth = prev->depth;
      rv->parent = prev->parent;
      rv->next = prev->next;
      prev->next = rv;
    } else {
      rv->prev = NULL;
      rv->depth = 0;
      rv->parent = NULL;
      rv->next = NULL;
    }
  }
  return rv;
}

void display(struct node *tree) {
  if(tree) {
    printf("[%d]", tree->depth);
    if(tree->type == term)
      printf("T:%c", tree->value);
    else if(tree->type == lterm)
      printf("LT:%c", tree->value);
    else if(tree->type == dbterm)
      printf("T=%d:%c", tree->index, tree->value);
    else {
      if(!tree->noparen) {
        printf("%c(", tree->type == sub ? 's' : 'L');
        display(tree->list);
        fputc(')', stdout);
      } else {
        fputc(tree->type == sub ? 's' : 'L', stdout);
        display(tree->list);
      }
    }
    if(tree->next) {
      fputs(", ", stdout);
      display(tree->next);
    }
  }
}

void fdisplay(struct node *tree) {
  if(tree) {
    if(tree->type == term)
      printf("%c", tree->value);
    else if(tree->type == lterm) {
      if(debugdisp) {
        printf("{%dP%d}", tree->parent ? tree->parent->type : -1,
          tree->parent ? tree->parent->noparen : -1);
      }
      if(!tree->parent || tree->parent->type != lambda ||
         tree->parent && tree->parent->type == lambda &&
         !tree->parent->noparen)
        printf("%c.[", tree->value);
      else
        printf("%c.", tree->value);
    } else if(tree->type == dbterm)
      printf("%c", tree->value);
    else if(tree->type == sub) {
      if(!tree->noparen) {
        fputc('(', stdout);
        fdisplay(tree->list);
        fputc(')', stdout);
      } else
        fdisplay(tree->list);
    } else if(tree->type == lambda) {
      fputc('\\', stdout);
      if(debugdisp) {
        printf("{%d}", tree->noparen);
      }
      fdisplay(tree->list);
      if(!tree->noparen)
        fputc(']', stdout);
    }
    if(tree->next) {
      fdisplay(tree->next);
    }
  }
}

void dbdisplay(struct node *tree) {
  if(tree) {
    if(tree->type == term)
      printf("%c", tree->value);
    else if(tree->type == lterm) {
      if(!tree->parent || tree->parent->type != lambda ||
         tree->parent && tree->parent->type == lambda &&
         !tree->parent->noparen)
        fputc('[', stdout);
    } else if(tree->type == dbterm)
      printf("%d", tree->index);
    else if(tree->type == sub) {
      if(!tree->noparen) {
        fputc('(', stdout);
        dbdisplay(tree->list);
        fputc(')', stdout);
      } else
        dbdisplay(tree->list);
    } else if(tree->type == lambda) {
      fputc('\\', stdout);
      dbdisplay(tree->list);
      if(!tree->noparen)
        fputc(']', stdout);
    }
    if(tree->next) {
      dbdisplay(tree->next);
    }
  }
}

void displaynl(struct node *tree) {
  display(tree);
  fputc('\n', stdout);
}

void fdisplaynl(struct node *tree) {
  fdisplay(tree);
  fputc('\n', stdout);
}

void dbdisplaynl(struct node *tree) {
  dbdisplay(tree);
  fputc('\n', stdout);
}

void debruijn(struct node *tree) {
  if(tree) {
    if(term == tree->type) {
      int levels;
      struct node *pursuit;
      levels = 0;
      if(debugparse) {
        printf("?db:%c\n", tree->value);
      }
      for(pursuit = tree->parent; pursuit; pursuit = pursuit->parent) {
        if(pursuit->type == lambda)
          ++levels;
        if(debugparse) {
          printf("lv%d %c vs. %d,%d:%c\n", levels, tree->value, pursuit->type,
            pursuit->list ? pursuit->list->type : -1,
            pursuit->list ? (term == pursuit->list->type || lterm ==
                pursuit->list->type ? pursuit->list->value : '-') : '*');
        }
        if(pursuit->type == lambda && pursuit->list &&
            (pursuit->list->type == term || pursuit->list->type == lterm) &&
            pursuit->list->value == tree->value) {
          if(pursuit->list != tree) {
            tree->index = levels;
            tree->type = dbterm;
            if(debugparse) {
              printf("%d=db:%c\n", levels, tree->value);
            }
          } else {
            if(debugparse) {
              printf("lt:%c\n", tree->value);
            }
            tree->type = lterm;
          }
          break;
        }
      }
    }
    if(tree->list)
      debruijn(tree->list);
    if(tree->next)
      debruijn(tree->next);
  }
}

int ldepth(struct node *node) {
  int depth = 0;
  struct node *walk;
  for(walk = node; node; walk = walk->parent) {
    if(lambda == walk->type)
      ++depth;
  }
  return depth;
}

void remparens(struct node *node) {
  if(!node)
    return;
  if(debugparen) {
    fdisplay(node);
    printf(" %c->P\n", node->type == sub ? 's' : (node->type == lambda ? 'L' :
      '-'));
  }
  if(node->type == sub || node->type == lambda) {
    if(!node->prev && (!node->next || node->next && node->next->type != sub)
       && (!node->list || node->list->type != lambda)) {
      struct node *child;
      for(child = node->list; child; child = child->next)
        if(child->type == lambda)
          break;
      if(!child) {
        node->noparen = 1;
        if(debugparen) {
          fputs("1:", stdout);
          fdisplaynl(node);
        }
      }
    }
    if(node->next && !node->next->next && node->next->type != sub) {
      struct node *child;
      for(child = node->list; child; child = child->next)
        if(child->type == lambda ||
           (child != node->list && child->type == sub))
          break;
      if(!child) {
        node->noparen = 1;
        if(debugparen) {
          fputs("2:", stdout);
          fdisplaynl(node);
        }
      }
    }
    if(node->type == sub && node->list && !node->list->next &&
       (node->list->type != lambda || !node->next)) {
      node->noparen = 1;
      if(debugparen) {
        fputs("3:", stdout);
        fdisplaynl(node);
      }
    }
    if(node->type == lambda && !node->next) {
      node->noparen = 1;
      if(debugparen) {
        fputs("4:", stdout);
        fdisplaynl(node);
      }
    }
  }
  remparens(node->list);
  remparens(node->next);
  if(node->next && (node->next->type == sub || node->next->type == lambda) &&
     !node->next->noparen) {
    struct node *child;
    for(child = node->list; child; child = child->next)
      if(child->type == lambda)
        return;
    if(node->list && node->list->next && node->list->type != sub)
      return;
    if(debugparen) {
      printf("<-%c ", node->type == sub ? 's' : (node->type == lambda ? 'L' :
        '-'));
      fdisplay(node);
    }
    node->noparen = 1;
    if(debugparen) {
      fputs(" ->P 5:", stdout);
      fdisplaynl(node);
    }
  }
}

void topremparens(struct node *tree) {
  if(!tree)
    return;
  if(!tree->next && (tree->type == sub || tree->type == lambda))
    tree->noparen = 1;
  remparens(tree);
}

int haslambda(struct node *node) {
  struct node *walk;
  for(walk = node; walk; walk = walk->next)
    if(walk->type == lambda)
      return 1;
  return 0;
}

void remparens2(struct node *tree) {
  if(!tree)
    return;
  if(tree->type == lambda && !tree->next) {
    if(debugparen) {
      fdisplay(tree);
      fputs(" L.extends: ", stdout);
    }
    tree->noparen = 1;
    if(debugparen) {
      fdisplaynl(tree);
    }
  }
  if(tree->type == sub && tree->list && tree->list->type == lambda &&
     !tree->next) {
    if(debugparen) {
      fdisplay(tree);
      fputs(" sLextends: ", stdout);
    }
    tree->noparen = 1;
    if(debugparen) {
      fdisplaynl(tree);
    }
  }
  if(tree->type == sub && tree->list && tree->list->type != lambda &&
     !tree->list->next) {
    if(debugparen) {
      fdisplay(tree);
      fputs(" singleton: ", stdout);
    }
    tree->noparen = 1;
    if(debugparen) {
      fdisplaynl(tree);
    }
  }
  if(tree->type == sub && !tree->prev && !haslambda(tree->list)) {
    if(debugparen) {
      fdisplay(tree);
      fputs(" leftassoc: ", stdout);
    }
    tree->noparen = 1;
    if(debugparen) {
      fdisplaynl(tree);
    }
  }
  remparens2(tree->next);
  remparens2(tree->list);
}

struct node *clonechild(struct node *src, struct node *parent) {
  struct node *clonenext(struct node *, struct node *);
  struct node *dst;
  dst = newchild(NULL);
  dst->parent = parent;
  dst->prev = NULL;
  dst->type = src->type;
  dst->index = src->index;
  dst->value = src->value;
  dst->depth = src->depth;
  dst->noparen = src->noparen;
  if(src->next)
    dst->next = clonenext(src->next, dst);
  if(src->list)
    dst->list = clonechild(src->list, dst);
  return dst;
}

struct node *clonenext(struct node *src, struct node *prev) {
  struct node *dst;
  dst = newnode(NULL);
  dst->prev = prev;
  dst->parent = prev ? prev->parent : NULL;
  dst->type = src->type;
  dst->index = src->index;
  dst->value = src->value;
  dst->depth = src->depth;
  dst->noparen = src->noparen;
  if(src->next)
    dst->next = clonenext(src->next, dst);
  if(src->list)
    dst->list = clonechild(src->list, dst);
  return dst;
}

struct node *clone(struct node *src) {
  struct node *dst;
  if(!src)
    return NULL;
  dst = clonenext(src, src->prev);
  dst->parent = src->parent;
  return dst;
}

int isbound(struct node *tree, char var) {
  if(!tree)
    return 0;
  if(tree->type == lterm)
    return tree->value == var ||
             isbound(tree->list, var) || isbound(tree->next, var);
  else
   return isbound(tree->list, var) || isbound(tree->next, var);
}

int isfree(struct node *tree, char var) {
  if(!tree)
    return 1;
  if(tree->type == lterm)
    return tree->value != var &&
             isfree(tree->list, var) && isfree(tree->next, var);
  else
    return isfree(tree->list, var) && isfree(tree->next, var);
}

int inexpr(struct node *tree, char var) {
  if(!tree)
    return 0;
  if(tree->type == lterm || tree->type == dbterm || tree->type == term)
    return tree->value == var ||
             inexpr(tree->list, var) || inexpr(tree->next, var);
  else
    return inexpr(tree->list, var) || inexpr(tree->next, var);
}

void dbshift(struct node *tree, int shift) {
  if(!tree)
    return;
  if(dbterm == tree->type)
    tree->index += shift;
  dbshift(tree->next, shift);
  dbshift(tree->list, shift);
}

struct node *parse(const char *expr) {
  enum {exp, lambda, var} expect;
  struct node *root, *current;
  root = NULL;
  current = NULL;
  expect = exp;
  while(expr && *expr) {
    if(debugparse) {
      printf("%d %c: ", expect, *expr);
    }
    switch(expect) {
      case exp:
        switch(*expr) {
          case ')':
            if(current && current->parent)
              do {
                current = current->parent;
              } while(current->type != sub && current->parent);
            else
              fprintf(stderr, "Unmatched ')' at \"%s\"\n", expr);
            break;
          case '(':
            current = newnode(current);
            break;
          case '\\':
            current = newnode(current);
            current->type = lambda;
            expect = var;
            break;
          case '.':
            fprintf(stderr, "Expected expr, found '.' at \"%s\"\n", expr);
            break;
          default:
            if(isalpha(*expr)) {
              current = newnode(current);
              current->type = term;
              current->value = *expr;
            } else if(!isspace(*expr)) {
              if(isprint(*expr))
                fprintf(stderr, "Expected term, found '%c' at \"%s\"\n",
                        *expr, expr);
              else
                fprintf(stderr, "Expected term, found \\%03o before \"%s\"\n",
                        (int) *expr, 1 + expr);
            }
        }
        break;
      case var:
        if(!isspace(*expr)) {
          if(isalpha(*expr)) {
            current = newnode(current);
            current->type = term;
            current->value = *expr;
            expect = lambda;
          } else
            if(isprint(*expr))
              fprintf(stderr, "Expected var binding, found '%c' at \"%s\"\n",
                      *expr, expr);
            else
              fprintf(stderr,
                      "Expected var binding, found \\%03o before \"%s\"\n",
                      (int) *expr, 1 + expr);
        }
        break;
      case lambda:
        switch(*expr) {
          case '.':
            expect = exp;
            break;
          case '\\':
            current = newnode(current);
            current->type = lambda;
            expect = var;
            break;
          case '(':
          case ')':
            fprintf(stderr, "Expected '.', found '%c' at \"%s\"\n", *expr,
                    expr);
            break;
          default:
            if(!isspace(*expr)) {
              if(isalpha(*expr)) {
                current = newnode(current);
                current->type = lambda;
                current->value = *expr;
              } else
                if(isprint(*expr))
                  fprintf(stderr, "Expected '.', found '%c' at \"%s\"\n",
                          *expr, expr);
                else
                  fprintf(stderr,
                          "Expected '.', found \\%03o before \"%s\"\n",
                          (int) *expr, 1 + expr);
            }
          }
        }
    ++expr;
    if(!root && current)
      root = current;
    if(debugparse) {
      printf("%d %d %d\n", current ? current->type : -1, expect, current ?
             ((dbterm == current->type || term == current->type) ?
             current->value : (current->list ? 256 : 0)) : -1);
    }
    display(root);
  }
  return root;
}

void buildatlas(struct var **a, struct node *n) {
  *a=NULL;
  buildatlassub(a,n);
}

int main(int argc, char **argv) {
  struct node *tree, *tree2, *treenext, *treelist;
  struct var *atlas, *atlas2;
  char var;
  int arg, clonetests, disptests, parsetests, vartests, atlastests, parentests;
  debugdisp = 0;
  debugatlas = 0;
  debugparse = 0;
  debugparen = 0;
  parentests = 0;
  clonetests = 0;
  disptests = 0;
  parsetests = 0;
  vartests = 0;
  atlastests = 0;
  if(argc >= 2) {
    struct node *tree3;
    struct var *atlas3;
    for(arg = 1; arg < argc && *argv[arg] == '-' ; ++arg) {
      if (!strcmp(argv[arg], "-help")) {
        fputs("-debugparse    debug output from parser\n"
              "-debugparen    debug output during parenthesis removal\n"
              "-debugatlas    debug output from creating atlas of vars\n"
              "-debugdisp     debug output from display routines\n"
              "-parentests    test extraneous-parenthesis-removal routines\n"
              "-clonetests    test partial cloning of parser tree\n"
              "-atlastests    test variables atlas creation\n"
              "-disptests     test of parser tree display\n"
              "-vartests      test of bound/free variable classifier\n",
              stdout);
      } else if(!strcmp(argv[arg], "-debugdisp")) {
        debugdisp = 1;
      } else if(!strcmp(argv[arg], "-debugatlas")) {
        debugatlas = 1;
      } else if(!strcmp(argv[arg], "-debugparse")) {
        debugparse = 1;
      } else if(!strcmp(argv[arg], "-debugparen")) {
        debugparen = 1;
      } else if(!strcmp(argv[arg], "-clonetests")) {
        clonetests = 1;
      } else if(!strcmp(argv[arg], "-atlastests")) {
        atlastests = 1;
      } else if(!strcmp(argv[arg], "-parentests")) {
        parentests = 1;
      } else if(!strcmp(argv[arg], "-disptests")) {
        disptests = 1;
      } else if(!strcmp(argv[arg], "-vartests")) {
        vartests = 1;
      } else {
        fprintf(stderr, "unknown option %s\n", argv[arg]);
      }
    }
    if(arg == argc) {
      fputs("missing expression\n", stderr);
    }
    tree = parse(argv[arg]);
    if(parsetests) {
      displaynl(tree);
    }
    debruijn(tree);
    if(parsetests) {
      displaynl(tree);
    }
    printf("M%d\n", maxdepth(tree));
    if(parentests) {
      tree2 = clone(tree);
    }
    fdisplaynl(tree);
    dbdisplaynl(tree);
    if(parentests) {
      tree3 = clone(tree2);
      topremparens(tree);
      remparens2(tree2);
      fdisplaynl(tree3);
      dbdisplaynl(tree3);
      fdisplaynl(tree);
      dbdisplaynl(tree);
      fdisplaynl(tree2);
      dbdisplaynl(tree2);
    }
    if(atlastests) {
      buildatlas(&atlas, tree);
      if(parentests) {
        buildatlas(&atlas2, tree2);
        buildatlas(&atlas3, tree3);
      }
      displayatlas(atlas);
      if(parentests) {
        displayatlas(atlas2);
        displayatlas(atlas3);
      }
    }
    if(disptests) {
      dispwidths(tree);
      disptree(tree);
    }
    if(clonetests) {
      treenext = clone(tree->next);
      treelist = clone(tree->list);
      displaynl(tree2);
      fdisplaynl(tree2);
      dbdisplaynl(tree2);
      displaynl(treenext);
      fdisplaynl(treenext);
      dbdisplaynl(treenext);
      displaynl(treelist);
      fdisplaynl(treelist);
      dbdisplaynl(treelist);
      dbshift(tree2, -2);
      displaynl(tree2);
      fdisplaynl(tree2);
      dbdisplaynl(tree2);
    }
    if(vartests) {
      var = CHAR_MIN;
      do {
        if(isalpha(var)) {
          printf("%c %d %d %d\n", var, inexpr(tree, var), isbound(tree, var),
            isfree(tree, var));
        }
      } while (var++ < CHAR_MAX);
    }
  } else {
    fprintf(stderr,
      "usage: %s [opts] lambda-expr\nfor list of opts: %s -help\n",
      argv[0], argv[0]);
    exit(1);
  }
  exit(0);
}
Tags: code, lambdacalculus, math
Subscribe
  • Post a new comment

    Error

    default userpic

    Your IP address will be recorded 

    When you submit the form an invisible reCAPTCHA check will be performed.
    You must follow the Privacy Policy and Google Terms of use.
  • 0 comments