grammar loader and unloader in C. Abstract Syntax only!

src/runtime/c/pgf.h

@@ -0,0 +1,14 @@
+#ifndef PGF_H
+#define PGF_H
+
+typedef struct _CId     *CId;
+typedef struct _String  *String;
+typedef struct _Literal *Literal ;
+typedef struct _Type    *Type ;
+typedef struct _Expr    *Expr ;
+typedef struct _PGF     *PGF ;
+
+PGF readPGF(char *filename);
+void freePGF(PGF pgf);
+
+#endif

src/runtime/c/pgf/data.h

@@ -0,0 +1,76 @@
+#ifndef PGF_DATA_H
+#define PGF_DATA_H
+
+typedef int BindType;
+
+#include "expr.h"
+#include "type.h"
+
+struct _String {
+  int len;
+  unsigned int chars[];
+};
+
+struct _CId {
+  int len;
+  char chars[];
+};
+
+typedef struct _CIdList {
+  int count;
+  CId names[];
+} *CIdList;
+
+typedef struct _AbsCat {
+  CId name;
+  Context hypos;
+  CIdList funs;
+} *AbsCat;
+
+typedef struct _AbsCats {
+  int count;
+  struct _AbsCat lst[];
+} *AbsCats;
+
+typedef struct _AbsFun {
+  CId name;
+  Type ty;
+  int arrity;
+  Equations equs;
+} *AbsFun;
+
+typedef struct _AbsFuns {
+  int count;
+  struct _AbsFun lst[];
+} *AbsFuns;
+
+struct _Flag {
+  CId name;
+  Literal value;
+} ;
+
+typedef struct _Flags {
+  int count;
+  struct _Flag values[];
+} *Flags;
+
+typedef struct _Abstract {
+  CId name;
+  Flags flags;
+  AbsFuns funs;
+  AbsCats cats;
+} *Abstract;
+
+typedef struct _Concrete {
+  CId name;
+  Flags flags;
+} *Concrete;
+
+struct _PGF {
+  Flags flags;
+  int   nConcr;
+  struct _Abstract abstract;
+  struct _Concrete concretes[];
+};
+
+#endif

src/runtime/c/pgf/expr.h

@@ -0,0 +1,144 @@
+#ifndef PGF_EXPR_H
+#define PGF_EXPR_H
+
+#define LIT_STR   0
+#define LIT_INT   1
+#define LIT_FLOAT 2
+
+struct _Literal {
+  int tag;
+};
+
+typedef struct _LiteralStr {
+  struct _Literal _;
+  String val;
+} *LiteralStr;
+
+typedef struct _LiteralInt {
+  struct _Literal _;
+  int val;
+} *LiteralInt;
+
+typedef struct _LiteralFloat {
+  struct _Literal _;
+  double val;
+} *LiteralFloat;
+
+#define TAG_ABS 0
+#define TAG_APP 1
+#define TAG_LIT 2
+#define TAG_MET 3
+#define TAG_FUN 4
+#define TAG_VAR 5
+#define TAG_TYP 6
+#define TAG_IMP 7
+
+struct _Expr {
+  int tag;
+};
+
+typedef struct _ExprAbs {
+  struct _Expr _;
+  BindType bt;
+  CId var;
+  Expr body;
+} *ExprAbs;
+
+typedef struct _ExprApp {
+  struct _Expr _;
+  Expr left, right;
+} *ExprApp;
+
+typedef struct _ExprLit {
+  struct _Expr _;
+  Literal lit;
+} *ExprLit;
+
+typedef struct _ExprMeta {
+  struct _Expr _;
+  int id;
+} *ExprMeta;
+
+typedef struct _ExprFun {
+  struct _Expr _;
+  CId fun;
+} *ExprFun;
+
+typedef struct _ExprVar {
+  struct _Expr _;
+  int index;
+} *ExprVar;
+
+typedef struct _ExprTyped {
+  struct _Expr _;
+  Expr e;
+  Type ty;
+} *ExprTyped;
+
+typedef struct _ExprImplArg {
+  struct _Expr _;
+  Expr e;
+} *ExprImplArg;
+
+#define TAG_PAPP   0
+#define TAG_PVAR   1
+#define TAG_PAT    2
+#define TAG_PWILD  3
+#define TAG_PLIT   4
+#define TAG_PIMP   5
+#define TAG_PTILDE 6
+
+typedef struct _Patt {
+  int tag;
+} *Patt;
+
+typedef struct _Patts {
+  int count;
+  Patt pats[];
+} *Patts;
+
+typedef struct _PattApp {
+  struct _Patt _;
+  CId fun;
+  struct _Patts args;
+} *PattApp;
+
+typedef struct _PattVar {
+  struct _Patt _;
+  CId var;
+} *PattVar;
+
+typedef struct _PattAt {
+  struct _Patt _;
+  CId  var;
+  Patt pat;
+} *PattAt;
+
+typedef struct _PattWild {
+  struct _Patt _;
+} *PattWild;
+
+typedef struct _PattLit {
+  struct _Patt _;
+  Literal lit;
+} *PattLit;
+
+typedef struct _PattImplArg {
+  struct _Patt _;
+  Patt pat;
+} *PattImplArg;
+
+typedef struct _PattTilde {
+  struct _Patt _;
+  Expr e;
+} *PattTilde;
+
+typedef struct _Equations {
+  int count;
+  struct _Equation {
+    Patts lhs;
+    Expr  rhs;
+  } equs[];
+} *Equations;
+
+#endif

src/runtime/c/pgf/loader.c

@@ -0,0 +1,396 @@
+#include "../pgf.h"
+#include "data.h"
+#include "panic.h"
+#include <stdio.h>
+#include <stdlib.h>
+
+static int readTag(FILE *f) {
+  return getc(f);
+}
+
+static int readInt16(FILE *f) {
+  int x = getc(f);
+  int y = getc(f);
+  return ((x << 8) | y);
+}
+
+static int readInt(FILE *f) {
+  unsigned int x = (unsigned int) getc(f);
+  if (x <= 0x7f)
+    return (int) x;
+  else {
+    unsigned int y = (unsigned int) readInt(f);
+    return (int) ((y << 7) | (x & 0x7f)) ;
+  }
+}
+
+static double readFloat(FILE *f) {
+  double d;
+  fread(&d, sizeof(d), 1, f);
+  return d;
+}
+
+static String readString(FILE *f) {
+  int len = readInt(f);
+  String str = (String) malloc(sizeof(struct _CId)+len*sizeof(unsigned int));
+  str->len = len;
+  
+  int i;
+  for (i = 0; i < len; i++) {
+    int c = fgetc(f);
+    str->chars[i] = c;
+  }
+  
+  return str;
+}
+
+static CId readCId(FILE *f) {
+  int len = readInt(f);
+  CId cid = (CId) malloc(sizeof(struct _CId)+len*sizeof(char));
+  cid->len = len;
+  fread(&cid->chars, sizeof(char), len, f);
+  return cid;
+}
+
+static CIdList readCIdList(FILE *f) {
+  int i;
+  int count = readInt(f);
+  CIdList list = (CIdList) malloc(sizeof(struct _CIdList)+count*sizeof(CId));
+  
+  list->count = count;
+  for (i = 0; i < count; i++) {
+    list->names[i]  = readCId(f);
+  }
+
+  return list;
+}
+
+static Literal readLiteral(FILE *f) {
+  int tag = readTag(f);
+  switch (tag) {
+    case LIT_STR:
+      { 
+	LiteralStr lit = (LiteralStr) malloc(sizeof(struct _LiteralStr));
+        lit->_.tag = tag;
+        lit->val   = readString(f);
+        return ((Literal) lit);
+      }
+    case LIT_INT:
+      { 
+	LiteralInt lit = (LiteralInt) malloc(sizeof(struct _LiteralInt));
+        lit->_.tag = tag;
+        lit->val   = readInt(f);
+        return ((Literal) lit);
+      }
+    case LIT_FLOAT:
+      {
+        LiteralFloat lit = (LiteralFloat) malloc(sizeof(struct _LiteralFloat));
+        lit->_.tag = tag;
+        lit->val   = readFloat(f);
+        return ((Literal) lit);
+      }
+    default:
+      __pgf_panic("Unknown literal tag");
+  }
+}
+
+static Flags readFlags(FILE *f) {
+  int i;
+  int count = readInt(f);
+  Flags flags = (Flags) malloc(sizeof(struct _Flags)+count*sizeof(struct _Flag));
+  
+  flags->count = count;
+  for (i = 0; i < count; i++) {
+    flags->values[i].name  = readCId(f);
+    flags->values[i].value = readLiteral(f);
+  }
+
+  return flags;
+}
+
+static Context readContext(FILE *f);
+static Type readType(FILE *f);
+
+static Expr readExpr(FILE *f) {
+  int tag = readTag(f);
+  
+  switch (tag) {
+  case TAG_ABS:
+    {
+        ExprAbs e = (ExprAbs) malloc(sizeof(struct _ExprAbs));
+        e->_.tag = tag;
+        e->bt    = readTag(f);
+        e->var   = readCId(f);
+        e->body  = readExpr(f);
+        return ((Expr) e);
+    }
+  case TAG_APP:
+    {
+        ExprApp e = (ExprApp) malloc(sizeof(struct _ExprApp));
+        e->_.tag = tag;
+        e->left  = readExpr(f);
+        e->right = readExpr(f);
+        return ((Expr) e);
+    }
+  case TAG_LIT:
+    {
+        ExprLit e = (ExprLit) malloc(sizeof(struct _ExprLit));
+        e->_.tag = tag;
+        e->lit   = readLiteral(f);
+        return ((Expr) e);
+    }
+  case TAG_MET:
+    {
+        ExprMeta e = (ExprMeta) malloc(sizeof(struct _ExprMeta));
+        e->_.tag = tag;
+        e->id    = readInt(f);
+        return ((Expr) e);
+    }
+  case TAG_FUN:
+    {
+        ExprFun e = (ExprFun) malloc(sizeof(struct _ExprFun));
+        e->_.tag = tag;
+        e->fun   = readCId(f);
+        return ((Expr) e);
+    }
+  case TAG_VAR:
+    {
+        ExprVar e = (ExprVar) malloc(sizeof(struct _ExprVar));
+        e->_.tag = tag;
+        e->index = readInt(f);
+        return ((Expr) e);
+    }
+  case TAG_TYP:
+    {
+        ExprTyped e = (ExprTyped) malloc(sizeof(struct _ExprTyped));
+        e->_.tag = tag;
+        e->e     = readExpr(f);
+        e->ty    = readType(f);
+        return ((Expr) e);
+    }
+  case TAG_IMP:
+    {
+        ExprImplArg e = (ExprImplArg) malloc(sizeof(struct _ExprImplArg));
+        e->_.tag = tag;
+        e->e     = readExpr(f);
+        return ((Expr) e);
+    }
+  default:
+    __pgf_panic("Unknown expression tag");
+  }
+}
+	
+static Type readType(FILE *f) {
+  Context hypos = readContext(f);
+  CId     cat   = readCId(f);
+  
+  int i;
+  int count = readInt(f);
+  Type ty = (Type) malloc(sizeof(struct _Type)+count*sizeof(Expr));
+  
+  ty->hypos = hypos;
+  ty->cat   = cat;
+  ty->nArgs = count;
+  for (i = 0; i < count; i++) {
+    ty->args[i]  = readExpr(f);
+  }
+  
+  return ty;
+}
+
+static void readHypo(FILE *f, Hypo h) {
+  h->bt  = readTag(f);
+  h->var = readCId(f);
+  h->ty  = readType(f);
+}
+
+static Context readContext(FILE *f) {
+  int i;
+  int size = readInt(f);
+  Context ctxt = (Context) malloc(sizeof(struct _Context)+size*sizeof(struct _Hypo));
+  
+  ctxt->size = size;
+  for (i = 0; i < size; i++) {
+    readHypo(f, &ctxt->hypos[i]);
+  }
+  
+  return ctxt;
+}
+
+static Patt readPatt(FILE *f) {
+  int tag = readTag(f);
+
+  switch (tag) {
+  case TAG_PAPP:
+    {
+       CId fun = readCId(f);
+       
+       int i;
+       int count = readInt(f);
+       PattApp p = (PattApp) malloc(sizeof(struct _PattApp)+count*sizeof(Patt));
+  
+       p->_.tag      = tag;
+       p->fun        = fun;
+       p->args.count = count;
+       for (i = 0; i < count; i++) {
+         p->args.pats[i] = readPatt(f);
+       }
+       
+       return ((Patt) p);
+    }
+  case TAG_PVAR:
+    {
+        PattVar p = (PattVar) malloc(sizeof(struct _PattVar));
+        p->_.tag = tag;
+        p->var   = readCId(f);
+        return ((Patt) p);
+    }
+  case TAG_PAT:
+    {
+        PattAt p = (PattAt) malloc(sizeof(struct _PattAt));
+        p->_.tag = tag;
+        p->var   = readCId(f);
+        p->pat   = readPatt(f);
+        return ((Patt) p);
+    }
+  case TAG_PWILD:
+    {
+        PattWild p = (PattWild) malloc(sizeof(struct _PattWild));
+        p->_.tag = tag;
+        return ((Patt) p);
+    }
+  case TAG_PLIT:
+    {
+        PattLit p = (PattLit) malloc(sizeof(struct _PattLit));
+        p->_.tag = tag;
+        p->lit   = readLiteral(f);
+        return ((Patt) p);
+    }
+  case TAG_PIMP:
+    {
+        PattImplArg p = (PattImplArg) malloc(sizeof(struct _PattImplArg));
+        p->_.tag = tag;
+        p->pat   = readPatt(f);
+        return ((Patt) p);
+    }
+  case TAG_PTILDE:
+    {
+        PattTilde p = (PattTilde) malloc(sizeof(struct _PattTilde));
+        p->_.tag = tag;
+        p->e     = readExpr(f);
+        return ((Patt) p);
+    }
+  default:
+    __pgf_panic("Unknown pattern tag");
+  }  
+}
+
+static Patts readPatts(FILE *f) {
+  int i;
+  int count = readInt(f);
+  Patts pats = (Patts) malloc(sizeof(struct _Patts)+count*sizeof(Patt));
+  
+  pats->count = count;
+  for (i = 0; i < count; i++) {
+    pats->pats[i] = readPatt(f);
+  }
+
+  return pats;
+}
+
+static Equations readEquations(FILE *f) {
+  int i;
+  int count = readInt(f);
+  Equations equs = (Equations) malloc(sizeof(struct _Equations)+count*sizeof(struct _Equation));
+  
+  equs->count = count;
+  for (i = 0; i < count; i++) {
+    equs->equs[i].lhs = readPatts(f);
+    equs->equs[i].rhs = readExpr(f);
+  }
+
+  return equs;
+}
+
+static void readAbsFun(FILE *f, AbsFun fun) {
+  fun->name   = readCId(f);
+  fun->ty     = readType(f);
+  fun->arrity = readInt(f);
+  if (readTag(f) != 0)
+    fun->equs   = readEquations(f);
+  else
+    fun->equs   = NULL;
+}
+
+static AbsFuns readAbsFuns(FILE *f) {
+  int i;
+  int count = readInt(f);
+  AbsFuns funs = (AbsFuns) malloc(sizeof(struct _AbsFuns)+count*sizeof(struct _AbsFun));
+  
+  funs->count = count;
+  for (i = 0; i < count; i++) {
+    readAbsFun(f, &funs->lst[i]);
+  }
+  
+  return funs;
+}
+
+static void readAbsCat(FILE *f, AbsCat cat) {
+  cat->name  = readCId(f);
+  cat->hypos = readContext(f);
+  cat->funs  = readCIdList(f);
+}
+
+static AbsCats readAbsCats(FILE *f) {
+  int i;
+  int count = readInt(f);
+  AbsCats cats = (AbsCats) malloc(sizeof(struct _AbsCats)+count*sizeof(struct _AbsCat));
+  
+  cats->count = count;
+  for (i = 0; i < count; i++) {
+    readAbsCat(f, &cats->lst[i]);
+  }
+  
+  return cats;
+}
+
+static void readAbstr(FILE *f, Abstract abstr) {
+  abstr->name  = readCId(f);
+  abstr->flags = readFlags(f);
+  abstr->funs  = readAbsFuns(f);
+  abstr->cats  = readAbsCats(f);
+}
+
+static void readConcr(FILE *f, Concrete concr) {
+  concr->name  = readCId(f);
+  concr->flags = readFlags(f);
+}
+
+PGF readPGF(char *filename) {
+  FILE *f = fopen(filename, "rb");
+  if (f == NULL)
+    return NULL;
+    
+  int maj_ver = readInt16(f);
+  int min_ver = readInt16(f);
+  
+  Flags flags = readFlags(f);
+  
+  struct _Abstract abstr;
+  readAbstr(f, &abstr);
+  
+  int nConcr = readInt(f);
+  PGF pgf = (PGF) malloc(sizeof(struct _PGF)+sizeof(Concrete)*nConcr);
+  
+  pgf->flags    = flags;
+  pgf->abstract = abstr;
+  pgf->nConcr   = nConcr;
+  
+  int i;
+//  for (i = 0; i < nConcr; i++) {
+//    readConcr(f, &pgf->concretes[i]);
+//  }
+
+  fclose(f);
+  return pgf;
+}

src/runtime/c/pgf/panic.c

@@ -0,0 +1,8 @@
+#include "panic.h"
+#include <stdio.h>
+
+void __pgf_panic(char *msg) {
+  printf("%s\n",msg);
+  fflush(stdout);
+  exit(1);
+}

src/runtime/c/pgf/panic.h

@@ -0,0 +1,6 @@
+#ifndef PGF_PANIC_H
+#define PGF_PANIC_H
+
+void __pgf_panic(char *msg);
+
+#endif

src/runtime/c/pgf/type.h

@@ -0,0 +1,22 @@
+#ifndef PGF_TYPE_H
+#define PGF_TYPE_H
+
+typedef struct _Hypo {
+  BindType bt;
+  CId var;
+  Type ty;
+} *Hypo;
+
+typedef struct _Context {
+  int  size;
+  struct _Hypo hypos[];
+} *Context;
+
+struct _Type {
+  Context hypos;
+  CId  cat;
+  int  nArgs;
+  Expr args[];
+};
+
+#endif

src/runtime/c/pgf/unloader.c

@@ -0,0 +1,248 @@
+#include "../pgf.h"
+#include "data.h"
+#include "panic.h"
+#include <stdlib.h>
+
+static void freeCId(CId id) {
+  free(id);
+}
+
+static void freeCIdList(CIdList ids) {
+  int i;
+  for (i = 0; i < ids->count; i++) {
+    freeCId(ids->names[i]);
+  }
+  free(ids);
+}
+
+static void freeString(String str) {
+  free(str);
+}
+
+static void freeLiteral(Literal lit) {
+  switch (lit->tag) {
+  case LIT_STR:
+    freeString (((LiteralStr) lit)->val);
+    break;
+  }
+  free(lit);
+}
+
+static void freeFlags(Flags flags) {
+  int i;
+  for (i = 0; i < flags->count; i++) {
+    freeCId(flags->values[i].name);
+    freeLiteral(flags->values[i].value);
+  }  
+  free(flags);
+}
+
+static void freeContext(Context ctxt);
+static void freeType(Type ty);
+
+static void freeExpr(Expr e0) {
+	
+  switch (e0->tag) {
+  case TAG_ABS:
+    {
+        ExprAbs e = (ExprAbs) e0;
+        freeCId(e->var);
+        freeExpr(e->body);
+    }
+    break;
+  case TAG_APP:
+    {
+        ExprApp e = (ExprApp) e0;
+        freeExpr(e->left);
+        freeExpr(e->right);
+    }
+    break;
+  case TAG_LIT:
+    {
+        ExprLit e = (ExprLit) e0;
+        freeLiteral(e->lit);
+    }
+    break;
+  case TAG_MET:
+    {
+        ExprMeta e = (ExprMeta) e0;
+    }
+    break;
+  case TAG_FUN:
+    {
+        ExprFun e = (ExprFun) e0;
+        freeCId(e->fun);
+    }
+    break;
+  case TAG_VAR:
+    {
+        ExprVar e = (ExprVar) e0;
+    }
+    break;
+  case TAG_TYP:
+    {
+        ExprTyped e = (ExprTyped) e0;
+        freeExpr(e->e);
+        freeType(e->ty);
+    }
+    break;
+  case TAG_IMP:
+    {
+        ExprImplArg e = (ExprImplArg) e0;
+        freeExpr(e->e);
+    }
+    break;
+  default:
+    __pgf_panic("Unknown expression tag");
+  }
+  
+  free(e0);
+}
+
+static void freeType(Type ty) {
+  freeContext(ty->hypos);
+  freeCId(ty->cat);
+   
+  int i;
+  for (i = 0; i < ty->nArgs; i++) {
+    freeExpr(ty->args[i]);
+  }
+  
+  free(ty);
+}
+
+static void freeHypo(Hypo hypo) {
+  freeCId(hypo->var);
+  freeType(hypo->ty);
+}
+
+static void freeContext(Context ctxt) {
+  int i;
+  for (i = 0; i < ctxt->size; i++) {
+    freeHypo(&ctxt->hypos[i]);
+  }  
+  free(ctxt);
+}
+
+static void freePatt(Patt p0) {
+  switch (p0->tag) {
+  case TAG_PAPP:
+    {
+       int i;
+       PattApp p = (PattApp) p0;
+  
+       freeCId(p->fun);
+       for (i = 0; i < p->args.count; i++) {
+         freePatt(p->args.pats[i]);
+       }
+    }
+    break;
+  case TAG_PVAR:
+    {
+        PattVar p = (PattVar) p0;
+        freeCId(p->var);
+    }
+    break;
+  case TAG_PAT:
+    {
+        PattAt p = (PattAt) p0;
+        freeCId(p->var);
+        freePatt(p->pat);
+    }
+    break;
+  case TAG_PWILD:
+    {
+        PattWild p = (PattWild) p0;
+    }
+    break;
+  case TAG_PLIT:
+    {
+        PattLit p = (PattLit) p0;
+        freeLiteral(p->lit);
+    }
+    break;
+  case TAG_PIMP:
+    {
+        PattImplArg p = (PattImplArg) p0;
+        freePatt(p->pat);
+    }
+    break;
+  case TAG_PTILDE:
+    {
+        PattTilde p = (PattTilde) p0;
+        freeExpr(p->e);
+    }
+    break;
+  default:
+    __pgf_panic("Unknown pattern tag");
+  }
+  
+  free(p0);
+}
+
+static void freePatts(Patts pats) {
+  int i;
+  for (i = 0; i < pats->count; i++) {
+    freePatt(pats->pats[i]);
+  }
+  free(pats);
+}
+
+static void freeEquations(Equations equs) {
+  int i;
+  for (i = 0; i < equs->count; i++) {
+    freePatts(equs->equs[i].lhs);
+    freeExpr(equs->equs[i].rhs);
+  }
+  free(equs);
+}
+
+static void freeAbsFun(AbsFun fun) {
+  freeCId(fun->name);
+  freeType(fun->ty);
+  freeEquations(fun->equs);
+}
+
+static void freeAbsFuns(AbsFuns funs) {
+  int i;
+  for (i = 0; i < funs->count; i++) {
+    freeAbsFun(&funs->lst[i]);
+  }  
+  free(funs);
+}
+
+static void freeAbsCat(AbsCat cat) {
+  freeCId(cat->name);
+  freeContext(cat->hypos);
+  freeCIdList(cat->funs);
+}
+
+static void freeAbsCats(AbsCats cats) {
+  int i;
+  for (i = 0; i < cats->count; i++) {
+    freeAbsCat(&cats->lst[i]);
+  }  
+  free(cats);
+}
+
+static void freeAbstract(Abstract abstr) {
+  freeCId(abstr->name);
+  freeFlags(abstr->flags);
+  freeAbsFuns(abstr->funs);
+  freeAbsCats(abstr->cats);
+}
+
+static void freeConcrete(Concrete concr) {
+//  freeCId(concr->name);
+//  freeFlags(concr->flags);
+}
+
+void freePGF(PGF pgf) {
+  int i;
+  
+  freeFlags(pgf->flags);
+  freeAbstract(&pgf->abstract);
+  for (i = 0; i < pgf->nConcr; i++)
+    freeConcrete(&pgf->concretes[i]);
+  free(pgf);
+}