Merge branch 'majestic' of github.com:GrammaticalFramework/gf-core into majestic

# Conflicts: # src/runtime/python/pypgf.c
2026-04-09 04:59:31 -06:00 · 2021-09-06 23:52:30 +02:00
parent 5b96ede199 1ec4949d90
commit e6d8b76dbf
16 changed files with 460 additions and 255 deletions
--- a/src/runtime/c/pgf/data.h
+++ b/src/runtime/c/pgf/data.h
@@ -107,26 +107,12 @@ typedef struct {
    Namespace<PgfAbsCat> cats;
 } PgfAbstr;

-struct PGF_INTERNAL_DECL PgfPGFRoot {
+typedef struct PGF_INTERNAL_DECL {
 	uint16_t major_version;
 	uint16_t minor_version;
 	Namespace<PgfFlag> gflags;
 	PgfAbstr abstract;
 	//PgfConcrs* concretes;
-};
-
-#pragma GCC diagnostic push
-#pragma GCC diagnostic ignored "-Wattributes"
-
-struct PgfPGF : DB {
-    PGF_INTERNAL_DECL PgfPGF(const char* fpath, int flags, int mode)
-                         : DB(fpath, flags, mode)
-    { };
-
-    PGF_INTERNAL_DECL ~PgfPGF()
-    { };
-};
-
-#pragma GCC diagnostic pop
+} PgfPGF;

 #endif
--- a/src/runtime/c/pgf/db.cxx
+++ b/src/runtime/c/pgf/db.cxx
@@ -7,7 +7,7 @@
 #include "data.h"

 PGF_INTERNAL __thread unsigned char* current_base __attribute__((tls_model("initial-exec"))) = NULL;
-PGF_INTERNAL __thread DB* current_db __attribute__((tls_model("initial-exec"))) = NULL;
+PGF_INTERNAL __thread PgfDB* current_db __attribute__((tls_model("initial-exec"))) = NULL;
 PGF_INTERNAL __thread DB_scope *last_db_scope __attribute__((tls_model("initial-exec"))) = NULL;

 #ifndef DEFAULT_TOP_PAD
@@ -269,7 +269,7 @@ struct malloc_state
    object root_offset;
 };

-DB::DB(const char* pathname, int flags, int mode) {
+PgfDB::PgfDB(const char* pathname, int flags, int mode) {
    size_t file_size;
    bool is_new = false;

@@ -313,7 +313,7 @@ DB::DB(const char* pathname, int flags, int mode) {
    }
 }

-DB::~DB() {
+PgfDB::~PgfDB() {
    if (ms != NULL) {
        size_t size =
            ms->top + chunksize(ptr(ms,ms->top)) + sizeof(size_t);
@@ -327,7 +327,7 @@ DB::~DB() {
    pthread_rwlock_destroy(&rwlock);
 }

-void DB::sync()
+void PgfDB::sync()
 {
    malloc_state *ms = current_db->ms;
    size_t size =
@@ -338,16 +338,16 @@ void DB::sync()
        throw std::system_error(errno, std::generic_category());
 }

-object DB::get_root_internal() {
+object PgfDB::get_root_internal() {
    return ms->root_offset;
 }

-void DB::set_root_internal(object root_offset) {
+void PgfDB::set_root_internal(object root_offset) {
    ms->root_offset = root_offset;
 }

 void
-DB::init_state(size_t size)
+PgfDB::init_state(size_t size)
 {
    /* Init fastbins */
    ms->have_fastchunks = false;
@@ -483,7 +483,7 @@ static void malloc_consolidate(malloc_state *ms)
 }

 object
-DB::malloc_internal(size_t bytes)
+PgfDB::malloc_internal(size_t bytes)
 {
    unsigned int idx;                 /* associated bin index */
    mbin* bin;                        /* associated bin */
@@ -856,7 +856,7 @@ DB::malloc_internal(size_t bytes)
 }

 void
-DB::free_internal(object o)
+PgfDB::free_internal(object o)
 {
    size_t size;                 /* its size */
    object *fb;                  /* associated fastbin */
@@ -948,7 +948,7 @@ DB::free_internal(object o)
 }


-DB_scope::DB_scope(DB *db, DB_scope_mode tp)
+DB_scope::DB_scope(PgfDB *db, DB_scope_mode tp)
 {
    int res =
        (tp == READER_SCOPE) ? pthread_rwlock_rdlock(&db->rwlock)
--- a/src/runtime/c/pgf/db.h
+++ b/src/runtime/c/pgf/db.h
@@ -3,10 +3,10 @@

 #define MALLOC_ALIGN_MASK (2*sizeof(size_t) - 1)

-class DB;
+class PgfDB;

 extern PGF_INTERNAL_DECL __thread unsigned char* current_base __attribute__((tls_model("initial-exec")));
-extern PGF_INTERNAL_DECL __thread DB*            current_db   __attribute__((tls_model("initial-exec")));
+extern PGF_INTERNAL_DECL __thread PgfDB*         current_db   __attribute__((tls_model("initial-exec")));

 struct malloc_state;

@@ -14,7 +14,7 @@ template<class A> class PGF_INTERNAL_DECL ref {
 private:
    object offset;

-    friend class DB;
+    friend class PgfDB;

 public:
    ref<A>() { }
@@ -54,7 +54,7 @@ public:
    }
 };

-class PGF_INTERNAL_DECL DB {
+class PgfDB {
 private:
    int fd;
    malloc_state* ms;
@@ -64,8 +64,8 @@ private:
    friend class PgfReader;

 public:
-    DB(const char* pathname, int flags, int mode);
-    ~DB();
+    PgfDB(const char* pathname, int flags, int mode);
+    ~PgfDB();

    template<class A>
    static ref<A> malloc() {
@@ -112,11 +112,11 @@ enum DB_scope_mode {READER_SCOPE, WRITER_SCOPE};

 class PGF_INTERNAL_DECL DB_scope {
 public:
-    DB_scope(DB *db, DB_scope_mode type);
+    DB_scope(PgfDB *db, DB_scope_mode type);
    ~DB_scope();

 private:
-    DB* save_db;
+    PgfDB* save_db;
    DB_scope* next_scope;
 };

--- a/src/runtime/c/pgf/expr.cxx
+++ b/src/runtime/c/pgf/expr.cxx
@@ -111,7 +111,7 @@ PgfType PgfDBMarshaller::match_type(PgfUnmarshaller *u, PgfType ty)
 PgfExpr PgfDBUnmarshaller::eabs(PgfBindType bind_type, PgfText *name, PgfExpr body)
 {
    ref<PgfExprAbs> eabs =
-        DB::malloc<PgfExprAbs>(sizeof(PgfExprAbs)+name->size+1);
+        PgfDB::malloc<PgfExprAbs>(sizeof(PgfExprAbs)+name->size+1);
    eabs->bind_type = bind_type;
    eabs->body = m->match_expr(this, body);
    memcpy(&eabs->name, name, sizeof(PgfText)+name->size+1);
@@ -120,7 +120,7 @@ PgfExpr PgfDBUnmarshaller::eabs(PgfBindType bind_type, PgfText *name, PgfExpr bo

 PgfExpr PgfDBUnmarshaller::eapp(PgfExpr fun, PgfExpr arg)
 {
-    ref<PgfExprApp> eapp = DB::malloc<PgfExprApp>();
+    ref<PgfExprApp> eapp = PgfDB::malloc<PgfExprApp>();
    eapp->fun = m->match_expr(this, fun);
 	eapp->arg = m->match_expr(this, arg);
    return ref<PgfExprApp>::tagged(eapp);
@@ -128,14 +128,14 @@ PgfExpr PgfDBUnmarshaller::eapp(PgfExpr fun, PgfExpr arg)

 PgfExpr PgfDBUnmarshaller::elit(PgfLiteral lit)
 {
-    ref<PgfExprLit> elit = DB::malloc<PgfExprLit>();
+    ref<PgfExprLit> elit = PgfDB::malloc<PgfExprLit>();
    elit->lit = m->match_lit(this, lit);
    return ref<PgfExprLit>::tagged(elit);
 }

 PgfExpr PgfDBUnmarshaller::emeta(PgfMetaId meta_id)
 {
-    ref<PgfExprMeta> emeta = DB::malloc<PgfExprMeta>();
+    ref<PgfExprMeta> emeta = PgfDB::malloc<PgfExprMeta>();
 	emeta->id = meta_id;
 	return ref<PgfExprMeta>::tagged(emeta);
 }
@@ -143,21 +143,21 @@ PgfExpr PgfDBUnmarshaller::emeta(PgfMetaId meta_id)
 PgfExpr PgfDBUnmarshaller::efun(PgfText *name)
 {
    ref<PgfExprFun> efun =
-        DB::malloc<PgfExprFun>(sizeof(PgfExprFun)+name->size+1);
+        PgfDB::malloc<PgfExprFun>(sizeof(PgfExprFun)+name->size+1);
    memcpy(&efun->name, name, sizeof(PgfText)+name->size+1);
    return ref<PgfExprFun>::tagged(efun);
 }

 PgfExpr PgfDBUnmarshaller::evar(int index)
 {
-    ref<PgfExprVar> evar = DB::malloc<PgfExprVar>();
+    ref<PgfExprVar> evar = PgfDB::malloc<PgfExprVar>();
    evar->var = index;
    return ref<PgfExprVar>::tagged(evar);
 }

 PgfExpr PgfDBUnmarshaller::etyped(PgfExpr expr, PgfType ty)
 {
-    ref<PgfExprTyped> etyped = DB::malloc<PgfExprTyped>();
+    ref<PgfExprTyped> etyped = PgfDB::malloc<PgfExprTyped>();
    etyped->expr = m->match_expr(this, expr);
    etyped->type = m->match_type(this, ty);
    return ref<PgfExprTyped>::tagged(etyped);
@@ -173,7 +173,7 @@ PgfExpr PgfDBUnmarshaller::eimplarg(PgfExpr expr)
 PgfLiteral PgfDBUnmarshaller::lint(size_t size, uintmax_t *val)
 {
    ref<PgfLiteralInt> lit_int =
-        DB::malloc<PgfLiteralInt>(sizeof(PgfLiteralInt)+size*sizeof(uintmax_t));
+        PgfDB::malloc<PgfLiteralInt>(sizeof(PgfLiteralInt)+size*sizeof(uintmax_t));
    lit_int->size = size;
    memcpy(&lit_int->val, val, size*sizeof(uintmax_t));
    return ref<PgfLiteralInt>::tagged(lit_int);
@@ -181,7 +181,7 @@ PgfLiteral PgfDBUnmarshaller::lint(size_t size, uintmax_t *val)

 PgfLiteral PgfDBUnmarshaller::lflt(double val)
 {
-    ref<PgfLiteralFlt> lit_flt = DB::malloc<PgfLiteralFlt>();
+    ref<PgfLiteralFlt> lit_flt = PgfDB::malloc<PgfLiteralFlt>();
    lit_flt->val = val;
    return ref<PgfLiteralFlt>::tagged(lit_flt);
 }
@@ -189,7 +189,7 @@ PgfLiteral PgfDBUnmarshaller::lflt(double val)
 PgfLiteral PgfDBUnmarshaller::lstr(PgfText *val)
 {
    ref<PgfLiteralStr> lit_str =
-        DB::malloc<PgfLiteralStr>(sizeof(PgfLiteralStr)+val->size+1);
+        PgfDB::malloc<PgfLiteralStr>(sizeof(PgfLiteralStr)+val->size+1);
    memcpy(&lit_str->val, val, sizeof(PgfText)+val->size+1);
    return ref<PgfLiteralStr>::tagged(lit_str);
 }
@@ -199,19 +199,19 @@ PgfType PgfDBUnmarshaller::dtyp(int n_hypos, PgfTypeHypo *hypos,
                                int n_exprs, PgfExpr *exprs)
 {
    ref<PgfDTyp> ty =
-        DB::malloc<PgfDTyp>(sizeof(PgfDTyp)+cat->size+1);
+        PgfDB::malloc<PgfDTyp>(sizeof(PgfDTyp)+cat->size+1);
    memcpy(&ty->name, cat, sizeof(PgfText)+cat->size+1);
    ty->hypos = vector_new<PgfHypo>(n_hypos);
    for (size_t i = 0; i < n_hypos; i++) {
        ref<PgfHypo> hypo = vector_elem(ty->hypos,i);
        hypo->bind_type = hypos[i].bind_type;
-        hypo->cid = DB::malloc<PgfText>(sizeof(PgfText)+hypos[i].cid->size+1);
-        memcpy(&hypo->cid->text, hypos[i].cid, sizeof(PgfText)+hypos[i].cid->size+1);
+        hypo->cid = PgfDB::malloc<PgfText>(sizeof(PgfText)+hypos[i].cid->size+1);
+        memcpy(hypo->cid, hypos[i].cid, sizeof(PgfText)+hypos[i].cid->size+1);
        hypo->type = m->match_type(this, hypos[i].type);
    }
    ty->exprs = vector_new<PgfExpr>(n_exprs);
    for (size_t i = 0; i < n_exprs; i++) {
-        vector_elem(ty->exprs,i) = exprs[i];
+        *vector_elem(ty->exprs,i) = m->match_expr(this, exprs[i]);
    }

    return ty.as_object();
@@ -219,7 +219,7 @@ PgfType PgfDBUnmarshaller::dtyp(int n_hypos, PgfTypeHypo *hypos,

 void PgfDBUnmarshaller::free_ref(object x)
 {
-    DB::free(ref<void>::untagged(x));
+    PgfDB::free(ref<void>::untagged(x));
 }

 PgfExprParser::PgfExprParser(PgfText *input, PgfUnmarshaller *unmarshaller)
--- a/src/runtime/c/pgf/namespace.h
+++ b/src/runtime/c/pgf/namespace.h
@@ -339,7 +339,7 @@ void namespace_release(Namespace<V> node)
    if (!(--node->ref_count)) {
        namespace_release(node->left);
        namespace_release(node->right);
-        DB::free(node);
+        PgfDB::free(node);
    }
 }

--- a/src/runtime/c/pgf/pgf.cxx
+++ b/src/runtime/c/pgf/pgf.cxx
@@ -13,15 +13,16 @@ pgf_exn_clear(PgfExn* err)
 }

 PGF_API
-PgfPGF *pgf_read_pgf(const char* fpath,
-                     PgfExn* err)
+PgfDB *pgf_read_pgf(const char* fpath,
+                    PgfRevision *revision,
+                    PgfExn* err)
 {
-    PgfPGF *pgf = NULL;
+    PgfDB *db = NULL;

    pgf_exn_clear(err);

    try {
-        pgf = new PgfPGF(NULL, 0, 0);
+        db = new PgfDB(NULL, 0, 0);

        std::ifstream in(fpath, std::ios::binary);
        if (in.fail()) {
@@ -29,15 +30,16 @@ PgfPGF *pgf_read_pgf(const char* fpath,
        }

        {
-            DB_scope scope(pgf, WRITER_SCOPE);
+            DB_scope scope(db, WRITER_SCOPE);

            PgfReader rdr(&in);
-            ref<PgfPGFRoot> pgf_root = rdr.read_pgf();
+            ref<PgfPGF> pgf = rdr.read_pgf();

-            pgf->set_root(pgf_root);
+            PgfDB::set_root(pgf);
+            *revision = pgf.as_object();
        }

-        return pgf;
+        return db;
    } catch (std::system_error& e) {
        err->type = PGF_EXN_SYSTEM_ERROR;
        err->code = e.code().value();
@@ -46,22 +48,23 @@ PgfPGF *pgf_read_pgf(const char* fpath,
        err->msg  = strdup(e.what());
    }

-    if (pgf != NULL)
-        delete pgf;
+    if (db != NULL)
+        delete db;

    return NULL;
 }

 PGF_API
-PgfPGF *pgf_boot_ngf(const char* pgf_path, const char* ngf_path,
-                     PgfExn* err)
+PgfDB *pgf_boot_ngf(const char* pgf_path, const char* ngf_path,
+                    PgfRevision *revision,
+                    PgfExn* err)
 {
-    PgfPGF *pgf = NULL;
+    PgfDB *db = NULL;

    pgf_exn_clear(err);

    try {
-        pgf = new PgfPGF(ngf_path, O_CREAT | O_EXCL | O_RDWR, S_IRUSR | S_IWUSR);
+        db = new PgfDB(ngf_path, O_CREAT | O_EXCL | O_RDWR, S_IRUSR | S_IWUSR);

        std::ifstream in(pgf_path, std::ios::binary);
        if (in.fail()) {
@@ -69,17 +72,18 @@ PgfPGF *pgf_boot_ngf(const char* pgf_path, const char* ngf_path,
        }

        {
-            DB_scope scope(pgf, WRITER_SCOPE);
+            DB_scope scope(db, WRITER_SCOPE);

            PgfReader rdr(&in);
-            ref<PgfPGFRoot> pgf_root = rdr.read_pgf();
+            ref<PgfPGF> pgf = rdr.read_pgf();

-            pgf->set_root(pgf_root);
+            db->set_root<PgfPGF>(pgf);
+            *revision = pgf.as_object();

-            DB::sync();
+            PgfDB::sync();
        }

-        return pgf;
+        return db;
    } catch (std::system_error& e) {
        err->type = PGF_EXN_SYSTEM_ERROR;
        err->code = e.code().value();
@@ -88,8 +92,8 @@ PgfPGF *pgf_boot_ngf(const char* pgf_path, const char* ngf_path,
        err->msg  = strdup(e.what());
    }

-    if (pgf != NULL) {
-        delete pgf;
+    if (db != NULL) {
+        delete db;
        remove(ngf_path);
    }

@@ -97,36 +101,40 @@ PgfPGF *pgf_boot_ngf(const char* pgf_path, const char* ngf_path,
 }

 PGF_API
-PgfPGF *pgf_read_ngf(const char *fpath,
+PgfDB *pgf_read_ngf(const char *fpath,
+                     PgfRevision *revision,
                     PgfExn* err)
 {
-    PgfPGF *pgf = NULL;
+    PgfDB *db = NULL;

    pgf_exn_clear(err);

    bool is_new = false;
    try {
-        pgf = new PgfPGF(fpath, O_CREAT | O_RDWR, S_IRUSR | S_IWUSR);
+        db = new PgfDB(fpath, O_CREAT | O_RDWR, S_IRUSR | S_IWUSR);

        {
-            DB_scope scope(pgf, WRITER_SCOPE);
+            DB_scope scope(db, WRITER_SCOPE);

-            if (DB::get_root<PgfPGFRoot>() == 0) {
+            if (PgfDB::get_root<PgfPGF>() == 0) {
                is_new = true;
-                ref<PgfPGFRoot> root = DB::malloc<PgfPGFRoot>();
-                root->major_version = 2;
-                root->minor_version = 0;
-                root->gflags = 0;
-                root->abstract.name = DB::malloc<PgfText>();
-                root->abstract.name->size = 0;
-                root->abstract.aflags = 0;
-                root->abstract.funs = 0;
-                root->abstract.cats = 0;
-                DB::set_root<PgfPGFRoot>(root);
+                ref<PgfPGF> pgf = PgfDB::malloc<PgfPGF>();
+                pgf->major_version = 2;
+                pgf->minor_version = 0;
+                pgf->gflags = 0;
+                pgf->abstract.name = PgfDB::malloc<PgfText>();
+                pgf->abstract.name->size = 0;
+                pgf->abstract.aflags = 0;
+                pgf->abstract.funs = 0;
+                pgf->abstract.cats = 0;
+                PgfDB::set_root<PgfPGF>(pgf);
+                *revision = pgf.as_object();
+            } else {
+                *revision = PgfDB::get_root<PgfPGF>().as_object();
            }
        }

-        return pgf;
+        return db;
    } catch (std::system_error& e) {
        err->type = PGF_EXN_SYSTEM_ERROR;
        err->code = e.code().value();
@@ -135,8 +143,8 @@ PgfPGF *pgf_read_ngf(const char *fpath,
        err->msg  = strdup(e.what());
    }

-    if (pgf != NULL) {
-        delete pgf;
+    if (db != NULL) {
+        delete db;
        if (is_new)
            remove(fpath);
    }
@@ -145,32 +153,42 @@ PgfPGF *pgf_read_ngf(const char *fpath,
 }

 PGF_API
-void pgf_free(PgfPGF *pgf)
+void pgf_free(PgfDB *db)
+{
+    delete db;
+}
+
+PGF_API_DECL
+void pgf_free_revision(PgfDB *pgf, PgfRevision revision)
 {
-    delete pgf;
 }

 PGF_API
-PgfText *pgf_abstract_name(PgfPGF* pgf)
+PgfText *pgf_abstract_name(PgfDB *db, PgfRevision revision)
 {
-    DB_scope scope(pgf, READER_SCOPE);
+    DB_scope scope(db, READER_SCOPE);
+    ref<PgfPGF> pgf = revision;

-    return textdup(&(*pgf->get_root<PgfPGFRoot>()->abstract.name));
+    return textdup(&(*pgf->abstract.name));
 }

 PGF_API
-void pgf_iter_categories(PgfPGF *pgf, PgfItor *itor, PgfExn *err)
+void pgf_iter_categories(PgfDB *db, PgfRevision revision,
+                         PgfItor *itor, PgfExn *err)
 {
-    DB_scope scope(pgf, READER_SCOPE);
+    DB_scope scope(db, READER_SCOPE);
+    ref<PgfPGF> pgf = revision;

-    err->type = PGF_EXN_NONE;
-    namespace_iter(pgf->get_root<PgfPGFRoot>()->abstract.cats, itor, err);
+    pgf_exn_clear(err);
+    namespace_iter(pgf->abstract.cats, itor, err);
 }

 PGF_API
-PgfType pgf_start_cat(PgfPGF *pgf, PgfUnmarshaller *u)
+PgfType pgf_start_cat(PgfDB *db, PgfRevision revision,
+                      PgfUnmarshaller *u)
 {
-    DB_scope scope(pgf, READER_SCOPE);
+    DB_scope scope(db, READER_SCOPE);
+    ref<PgfPGF> pgf = revision;

    PgfText *startcat = (PgfText *)
        alloca(sizeof(PgfText)+9);
@@ -178,7 +196,7 @@ PgfType pgf_start_cat(PgfPGF *pgf, PgfUnmarshaller *u)
    strcpy(startcat->text, "startcat");

 	ref<PgfFlag> flag =
-		namespace_lookup(pgf->get_root<PgfPGFRoot>()->abstract.aflags, startcat);
+		namespace_lookup(pgf->abstract.aflags, startcat);

 	if (flag != 0) {
 		switch (ref<PgfLiteral>::get_tag(flag->value)) {
@@ -202,12 +220,14 @@ PgfType pgf_start_cat(PgfPGF *pgf, PgfUnmarshaller *u)
 }

 PGF_API
-PgfTypeHypo *pgf_category_context(PgfPGF *pgf, PgfText *catname, size_t *n_hypos, PgfUnmarshaller *u)
+PgfTypeHypo *pgf_category_context(PgfDB *db, PgfRevision revision,
+                                  PgfText *catname, size_t *n_hypos, PgfUnmarshaller *u)
 {
-    DB_scope scope(pgf, READER_SCOPE);
+    DB_scope scope(db, READER_SCOPE);
+    ref<PgfPGF> pgf = revision;

    ref<PgfAbsCat> abscat =
-        namespace_lookup(pgf->get_root<PgfPGFRoot>()->abstract.cats, catname);
+        namespace_lookup(pgf->abstract.cats, catname);
 	if (abscat == 0) {
        *n_hypos = 0;
 		return NULL;
@@ -228,12 +248,14 @@ PgfTypeHypo *pgf_category_context(PgfPGF *pgf, PgfText *catname, size_t *n_hypos
 }

 PGF_API
-prob_t pgf_category_prob(PgfPGF *pgf, PgfText *catname)
+prob_t pgf_category_prob(PgfDB *db, PgfRevision revision,
+                         PgfText *catname)
 {
-    DB_scope scope(pgf, READER_SCOPE);
+    DB_scope scope(db, READER_SCOPE);
+    ref<PgfPGF> pgf = revision;

    ref<PgfAbsCat> abscat =
-        namespace_lookup(pgf->get_root<PgfPGFRoot>()->abstract.cats, catname);
+        namespace_lookup(pgf->abstract.cats, catname);
 	if (abscat == 0) {
 		return 0;
    }
@@ -242,12 +264,14 @@ prob_t pgf_category_prob(PgfPGF *pgf, PgfText *catname)
 }

 PGF_API
-void pgf_iter_functions(PgfPGF *pgf, PgfItor *itor, PgfExn *err)
+void pgf_iter_functions(PgfDB *db, PgfRevision revision,
+                        PgfItor *itor, PgfExn *err)
 {
-    DB_scope scope(pgf, READER_SCOPE);
+    DB_scope scope(db, READER_SCOPE);
+    ref<PgfPGF> pgf = revision;

-    err->type = PGF_EXN_NONE;
-    namespace_iter(pgf->get_root<PgfPGFRoot>()->abstract.funs, itor, err);
+    pgf_exn_clear(err);
+    namespace_iter(pgf->abstract.funs, itor, err);
 }

 struct PgfItorHelper : PgfItor
@@ -267,26 +291,30 @@ void iter_by_cat_helper(PgfItor *itor, PgfText *key, void *value,
 }

 PGF_API
-void pgf_iter_functions_by_cat(PgfPGF *pgf, PgfText *cat, PgfItor *itor, PgfExn *err)
+void pgf_iter_functions_by_cat(PgfDB *db, PgfRevision revision,
+                               PgfText *cat, PgfItor *itor, PgfExn *err)
 {
-    DB_scope scope(pgf, READER_SCOPE);
+    DB_scope scope(db, READER_SCOPE);
+    ref<PgfPGF> pgf = revision;

    PgfItorHelper helper;
    helper.fn   = iter_by_cat_helper;
    helper.cat  = cat;
    helper.itor = itor;

-    err->type = PGF_EXN_NONE;
-    namespace_iter(pgf->get_root<PgfPGFRoot>()->abstract.funs, &helper, err);
+    pgf_exn_clear(err);
+    namespace_iter(pgf->abstract.funs, &helper, err);
 }

 PGF_API
-PgfType pgf_function_type(PgfPGF *pgf, PgfText *funname, PgfUnmarshaller *u)
+PgfType pgf_function_type(PgfDB *db, PgfRevision revision,
+                          PgfText *funname, PgfUnmarshaller *u)
 {
-    DB_scope scope(pgf, READER_SCOPE);
+    DB_scope scope(db, READER_SCOPE);
+    ref<PgfPGF> pgf = revision;

    ref<PgfAbsFun> absfun =
-        namespace_lookup(pgf->get_root<PgfPGFRoot>()->abstract.funs, funname);
+        namespace_lookup(pgf->abstract.funs, funname);
 	if (absfun == 0)
 		return 0;

@@ -294,12 +322,14 @@ PgfType pgf_function_type(PgfPGF *pgf, PgfText *funname, PgfUnmarshaller *u)
 }

 PGF_API
-int pgf_function_is_constructor(PgfPGF *pgf, PgfText *funname)
+int pgf_function_is_constructor(PgfDB *db, PgfRevision revision,
+                                PgfText *funname)
 {
-    DB_scope scope(pgf, READER_SCOPE);
+    DB_scope scope(db, READER_SCOPE);
+    ref<PgfPGF> pgf = revision;

    ref<PgfAbsFun> absfun =
-        namespace_lookup(pgf->get_root<PgfPGFRoot>()->abstract.funs, funname);
+        namespace_lookup(pgf->abstract.funs, funname);
 	if (absfun == 0)
 		return false;

@@ -307,12 +337,14 @@ int pgf_function_is_constructor(PgfPGF *pgf, PgfText *funname)
 }

 PGF_API
-prob_t pgf_function_prob(PgfPGF *pgf, PgfText *funname)
+prob_t pgf_function_prob(PgfDB *db, PgfRevision revision,
+                         PgfText *funname)
 {
-    DB_scope scope(pgf, READER_SCOPE);
+    DB_scope scope(db, READER_SCOPE);
+    ref<PgfPGF> pgf = revision;

    ref<PgfAbsFun> absfun =
-        namespace_lookup(pgf->get_root<PgfPGFRoot>()->abstract.funs, funname);
+        namespace_lookup(pgf->abstract.funs, funname);
 	if (absfun == 0)
 		return INFINITY;

@@ -363,28 +395,87 @@ PgfType pgf_read_type(PgfText *input, PgfUnmarshaller *u)
    return res;
 }

-PGF_API
-void pgf_create_function(PgfPGF *pgf, PgfText *name,
-                         PgfType ty, prob_t prob,
-                         PgfMarshaller *m)
+PGF_API_DECL
+PgfRevision pgf_clone_revision(PgfDB *db, PgfRevision revision,
+                               PgfExn *err)
 {
-    DB_scope scope(pgf, WRITER_SCOPE);
+    DB_scope scope(db, WRITER_SCOPE);

-    PgfDBUnmarshaller u(m);
+    pgf_exn_clear(err);

-    ref<PgfPGFRoot> root = pgf->get_root<PgfPGFRoot>();
-    ref<PgfAbsFun> absfun = DB::malloc<PgfAbsFun>(sizeof(PgfAbsFun)+name->size+1);
-    absfun->type  = m->match_type(&u, ty);
-    absfun->arity = 0;
-    absfun->defns = 0;
-    absfun->ep.prob = prob;
-    ref<PgfExprFun> efun =
-        ref<PgfExprFun>::from_ptr((PgfExprFun*) &absfun->name);
-    absfun->ep.expr = ref<PgfExprFun>::tagged(efun);
-    memcpy(&absfun->name, name, sizeof(PgfText)+name->size+1);
-    
-    Namespace<PgfAbsFun> nmsp =
-        namespace_insert(root->abstract.funs, absfun);
-    namespace_release(root->abstract.funs);
-    root->abstract.funs = nmsp;
+    try {
+        ref<PgfPGF> pgf = revision;
+
+        ref<PgfPGF> new_pgf = PgfDB::malloc<PgfPGF>();
+        new_pgf->major_version = pgf->major_version;
+        new_pgf->minor_version = pgf->minor_version;
+
+        new_pgf->gflags = pgf->gflags;
+        if (pgf->gflags != 0)
+            pgf->gflags->ref_count++;
+
+        new_pgf->abstract.name =
+            PgfDB::malloc<PgfText>(sizeof(PgfText)+pgf->abstract.name->size+1);
+        memcpy(new_pgf->abstract.name, pgf->abstract.name, sizeof(PgfText)+pgf->abstract.name->size+1);
+
+        new_pgf->abstract.aflags = pgf->abstract.aflags;
+        if (pgf->abstract.aflags != 0)
+            pgf->abstract.aflags->ref_count++;
+
+        new_pgf->abstract.funs = pgf->abstract.funs;
+        if (pgf->abstract.funs != 0)
+            pgf->abstract.funs->ref_count++;
+
+        new_pgf->abstract.cats = pgf->abstract.cats;
+        if (pgf->abstract.cats != 0)
+            pgf->abstract.cats->ref_count++;
+
+        return new_pgf.as_object();
+    } catch (std::system_error& e) {
+        err->type = PGF_EXN_SYSTEM_ERROR;
+        err->code = e.code().value();
+    } catch (pgf_error& e) {
+        err->type = PGF_EXN_PGF_ERROR;
+        err->msg  = strdup(e.what());
+    }
+
+    return 0;
+}
+
+PGF_API
+void pgf_create_function(PgfDB *db, PgfRevision revision,
+                         PgfText *name,
+                         PgfType ty, prob_t prob,
+                         PgfMarshaller *m,
+                         PgfExn *err)
+{
+    DB_scope scope(db, WRITER_SCOPE);
+
+    pgf_exn_clear(err);
+
+    try {
+        PgfDBUnmarshaller u(m);
+
+        ref<PgfPGF> pgf = revision;
+        ref<PgfAbsFun> absfun = PgfDB::malloc<PgfAbsFun>(sizeof(PgfAbsFun)+name->size+1);
+        absfun->type  = m->match_type(&u, ty);
+        absfun->arity = 0;
+        absfun->defns = 0;
+        absfun->ep.prob = prob;
+        ref<PgfExprFun> efun =
+            ref<PgfExprFun>::from_ptr((PgfExprFun*) &absfun->name);
+        absfun->ep.expr = ref<PgfExprFun>::tagged(efun);
+        memcpy(&absfun->name, name, sizeof(PgfText)+name->size+1);
+        
+        Namespace<PgfAbsFun> nmsp =
+            namespace_insert(pgf->abstract.funs, absfun);
+        namespace_release(pgf->abstract.funs);
+        pgf->abstract.funs = nmsp;
+    } catch (std::system_error& e) {
+        err->type = PGF_EXN_SYSTEM_ERROR;
+        err->code = e.code().value();
+    } catch (pgf_error& e) {
+        err->type = PGF_EXN_PGF_ERROR;
+        err->msg  = strdup(e.what());
+    }
 }
--- a/src/runtime/c/pgf/pgf.h
+++ b/src/runtime/c/pgf/pgf.h
@@ -210,62 +210,80 @@ struct PgfMarshaller {

 typedef float prob_t;

-typedef struct PgfPGF PgfPGF;
+typedef struct PgfDB PgfDB;
+typedef object PgfRevision;

-/* Reads a PGF file and keeps it in memory. */
+/* Reads a PGF file and builds the database in memory.
+ * If successful, *revision will contain the initial revision of
+ * the grammar. */
 PGF_API_DECL
-PgfPGF *pgf_read_pgf(const char* fpath,
-                     PgfExn* err);
+PgfDB *pgf_read_pgf(const char* fpath, PgfRevision *revision,
+                    PgfExn* err);

 /* Reads a PGF file and stores the unpacked data in an NGF file
- * ready to be shared with other process, or used for quick startup.
+ * ready to be shared with other process, or used for quick re-start.
 * The NGF file is platform dependent and should not be copied
 * between machines. */
 PGF_API_DECL
-PgfPGF *pgf_boot_ngf(const char* pgf_path, const char* ngf_path,
-                     PgfExn* err);
+PgfDB *pgf_boot_ngf(const char* pgf_path, const char* ngf_path,
+                    PgfRevision *revision,
+                    PgfExn* err);

 /* Tries to read the grammar from an already booted NGF file.
 * If the file does not exist then a new one is created, and the
 * grammar is set to be empty. It can later be populated with
- * rules dynamically. */
+ * rules dynamically. The default grammar revision is stored
+ * in *revision. */
 PGF_API_DECL
-PgfPGF *pgf_read_ngf(const char* fpath,
-                     PgfExn* err);
+PgfDB *pgf_read_ngf(const char* fpath,
+                    PgfRevision *revision,
+                    PgfExn* err);

-/* Release the grammar when it is no longer needed. */
+/* Release the database when it is no longer needed. */
 PGF_API_DECL
-void pgf_free(PgfPGF *pgf);
+void pgf_free(PgfDB *pgf);

 PGF_API_DECL
-PgfText *pgf_abstract_name(PgfPGF *pgf);
+void pgf_free_revision(PgfDB *pgf, PgfRevision revision);

 PGF_API_DECL
-void pgf_iter_categories(PgfPGF *pgf, PgfItor *itor, PgfExn *err);
+PgfText *pgf_abstract_name(PgfDB *db, PgfRevision revision);

 PGF_API_DECL
-PgfType pgf_start_cat(PgfPGF *pgf, PgfUnmarshaller *u);
+void pgf_iter_categories(PgfDB *db, PgfRevision revision,
+                         PgfItor *itor, PgfExn *err);

 PGF_API_DECL
-PgfTypeHypo *pgf_category_context(PgfPGF *pgf, PgfText *catname, size_t *n_hypos, PgfUnmarshaller *u);
+PgfType pgf_start_cat(PgfDB *db, PgfRevision revision,
+                      PgfUnmarshaller *u);

 PGF_API_DECL
-prob_t pgf_category_prob(PgfPGF* pgf, PgfText *catname);
+PgfTypeHypo *pgf_category_context(PgfDB *db, PgfRevision revision,
+                                  PgfText *catname, size_t *n_hypos, PgfUnmarshaller *u);

 PGF_API_DECL
-void pgf_iter_functions(PgfPGF *pgf, PgfItor *itor, PgfExn *err);
+prob_t pgf_category_prob(PgfDB *db, PgfRevision revision,
+                         PgfText *catname);

 PGF_API_DECL
-void pgf_iter_functions_by_cat(PgfPGF *pgf, PgfText *cat, PgfItor *itor, PgfExn *err);
+void pgf_iter_functions(PgfDB *db, PgfRevision revision,
+                        PgfItor *itor, PgfExn *err);

 PGF_API_DECL
-PgfType pgf_function_type(PgfPGF *pgf, PgfText *funname, PgfUnmarshaller *u);
+void pgf_iter_functions_by_cat(PgfDB *db, PgfRevision revision,
+                               PgfText *cat, PgfItor *itor, PgfExn *err);

 PGF_API_DECL
-int pgf_function_is_constructor(PgfPGF *pgf, PgfText *funname);
+PgfType pgf_function_type(PgfDB *db, PgfRevision revision,
+                          PgfText *funname, PgfUnmarshaller *u);

 PGF_API_DECL
-prob_t pgf_function_prob(PgfPGF *pgf, PgfText *funname);
+int pgf_function_is_constructor(PgfDB *db, PgfRevision revision,
+                                PgfText *funname);
+
+PGF_API_DECL
+prob_t pgf_function_prob(PgfDB *db, PgfRevision revision,
+                         PgfText *funname);

 typedef struct PgfPrintContext PgfPrintContext;

@@ -291,8 +309,14 @@ PGF_API_DECL
 PgfType pgf_read_type(PgfText *input, PgfUnmarshaller *u);

 PGF_API_DECL
-void pgf_create_function(PgfPGF *pgf, PgfText *name,
+PgfRevision pgf_clone_revision(PgfDB *db, PgfRevision revision,
+                               PgfExn *err);
+
+PGF_API_DECL
+void pgf_create_function(PgfDB *db, PgfRevision revision,
+                         PgfText *name,
                         PgfType ty, prob_t prob,
-                         PgfMarshaller *m);
+                         PgfMarshaller *m,
+                         PgfExn *err);

 #endif // PGF_H_
--- a/src/runtime/c/pgf/reader.cxx
+++ b/src/runtime/c/pgf/reader.cxx
@@ -204,7 +204,7 @@ PgfLiteral PgfReader::read_literal()
 	}
 	case PgfLiteralInt::tag: {
 		ref<PgfLiteralInt> lit_int =
-			DB::malloc<PgfLiteralInt>(sizeof(PgfLiteralInt)+sizeof(uintmax_t));
+			PgfDB::malloc<PgfLiteralInt>(sizeof(PgfLiteralInt)+sizeof(uintmax_t));
        lit_int->size   = 1;
 		lit_int->val[0] = read_int();
        lit = ref<PgfLiteralInt>::tagged(lit_int);
@@ -245,20 +245,20 @@ PgfExpr PgfReader::read_expr()
 		break;
 	}
 	case PgfExprApp::tag: {
-        ref<PgfExprApp> eapp = DB::malloc<PgfExprApp>();
+        ref<PgfExprApp> eapp = PgfDB::malloc<PgfExprApp>();
 		eapp->fun = read_expr();
 		eapp->arg = read_expr();
        expr = ref<PgfExprApp>::tagged(eapp);
 		break;
 	}
 	case PgfExprLit::tag: {
-        ref<PgfExprLit> elit = DB::malloc<PgfExprLit>();
+        ref<PgfExprLit> elit = PgfDB::malloc<PgfExprLit>();
 		elit->lit = read_literal();
 		expr = ref<PgfExprLit>::tagged(elit);
 		break;
 	}
 	case PgfExprMeta::tag: {
-		ref<PgfExprMeta> emeta = DB::malloc<PgfExprMeta>();
+		ref<PgfExprMeta> emeta = PgfDB::malloc<PgfExprMeta>();
 		emeta->id = read_int();
 		expr = ref<PgfExprMeta>::tagged(emeta);
 		break;
@@ -269,13 +269,13 @@ PgfExpr PgfReader::read_expr()
 		break;
 	}
 	case PgfExprVar::tag: {
-        ref<PgfExprVar> evar = DB::malloc<PgfExprVar>();
+        ref<PgfExprVar> evar = PgfDB::malloc<PgfExprVar>();
 		evar->var = read_int();
        expr = ref<PgfExprVar>::tagged(evar);
 		break;
 	}
 	case PgfExprTyped::tag: {
-        ref<PgfExprTyped> etyped = DB::malloc<PgfExprTyped>();
+        ref<PgfExprTyped> etyped = PgfDB::malloc<PgfExprTyped>();
 		etyped->expr = read_expr();
 		etyped->type = read_type();
        expr = ref<PgfExprTyped>::tagged(etyped);
@@ -339,24 +339,24 @@ PgfPatt PgfReader::read_patt()
 		break;
 	}
 	case PgfPattWild::tag: {
-		ref<PgfPattWild> pwild = DB::malloc<PgfPattWild>();
+		ref<PgfPattWild> pwild = PgfDB::malloc<PgfPattWild>();
        patt = ref<PgfPattWild>::tagged(pwild);
 		break;
 	}
 	case PgfPattLit::tag: {
-        ref<PgfPattLit> plit = DB::malloc<PgfPattLit>();
+        ref<PgfPattLit> plit = PgfDB::malloc<PgfPattLit>();
 		plit->lit = read_literal();
        patt = ref<PgfPattLit>::tagged(plit);
 		break;
 	}
 	case PgfPattImplArg::tag: {
-        ref<PgfPattImplArg> pimpl = DB::malloc<PgfPattImplArg>();
+        ref<PgfPattImplArg> pimpl = PgfDB::malloc<PgfPattImplArg>();
 		pimpl->patt = read_patt();
        patt = ref<PgfPattImplArg>::tagged(pimpl);
 		break;
 	}
 	case PgfPattTilde::tag: {
-        ref<PgfPattTilde> ptilde = DB::malloc<PgfPattTilde>();
+        ref<PgfPattTilde> ptilde = PgfDB::malloc<PgfPattTilde>();
 		ptilde->expr = read_expr();
        patt = ref<PgfPattTilde>::tagged(ptilde);
 		break;
@@ -425,9 +425,9 @@ void PgfReader::read_abstract(ref<PgfAbstr> abstract)
    abstract->cats = read_namespace<PgfAbsCat>(&PgfReader::read_abscat);
 }

-ref<PgfPGFRoot> PgfReader::read_pgf()
+ref<PgfPGF> PgfReader::read_pgf()
 {
-    ref<PgfPGFRoot> pgf = DB::malloc<PgfPGFRoot>();
+    ref<PgfPGF> pgf = PgfDB::malloc<PgfPGF>();

    pgf->major_version = read_u16be();
    pgf->minor_version = read_u16be();
--- a/src/runtime/c/pgf/reader.h
+++ b/src/runtime/c/pgf/reader.h
@@ -70,7 +70,7 @@ public:
    ref<PgfAbsCat> read_abscat();
    void read_abstract(ref<PgfAbstr> abstract);

-    ref<PgfPGFRoot> read_pgf();
+    ref<PgfPGF> read_pgf();

 private:
    std::istream *in;
--- a/src/runtime/c/pgf/vector.h
+++ b/src/runtime/c/pgf/vector.h
@@ -10,7 +10,7 @@ struct PgfVector {
 template <class A> inline
 ref<PgfVector<A>> vector_new(size_t len)
 {
-    ref<PgfVector<A>> res = DB::malloc<PgfVector<A>>(sizeof(PgfVector<A>)+len*sizeof(A));
+    ref<PgfVector<A>> res = PgfDB::malloc<PgfVector<A>>(sizeof(PgfVector<A>)+len*sizeof(A));
    res->len = len;
    return res;
 }
@@ -18,7 +18,7 @@ ref<PgfVector<A>> vector_new(size_t len)
 template <class C, class A> inline
 ref<C> vector_new(PgfVector<A> C::* field, size_t len)
 {
-    ref<C> res = DB::malloc<C>(((size_t) &(((C*) NULL)->*field))+sizeof(PgfVector<A>)+len*sizeof(A));
+    ref<C> res = PgfDB::malloc<C>(((size_t) &(((C*) NULL)->*field))+sizeof(PgfVector<A>)+len*sizeof(A));
    (res->*field).len = len;
    return res;
 }
--- a/src/runtime/haskell/PGF2.hsc
+++ b/src/runtime/haskell/PGF2.hsc
@@ -40,8 +40,6 @@ module PGF2 (-- * PGF
             mkType, unType,
             mkHypo, mkDepHypo, mkImplHypo,

-             createFunction,
-
             -- * Concrete syntax
             ConcName,

@@ -49,13 +47,14 @@ module PGF2 (-- * PGF
             PGFError(..)
             ) where

-import Control.Exception(mask_,bracket)
-import System.IO.Unsafe(unsafePerformIO)
 import PGF2.Expr
 import PGF2.FFI

 import Foreign
 import Foreign.C
+import Control.Exception(mask_,bracket)
+import System.IO.Unsafe(unsafePerformIO)
+import qualified Foreign.Concurrent as C
 import qualified Data.Map as Map
 import Data.IORef

@@ -68,10 +67,13 @@ type ConcName = String -- ^ Name of concrete syntax
 readPGF :: FilePath -> IO PGF
 readPGF fpath =
  withCString fpath $ \c_fpath ->
+  alloca $ \p_revision ->
  mask_ $ do
-    c_pgf <- withPgfExn fpath (pgf_read_pgf c_fpath)
-    fptr <- newForeignPtr pgf_free_fptr c_pgf
-    return (PGF fptr Map.empty)
+    c_pgf <- withPgfExn fpath (pgf_read_pgf c_fpath p_revision)
+    c_revision <- peek p_revision
+    fptr1 <- newForeignPtr pgf_free_fptr c_pgf
+    fptr2 <- C.newForeignPtr c_revision (withForeignPtr fptr1 (\c_db -> pgf_free_revision c_db c_revision))
+    return (PGF fptr1 fptr2 Map.empty)

 -- | Reads a PGF file and stores the unpacked data in an NGF file
 -- ready to be shared with other process, or used for quick startup.
@@ -81,10 +83,13 @@ bootNGF :: FilePath -> FilePath -> IO PGF
 bootNGF pgf_path ngf_path =
  withCString pgf_path $ \c_pgf_path ->
  withCString ngf_path $ \c_ngf_path ->
+  alloca $ \p_revision ->
  mask_ $ do
-    c_pgf <- withPgfExn pgf_path (pgf_boot_ngf c_pgf_path c_ngf_path)
-    fptr <- newForeignPtr pgf_free_fptr c_pgf
-    return (PGF fptr Map.empty)
+    c_pgf <- withPgfExn pgf_path (pgf_boot_ngf c_pgf_path c_ngf_path p_revision)
+    c_revision <- peek p_revision
+    fptr1 <- newForeignPtr pgf_free_fptr c_pgf
+    fptr2 <- C.newForeignPtr c_revision (withForeignPtr fptr1 (\c_db -> pgf_free_revision c_db c_revision))
+    return (PGF fptr1 fptr2 Map.empty)

 -- | Tries to read the grammar from an already booted NGF file.
 -- If the file does not exist then a new one is created, and the
@@ -93,18 +98,22 @@ bootNGF pgf_path ngf_path =
 readNGF :: FilePath -> IO PGF
 readNGF fpath =
  withCString fpath $ \c_fpath ->
+  alloca $ \p_revision ->
  mask_ $ do
-    c_pgf <- withPgfExn fpath (pgf_read_ngf c_fpath)
-    fptr <- newForeignPtr pgf_free_fptr c_pgf
-    return (PGF fptr Map.empty)
+    c_db <- withPgfExn fpath (pgf_read_ngf c_fpath p_revision)
+    c_revision <- peek p_revision
+    fptr1 <- newForeignPtr pgf_free_fptr c_db
+    fptr2 <- C.newForeignPtr c_revision (withForeignPtr fptr1 (\c_db -> pgf_free_revision c_db c_revision))
+    return (PGF fptr1 fptr2 Map.empty)

 -- | The abstract language name is the name of the top-level
 -- abstract module
 abstractName :: PGF -> AbsName
 abstractName p =
  unsafePerformIO $
-  withForeignPtr (a_pgf p) $ \p_pgf ->
-  bracket (pgf_abstract_name p_pgf) free $ \c_text ->
+  withForeignPtr (a_db p) $ \c_db ->
+  withForeignPtr (revision p) $ \c_revision ->
+  bracket (pgf_abstract_name c_db c_revision) free $ \c_text ->
    peekText c_text

 -- | The start category is defined in the grammar with
@@ -116,8 +125,9 @@ startCat :: PGF -> Type
 startCat p =
  unsafePerformIO $
  withForeignPtr unmarshaller $ \u ->
-  withForeignPtr (a_pgf p) $ \c_pgf -> do
-    c_typ <- pgf_start_cat c_pgf u
+  withForeignPtr (a_db p) $ \c_db ->
+  withForeignPtr (revision p) $ \c_revision -> do
+    c_typ <- pgf_start_cat c_db c_revision u
    typ <- deRefStablePtr c_typ
    freeStablePtr c_typ
    return typ
@@ -127,9 +137,10 @@ functionType :: PGF -> Fun -> Maybe Type
 functionType p fn =
  unsafePerformIO $
  withForeignPtr unmarshaller $ \u ->
-  withForeignPtr (a_pgf p) $ \p_pgf ->
+  withForeignPtr (a_db p) $ \c_db ->
+  withForeignPtr (revision p) $ \c_revision ->
  withText fn $ \c_fn -> do
-    c_typ <- pgf_function_type p_pgf c_fn u
+    c_typ <- pgf_function_type c_db c_revision c_fn u
    if c_typ == castPtrToStablePtr nullPtr
      then return Nothing
      else do typ <- deRefStablePtr c_typ
@@ -140,16 +151,18 @@ functionIsConstructor :: PGF -> Fun -> Bool
 functionIsConstructor p fun =
  unsafePerformIO $
  withText fun $ \c_fun ->
-  withForeignPtr (a_pgf p) $ \c_pgf ->
-      do res <- pgf_function_is_constructor c_pgf c_fun
+  withForeignPtr (a_db p) $ \c_db ->
+  withForeignPtr (revision p) $ \c_revision ->
+      do res <- pgf_function_is_constructor c_db c_revision c_fun
         return (res /= 0)

 functionProb :: PGF -> Fun -> Float
 functionProb p fun =
  unsafePerformIO $
  withText fun $ \c_fun ->
-  withForeignPtr (a_pgf p) $ \c_pgf ->
-      do c_prob <- pgf_function_prob c_pgf c_fun
+  withForeignPtr (a_db p) $ \c_db ->
+  withForeignPtr (revision p) $ \c_revision ->
+      do c_prob <- pgf_function_prob c_db c_revision c_fun
         return (realToFrac c_prob)

 -- | List of all functions defined in the abstract syntax
@@ -159,9 +172,10 @@ categories p =
    ref <- newIORef []
    (allocaBytes (#size PgfItor) $ \itor ->
     bracket (wrapItorCallback (getCategories ref)) freeHaskellFunPtr $ \fptr ->
-     withForeignPtr (a_pgf p) $ \p_pgf -> do
+     withForeignPtr (a_db p) $ \c_db ->
+     withForeignPtr (revision p) $ \c_revision -> do
      (#poke PgfItor, fn) itor fptr
-      withPgfExn "" (pgf_iter_categories p_pgf itor)
+      withPgfExn "" (pgf_iter_categories c_db c_revision itor)
      cs <- readIORef ref
      return (reverse cs))
  where
@@ -177,9 +191,10 @@ categoryContext p cat =
  withText cat $ \c_cat ->
  alloca $ \p_n_hypos ->
  withForeignPtr unmarshaller $ \u ->
-  withForeignPtr (a_pgf p) $ \c_pgf ->
+  withForeignPtr (a_db p) $ \c_db ->
+  withForeignPtr (revision p) $ \c_revision ->
  mask_ $ do
-    c_hypos <- pgf_category_context c_pgf c_cat p_n_hypos u
+    c_hypos <- pgf_category_context c_db c_revision c_cat p_n_hypos u
    if c_hypos == nullPtr
      then return []
      else do n_hypos <- peek p_n_hypos
@@ -204,8 +219,9 @@ categoryProb :: PGF -> Cat -> Float
 categoryProb p cat =
  unsafePerformIO $
  withText cat $ \c_cat ->
-  withForeignPtr (a_pgf p) $ \c_pgf ->
-      do c_prob <- pgf_category_prob c_pgf c_cat
+  withForeignPtr (a_db p) $ \c_db ->
+  withForeignPtr (revision p) $ \c_revision ->
+      do c_prob <- pgf_category_prob c_db c_revision c_cat
         return (realToFrac c_prob)

 -- | List of all functions defined in the abstract syntax
@@ -215,9 +231,10 @@ functions p =
    ref <- newIORef []
    (allocaBytes (#size PgfItor) $ \itor ->
     bracket (wrapItorCallback (getFunctions ref)) freeHaskellFunPtr $ \fptr ->
-     withForeignPtr (a_pgf p) $ \p_pgf -> do
+     withForeignPtr (a_db p) $ \c_db ->
+     withForeignPtr (revision p) $ \c_revision -> do
      (#poke PgfItor, fn) itor fptr
-      withPgfExn "" (pgf_iter_functions p_pgf itor)
+      withPgfExn "" (pgf_iter_functions c_db c_revision itor)
      fs <- readIORef ref
      return (reverse fs))
  where
@@ -235,9 +252,10 @@ functionsByCat p cat =
    (withText cat $ \c_cat ->
     allocaBytes (#size PgfItor) $ \itor ->
     bracket (wrapItorCallback (getFunctions ref)) freeHaskellFunPtr $ \fptr ->
-     withForeignPtr (a_pgf p) $ \p_pgf -> do
+     withForeignPtr (a_db p) $ \c_db ->
+     withForeignPtr (revision p) $ \c_revision -> do
      (#poke PgfItor, fn) itor fptr
-      withPgfExn "" (pgf_iter_functions_by_cat p_pgf c_cat itor)
+      withPgfExn "" (pgf_iter_functions_by_cat c_db c_revision c_cat itor)
      fs <- readIORef ref
      return (reverse fs))
  where
@@ -316,11 +334,3 @@ readType str =
      else do ty <- deRefStablePtr c_ty
              freeStablePtr c_ty
              return (Just ty)
-
-createFunction :: PGF -> Fun -> Type -> Float -> IO ()
-createFunction p name ty prob =
-  withForeignPtr (a_pgf p) $ \p_pgf ->
-  withText name $ \c_name ->
-  bracket (newStablePtr ty) freeStablePtr $ \c_ty ->
-  withForeignPtr marshaller $ \m -> do
-    pgf_create_function p_pgf c_name c_ty prob m
--- a/src/runtime/haskell/PGF2/FFI.hsc
+++ b/src/runtime/haskell/PGF2/FFI.hsc
@@ -20,8 +20,11 @@ import PGF2.Expr

 -- | An abstract data type representing multilingual grammar
 -- in Portable Grammar Format.
-data PGF = PGF {a_pgf :: ForeignPtr PgfPGF, langs :: Map.Map String Concr}
-data Concr = Concr {c_pgf :: ForeignPtr PgfPGF, concr :: Ptr PgfConcr}
+data PGF = PGF { a_db     :: ForeignPtr PgfDB
+               , revision :: ForeignPtr PgfRevision
+               , langs    :: Map.Map String Concr
+               }
+data Concr = Concr {c_pgf :: ForeignPtr PgfDB, concr :: Ptr PgfConcr}

 ------------------------------------------------------------------
 -- libpgf API
@@ -29,7 +32,8 @@ data Concr = Concr {c_pgf :: ForeignPtr PgfPGF, concr :: Ptr PgfConcr}
 data PgfExn
 data PgfText
 data PgfItor
-data PgfPGF
+data PgfDB
+data PgfRevision
 data PgfPrintContext
 data PgfConcr
 data PgfTypeHypo
@@ -43,19 +47,22 @@ foreign import ccall unsafe "pgf_utf8_encode"
  pgf_utf8_encode :: Word32 -> Ptr CString -> IO ()

 foreign import ccall "pgf_read_pgf"
-  pgf_read_pgf :: CString -> Ptr PgfExn -> IO (Ptr PgfPGF)
+  pgf_read_pgf :: CString -> Ptr (Ptr PgfRevision) -> Ptr PgfExn -> IO (Ptr PgfDB)

 foreign import ccall "pgf_boot_ngf"
-  pgf_boot_ngf :: CString -> CString -> Ptr PgfExn -> IO (Ptr PgfPGF)
+  pgf_boot_ngf :: CString -> CString -> Ptr (Ptr PgfRevision) -> Ptr PgfExn -> IO (Ptr PgfDB)

 foreign import ccall "pgf_read_ngf"
-  pgf_read_ngf :: CString -> Ptr PgfExn -> IO (Ptr PgfPGF)
+  pgf_read_ngf :: CString -> Ptr (Ptr PgfRevision) -> Ptr PgfExn -> IO (Ptr PgfDB)

 foreign import ccall "&pgf_free"
-  pgf_free_fptr :: FinalizerPtr PgfPGF
+  pgf_free_fptr :: FinalizerPtr PgfDB
+
+foreign import ccall "pgf_free_revision"
+  pgf_free_revision :: Ptr PgfDB -> Ptr PgfRevision -> IO ()

 foreign import ccall "pgf_abstract_name"
-  pgf_abstract_name :: Ptr PgfPGF -> IO (Ptr PgfText)
+  pgf_abstract_name :: Ptr PgfDB -> Ptr PgfRevision -> IO (Ptr PgfText)

 foreign import ccall "pgf_print_expr"
  pgf_print_expr :: StablePtr Expr -> Ptr PgfPrintContext -> CInt -> Ptr PgfMarshaller -> IO (Ptr PgfText)
@@ -75,34 +82,37 @@ foreign import ccall "wrapper"
  wrapItorCallback :: ItorCallback -> IO (FunPtr ItorCallback)

 foreign import ccall "pgf_iter_categories"
-  pgf_iter_categories :: Ptr PgfPGF -> Ptr PgfItor -> Ptr PgfExn -> IO ()
+  pgf_iter_categories :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfItor -> Ptr PgfExn -> IO ()

 foreign import ccall "pgf_start_cat"
-  pgf_start_cat :: Ptr PgfPGF -> Ptr PgfUnmarshaller -> IO (StablePtr Type)
+  pgf_start_cat :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfUnmarshaller -> IO (StablePtr Type)

 foreign import ccall "pgf/pgf.h pgf_category_context"
-  pgf_category_context :: Ptr PgfPGF -> Ptr PgfText -> Ptr CSize -> Ptr PgfUnmarshaller -> IO (Ptr PgfTypeHypo)
+  pgf_category_context :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> Ptr CSize -> Ptr PgfUnmarshaller -> IO (Ptr PgfTypeHypo)

 foreign import ccall "pgf/pgf.h pgf_category_prob"
-  pgf_category_prob :: Ptr PgfPGF -> Ptr PgfText -> IO (#type prob_t)
+  pgf_category_prob :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> IO (#type prob_t)

 foreign import ccall "pgf_iter_functions"
-  pgf_iter_functions :: Ptr PgfPGF -> Ptr PgfItor -> Ptr PgfExn -> IO ()
+  pgf_iter_functions :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfItor -> Ptr PgfExn -> IO ()

 foreign import ccall "pgf_iter_functions_by_cat"
-  pgf_iter_functions_by_cat :: Ptr PgfPGF -> Ptr PgfText -> Ptr PgfItor -> Ptr PgfExn -> IO ()
+  pgf_iter_functions_by_cat :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> Ptr PgfItor -> Ptr PgfExn -> IO ()

 foreign import ccall "pgf/pgf.h pgf_function_type"
-   pgf_function_type :: Ptr PgfPGF -> Ptr PgfText -> Ptr PgfUnmarshaller -> IO (StablePtr Type)
+   pgf_function_type :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> Ptr PgfUnmarshaller -> IO (StablePtr Type)

 foreign import ccall "pgf/expr.h pgf_function_is_constructor"
-   pgf_function_is_constructor :: Ptr PgfPGF -> Ptr PgfText -> IO (#type int)
+   pgf_function_is_constructor :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> IO (#type int)

-foreign import ccall "pgf/expr.h pgf_function_is_constructor"
-   pgf_function_prob :: Ptr PgfPGF -> Ptr PgfText -> IO (#type prob_t)
+foreign import ccall "pgf_function_prob"
+   pgf_function_prob :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> IO (#type prob_t)
+
+foreign import ccall "pgf_clone_revision"
+   pgf_clone_revision :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfExn -> IO (Ptr PgfRevision)

 foreign import ccall "pgf_create_function"
-   pgf_create_function :: Ptr PgfPGF -> Ptr PgfText -> StablePtr Type -> (#type prob_t) -> Ptr PgfMarshaller -> IO ()
+   pgf_create_function :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> StablePtr Type -> (#type prob_t) -> Ptr PgfMarshaller -> Ptr PgfExn -> IO ()


 -----------------------------------------------------------------------
--- a/src/runtime/haskell/PGF2/Transactions.hsc
+++ b/src/runtime/haskell/PGF2/Transactions.hsc
@@ -0,0 +1,55 @@
+module PGF2.Transactions
+          ( Transaction
+          , modifyPGF
+          , createFunction
+          ) where
+
+import PGF2.FFI
+import PGF2.Expr
+
+import Foreign
+import Foreign.C
+import qualified Foreign.Concurrent as C
+import Control.Exception(bracket)
+
+#include <pgf/pgf.h>
+
+newtype Transaction a =
+  Transaction (Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfExn -> IO a)
+
+instance Functor Transaction where
+  fmap f (Transaction g) = Transaction $ \c_db c_revision c_exn -> do
+    res <- g c_db c_revision c_exn
+    return (f res)
+
+instance Applicative Transaction where
+  pure x = Transaction $ \c_db c_revision c_exn -> return x
+
+instance Monad Transaction where
+  (Transaction f) >>= g = Transaction $ \c_db c_revision c_exn -> do
+    res <- f c_db c_revision c_exn
+    ex_type <- (#peek PgfExn, type) c_exn
+    if (ex_type :: (#type PgfExnType)) == (#const PGF_EXN_NONE)
+      then case g res of
+             Transaction g -> g c_db c_revision c_exn
+      else return undefined
+
+modifyPGF :: PGF -> Transaction a -> IO PGF
+modifyPGF p (Transaction f) =
+  withForeignPtr (a_db p) $ \c_db ->
+  withForeignPtr (revision p) $ \c_revision ->
+  withPgfExn "" $ \c_exn -> do
+    c_revision <- pgf_clone_revision c_db c_revision c_exn
+    ex_type <- (#peek PgfExn, type) c_exn
+    if (ex_type :: (#type PgfExnType)) == (#const PGF_EXN_NONE)
+      then do f c_db c_revision c_exn
+              fptr2 <- C.newForeignPtr c_revision (withForeignPtr (a_db p) (\c_db -> pgf_free_revision c_db c_revision))
+              return (PGF (a_db p) fptr2 (langs p))
+      else return p
+
+createFunction :: Fun -> Type -> Float -> Transaction ()
+createFunction name ty prob = Transaction $ \c_db c_revision c_exn ->
+  withText name $ \c_name ->
+  bracket (newStablePtr ty) freeStablePtr $ \c_ty ->
+  withForeignPtr marshaller $ \m -> do
+    pgf_create_function c_db c_revision c_name c_ty prob m c_exn
--- a/src/runtime/haskell/pgf2.cabal
+++ b/src/runtime/haskell/pgf2.cabal
@@ -22,6 +22,7 @@ extra-source-files:
 library
  exposed-modules:
    PGF2,
+    PGF2.Transactions,
    PGF2.Internal,
    -- backwards compatibility API:
    PGF
@@ -53,3 +54,12 @@ test-suite basic
    random,
    directory,
    pgf2
+
+test-suite transactions
+  type: exitcode-stdio-1.0
+  main-is: tests/transactions.hs
+  default-language: Haskell2010
+  build-depends:
+    base,
+    HUnit,
+    pgf2
--- a/src/runtime/haskell/tests/transactions.hs
+++ b/src/runtime/haskell/tests/transactions.hs
@@ -0,0 +1,18 @@
+import Test.HUnit
+import PGF2
+import PGF2.Transactions
+
+main = do
+  gr1 <- readPGF "tests/basic.pgf"
+  let Just ty = readType "(N -> N) -> P (s z)"
+  gr2 <- modifyPGF gr1 (createFunction "foo" ty pi)
+
+  runTestTTAndExit $
+    TestList $
+      [TestCase (assertEqual "original functions" ["c","ind","s","z"] (functions gr1))
+      ,TestCase (assertEqual "extended functions" ["c","foo","ind","s","z"] (functions gr2))
+      ,TestCase (assertEqual "old function type" Nothing   (functionType gr1 "foo"))
+      ,TestCase (assertEqual "new function type" (Just ty) (functionType gr2 "foo"))
+      ,TestCase (assertEqual "old function prob" (-log 0)  (functionProb gr1 "foo"))
+      ,TestCase (assertEqual "new function prob" pi        (functionProb gr2 "foo"))
+      ]
--- a/src/runtime/python/pypgf.c
+++ b/src/runtime/python/pypgf.c
@@ -15,7 +15,8 @@ static PyObject *PGFError;

 typedef struct {
    PyObject_HEAD
-    PgfPGF *pgf;
+    PgfDB *db;
+    PgfRevision revision;
 } PGFObject;

 // typedef struct IterObject {
@@ -1719,7 +1720,7 @@ typedef struct {
 static void
 PGF_dealloc(PGFObject* self)
 {
-    pgf_free(self->pgf);
+    pgf_free(self->db);
    Py_TYPE(self)->tp_free((PyObject*)self);
 }

@@ -1767,7 +1768,7 @@ PGF_repr(PGFObject *self)
 static PyObject*
 PGF_getAbstractName(PGFObject *self, void *closure)
 {
-    PgfText* txt = pgf_abstract_name(self->pgf);
+    PgfText* txt = pgf_abstract_name(self->db, self->revision);
    PyObject *name = PyString_FromStringAndSize(txt->text, txt->size);
    free(txt);
    return name;
@@ -1866,7 +1867,7 @@ PGF_getCategories(PGFObject *self, void *closure)

    PgfExn err;
    PyPGFClosure clo = { { pgf_collect_cats }, self, categories };
-    pgf_iter_categories(self->pgf, &clo.fn, &err);
+    pgf_iter_categories(self->db, self->revision, &clo.fn, &err);
    if (err.type != PGF_EXN_NONE) {
        Py_DECREF(categories);
        return NULL;
@@ -1878,7 +1879,7 @@ PGF_getCategories(PGFObject *self, void *closure)
 static TypeObject *
 PGF_getStartCat(PGFObject *self, void *closure)
 {
-    PgfType type = pgf_start_cat(self->pgf, &unmarshaller);
+    PgfType type = pgf_start_cat(self->db, self->revision, &unmarshaller);
    if (type == 0) {
        PyErr_SetString(PGFError, "start category cannot be found");
        return NULL;
@@ -1915,7 +1916,7 @@ PGF_getFunctions(PGFObject *self, void *closure)

    PgfExn err;
    PyPGFClosure clo = { { pgf_collect_funs }, self, functions };
-    pgf_iter_functions(self->pgf, &clo.fn, &err);
+    pgf_iter_functions(self->db, self->revision, &clo.fn, &err);
    if (err.type != PGF_EXN_NONE) {
        Py_DECREF(functions);
        return NULL;
@@ -1943,7 +1944,7 @@ PGF_functionsByCat(PGFObject *self, PyObject *args)

    PgfExn err;
    PyPGFClosure clo = { { pgf_collect_funs }, self, functions };
-    pgf_iter_functions_by_cat(self->pgf, catname, &clo.fn, &err);
+    pgf_iter_functions_by_cat(self->db, self->revision, catname, &clo.fn, &err);
    PyMem_Free(catname);
    if (err.type != PGF_EXN_NONE) {
        Py_DECREF(functions);
@@ -1965,7 +1966,7 @@ PGF_functionType(PGFObject *self, PyObject *args)
    memcpy(funname->text, s, size+1);
    funname->size = size;

-    PgfType type = pgf_function_type(self->pgf, funname, &unmarshaller);
+    PgfType type = pgf_function_type(self->db, self->revision, funname, &unmarshaller);
    PyMem_Free(funname);
    if (type == 0) {
        PyErr_Format(PyExc_KeyError, "function '%s' is not defined", s);
@@ -2387,7 +2388,7 @@ pgf_readPGF(PyObject *self, PyObject *args)

    // Read the PGF grammar.
    PgfExn err;
-    py_pgf->pgf = pgf_read_pgf(fpath, &err);
+    py_pgf->db = pgf_read_pgf(fpath, &py_pgf->revision, &err);
    if (err.type == PGF_EXN_SYSTEM_ERROR) {
        errno = err.code;
        PyErr_SetFromErrnoWithFilename(PyExc_IOError, fpath);
@@ -2415,7 +2416,7 @@ pgf_bootNGF(PyObject *self, PyObject *args)

    // Read the PGF grammar.
    PgfExn err;
-    py_pgf->pgf = pgf_boot_ngf(fpath, npath, &err);
+    py_pgf->db = pgf_boot_ngf(fpath, npath, &py_pgf->revision, &err);
    if (err.type == PGF_EXN_SYSTEM_ERROR) {
        errno = err.code;
        PyErr_SetFromErrnoWithFilename(PyExc_IOError, npath);
@@ -2442,7 +2443,7 @@ pgf_readNGF(PyObject *self, PyObject *args)

    // Read the NGF grammar.
    PgfExn err;
-    py_pgf->pgf = pgf_read_ngf(fpath, &err);
+    py_pgf->db = pgf_read_ngf(fpath, &py_pgf->revision, &err);
    if (err.type == PGF_EXN_SYSTEM_ERROR) {
        errno = err.code;
        PyErr_SetFromErrnoWithFilename(PyExc_IOError, fpath);