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
  • Post a new comment

    Error

    default userpic

    Your IP address will be recorded 

  • 0 comments