clean up everything after revision is not needed anymore.

src/runtime/c/Makefile.am

@@ -17,6 +17,7 @@ libpgf_la_SOURCES = \
 	pgf/reader.h \
 	pgf/printer.cxx \
 	pgf/printer.h \
+	pgf/data.cxx \
 	pgf/data.h \
 	pgf/expr.cxx \
 	pgf/expr.h \

src/runtime/c/pgf/data.cxx

@@ -0,0 +1,39 @@
+#include "data.h"
+
+void PgfFlag::release(ref<PgfFlag> flag)
+{
+    pgf_literal_free(flag->value);
+}
+
+void PgfAbsFun::release(ref<PgfAbsFun> absfun)
+{
+    pgf_type_free(absfun->type);
+
+    if (absfun->defns != 0) {
+        for (size_t i = 0; i < absfun->defns->len; i++) {
+            ref<PgfEquation> eq = *vector_elem(absfun->defns, i);
+            pgf_expr_free(eq->body);
+
+            for (size_t j = 0; j < eq->patts.len; j++) {
+                PgfPatt patt = *vector_elem(ref<PgfVector<PgfPatt>>::from_ptr(&eq->patts), j);
+                pgf_patt_free(patt);
+            }
+        }
+
+        PgfDB::free(absfun->defns);
+    }
+}
+
+void PgfAbsCat::release(ref<PgfAbsCat> abscat)
+{
+    pgf_context_free(abscat->context);
+}
+
+void PgfPGF::release(ref<PgfPGF> pgf)
+{
+    namespace_release(pgf->gflags);
+    PgfDB::free(pgf->abstract.name);
+    namespace_release(pgf->abstract.aflags);
+    namespace_release(pgf->abstract.funs);
+    namespace_release(pgf->abstract.cats);
+}

src/runtime/c/pgf/data.h

@@ -63,54 +63,11 @@ class PgfPGF;
 #include "expr.h"
 
 struct PGF_INTERNAL_DECL PgfFlag {
+    size_t ref_count;
     PgfLiteral value;
     PgfText name;
-};
 
-// PgfPatt
+    static void release(ref<PgfFlag> pgf);
-
-typedef object PgfPatt;
-
-struct PGF_INTERNAL_DECL PgfPattApp {
-    static const uint8_t tag = 0;
-
-	ref<PgfText> ctor;
-    PgfVector<PgfPatt> args;
-};
-
-struct PGF_INTERNAL_DECL PgfPattVar {
-    static const uint8_t tag = 1;
-
-	PgfText name;
-};
-
-struct PGF_INTERNAL_DECL PgfPattAs {
-    static const uint8_t tag = 2;
-
-	PgfPatt patt;
-	PgfText name;
-};
-
-struct PGF_INTERNAL_DECL PgfPattWild {
-    static const uint8_t tag = 3;
-};
-
-struct PGF_INTERNAL_DECL PgfPattLit {
-    static const uint8_t tag = 4;
-
-	PgfLiteral lit;
-};
-
-struct PGF_INTERNAL_DECL PgfPattImplArg {
-    static const uint8_t tag = 5;
-
-	PgfPatt patt;
-};
-
-struct PGF_INTERNAL_DECL PgfPattTilde {
-    static const uint8_t tag = 6;
-
-	PgfExpr expr;
 };
 
 typedef struct {
@@ -119,18 +76,26 @@ typedef struct {
 } PgfEquation;
 
 struct PGF_INTERNAL_DECL PgfAbsFun {
+    size_t ref_count;
+
     ref<PgfDTyp> type;
 	int arity;
     ref<PgfVector<ref<PgfEquation>>> defns;
     PgfExprProb ep;
     PgfText name;
+
+    static void release(ref<PgfAbsFun> cat);
 };
 
-typedef struct {
+struct PGF_INTERNAL_DECL PgfAbsCat {
+    size_t ref_count;
+
 	ref<PgfVector<PgfHypo>> context;
 	prob_t prob;
     PgfText name;
-} PgfAbsCat;
+
+    static void release(ref<PgfAbsCat> cat);
+};
 
 typedef struct {
 	ref<PgfText> name;
@@ -140,6 +105,8 @@ typedef struct {
 } PgfAbstr;
 
 struct PGF_INTERNAL_DECL PgfPGF {
+    size_t ref_count;
+
 	uint16_t major_version;
 	uint16_t minor_version;
 	Namespace<PgfFlag> gflags;
@@ -153,6 +120,8 @@ struct PGF_INTERNAL_DECL PgfPGF {
     // The name lets the user to find a particular revision in
     // the database.
     PgfText name;
+
+    static void release(ref<PgfPGF> pgf);
 };
 
 extern PGF_INTERNAL_DECL

src/runtime/c/pgf/db.cxx

@@ -5,9 +5,9 @@
 
 #include "data.h"
 
-PGF_INTERNAL __thread unsigned char* current_base __attribute__((tls_model("initial-exec"))) = NULL;
+PGF_INTERNAL unsigned char* current_base = NULL;
-PGF_INTERNAL __thread PgfDB* current_db __attribute__((tls_model("initial-exec"))) = NULL;
+PGF_INTERNAL PgfDB* current_db = NULL;
-PGF_INTERNAL __thread DB_scope *last_db_scope __attribute__((tls_model("initial-exec"))) = NULL;
+PGF_INTERNAL DB_scope *last_db_scope = NULL;
 
 #ifndef DEFAULT_TOP_PAD
 #define DEFAULT_TOP_PAD        (0)
@@ -369,6 +369,7 @@ ref<PgfPGF> PgfDB::get_revision(PgfText *name)
 PGF_INTERNAL
 void PgfDB::set_revision(ref<PgfPGF> pgf)
 {
+    pgf->ref_count++;
     Namespace<PgfPGF> nmsp = namespace_insert(current_db->ms->revisions, pgf);
     namespace_release(current_db->ms->revisions);
     current_db->ms->revisions = nmsp;
@@ -993,6 +994,13 @@ ref<PgfPGF> PgfDB::revision2pgf(PgfRevision revision)
     return pgf;
 }
 
+PGF_INTERNAL
+bool PgfDB::is_persistant_revision(ref<PgfPGF> pgf)
+{
+    return (pgf->prev == 0 && pgf->next == 0 &&
+            current_db->ms->transient_revisions != pgf);
+}
+
 PGF_INTERNAL
 void PgfDB::link_transient_revision(ref<PgfPGF> pgf)
 {
@@ -1003,7 +1011,7 @@ void PgfDB::link_transient_revision(ref<PgfPGF> pgf)
 }
 
 PGF_INTERNAL
-bool PgfDB::unlink_transient_revision(ref<PgfPGF> pgf)
+void PgfDB::unlink_transient_revision(ref<PgfPGF> pgf)
 {
     if (pgf->next != 0)
         pgf->next->prev = pgf->prev;
@@ -1011,10 +1019,6 @@ bool PgfDB::unlink_transient_revision(ref<PgfPGF> pgf)
         pgf->prev->next = pgf->next;
     else if (current_db->ms->transient_revisions == pgf)
         current_db->ms->transient_revisions = pgf->next;
-    else
-        return false;
-
-    return true;
 }
 
 DB_scope::DB_scope(PgfDB *db, DB_scope_mode tp)

src/runtime/c/pgf/db.h

@@ -5,8 +5,8 @@
 
 class PgfDB;
 
-extern PGF_INTERNAL_DECL __thread unsigned char* current_base __attribute__((tls_model("initial-exec")));
+extern PGF_INTERNAL_DECL unsigned char* current_base;
-extern PGF_INTERNAL_DECL __thread PgfDB*         current_db   __attribute__((tls_model("initial-exec")));
+extern PGF_INTERNAL_DECL PgfDB*         current_db;
 
 struct malloc_state;
 
@@ -75,14 +75,15 @@ public:
 
     template<class A>
     static void free(ref<A> o) {
-        return current_db->free_internal(o.as_object());
+        current_db->free_internal(o.as_object());
     }
 
     static PGF_INTERNAL_DECL ref<PgfPGF> get_revision(PgfText *name);
     static PGF_INTERNAL_DECL void set_revision(ref<PgfPGF> pgf);
     static PGF_INTERNAL_DECL ref<PgfPGF> revision2pgf(PgfRevision revision);
+    static PGF_INTERNAL_DECL bool is_persistant_revision(ref<PgfPGF> pgf);
     static PGF_INTERNAL_DECL void link_transient_revision(ref<PgfPGF> pgf);
-    static PGF_INTERNAL_DECL bool unlink_transient_revision(ref<PgfPGF> pgf);
+    static PGF_INTERNAL_DECL void unlink_transient_revision(ref<PgfPGF> pgf);
 
     PGF_INTERNAL_DECL static void sync();
 
@@ -92,11 +93,6 @@ private:
     PGF_INTERNAL_DECL object malloc_internal(size_t bytes);
     PGF_INTERNAL_DECL void free_internal(object o);
 
-    PGF_INTERNAL_DECL object get_root_internal();
-    PGF_INTERNAL_DECL void set_root_internal(object root_offset);
-
-    PGF_INTERNAL_DECL unsigned char* relocate(unsigned char* ptr);
-
     friend class DB_scope;
 };
 
@@ -112,6 +108,6 @@ private:
     DB_scope* next_scope;
 };
 
-extern PGF_INTERNAL_DECL thread_local DB_scope *last_db_scope;
+extern PGF_INTERNAL_DECL DB_scope *last_db_scope;
 
 #endif

src/runtime/c/pgf/expr.cxx

@@ -920,3 +920,153 @@ exit:
 
     return type;
 }
+
+
+PGF_INTERNAL
+void pgf_literal_free(PgfLiteral literal)
+{
+    switch (ref<PgfLiteral>::get_tag(literal)) {
+    case PgfLiteralInt::tag: {
+        PgfDB::free(ref<PgfLiteralInt>::untagged(literal));
+        break;
+    }
+    case PgfLiteralFlt::tag: {
+        PgfDB::free(ref<PgfLiteralFlt>::untagged(literal));
+        break;
+    }
+    case PgfLiteralStr::tag: {
+        PgfDB::free(ref<PgfLiteralStr>::untagged(literal));
+        break;
+    }
+	default:
+		throw pgf_error("Unknown literal tag");
+    }
+}
+
+PGF_INTERNAL
+void pgf_expr_free(PgfExpr expr)
+{
+    switch (ref<PgfExpr>::get_tag(expr)) {
+    case PgfExprAbs::tag: {
+        auto eabs = ref<PgfExprAbs>::untagged(expr);
+        pgf_expr_free(eabs->body);
+        PgfDB::free(eabs);
+        break;
+    }
+    case PgfExprApp::tag: {
+        auto eapp = ref<PgfExprApp>::untagged(expr);
+        pgf_expr_free(eapp->fun);
+        pgf_expr_free(eapp->arg);
+        PgfDB::free(eapp);
+        break;
+    }
+    case PgfExprLit::tag: {
+        auto elit = ref<PgfExprLit>::untagged(expr);
+        pgf_literal_free(elit->lit);
+        PgfDB::free(elit);
+        break;
+    }
+    case PgfExprMeta::tag: {
+        PgfDB::free(ref<PgfExprMeta>::untagged(expr));
+        break;
+    }
+	case PgfExprFun::tag: {
+        PgfDB::free(ref<PgfExprFun>::untagged(expr));
+        break;
+    }
+	case PgfExprVar::tag: {
+        PgfDB::free(ref<PgfExprVar>::untagged(expr));
+        break;
+	}
+	case PgfExprTyped::tag: {
+        auto etyped = ref<PgfExprTyped>::untagged(expr);
+        pgf_expr_free(etyped->expr);
+        pgf_type_free(etyped->type);
+        PgfDB::free(etyped);
+        break;
+	}
+	case PgfExprImplArg::tag: {
+        auto eimpl = ref<PgfExprImplArg>::untagged(expr);
+        pgf_expr_free(eimpl->expr);
+        PgfDB::free(eimpl);
+        break;
+	}
+	default:
+		throw pgf_error("Unknown expression tag");
+    }
+}
+
+PGF_INTERNAL
+void pgf_context_free(ref<PgfVector<PgfHypo>> hypos)
+{
+    for (size_t i = 0; i < hypos->len; i++) {
+        PgfDB::free(vector_elem(hypos, i)->cid);
+        pgf_type_free(vector_elem(hypos, i)->type);
+    }
+
+    PgfDB::free(hypos);
+}
+
+PGF_INTERNAL
+void pgf_type_free(ref<PgfDTyp> dtyp)
+{
+    pgf_context_free(dtyp->hypos);
+
+    for (size_t i = 0; i < dtyp->exprs->len; i++) {
+        pgf_expr_free(*vector_elem(dtyp->exprs, i));
+    }
+    PgfDB::free(dtyp->exprs);
+
+    PgfDB::free(dtyp);
+}
+
+PGF_INTERNAL
+void pgf_patt_free(PgfPatt patt)
+{
+    switch (ref<PgfPatt>::get_tag(patt)) {
+    case PgfPattApp::tag: {
+        auto papp = ref<PgfPattApp>::untagged(patt);
+        PgfDB::free(papp->ctor);
+        for (size_t i = 0; i < papp->args.len; i++) {
+            PgfPatt patt = *vector_elem(ref<PgfVector<PgfPatt>>::from_ptr(&papp->args), i);
+            pgf_patt_free(patt);
+        }
+        PgfDB::free(papp);
+        break;
+    }
+	case PgfPattVar::tag: {
+        PgfDB::free(ref<PgfPattVar>::untagged(patt));
+        break;
+	}
+	case PgfPattAs::tag: {
+        auto pas = ref<PgfPattAs>::untagged(patt);
+        pgf_patt_free(pas->patt);
+        PgfDB::free(pas);
+        break;
+	}
+	case PgfPattWild::tag: {
+        PgfDB::free(ref<PgfPattWild>::untagged(patt));
+        break;
+	}
+    case PgfPattLit::tag: {
+        auto plit = ref<PgfPattLit>::untagged(patt);
+        pgf_literal_free(plit->lit);
+        PgfDB::free(plit);
+        break;
+    }
+	case PgfPattImplArg::tag: {
+        auto pimpl = ref<PgfPattImplArg>::untagged(patt);
+        pgf_patt_free(pimpl->patt);
+        PgfDB::free(pimpl);
+        break;
+	}
+	case PgfPattTilde::tag: {
+        auto ptilde = ref<PgfPattTilde>::untagged(patt);
+        pgf_patt_free(ptilde->expr);
+        PgfDB::free(ptilde);
+        break;
+	}
+	default:
+		throw pgf_error("Unknown pattern tag");
+    }
+}

src/runtime/c/pgf/expr.h

@@ -87,6 +87,52 @@ struct PGF_INTERNAL_DECL PgfExprImplArg {
 	PgfExpr expr;
 };
 
+// PgfPatt
+
+typedef object PgfPatt;
+
+struct PGF_INTERNAL_DECL PgfPattApp {
+    static const uint8_t tag = 0;
+
+	ref<PgfText> ctor;
+    PgfVector<PgfPatt> args;
+};
+
+struct PGF_INTERNAL_DECL PgfPattVar {
+    static const uint8_t tag = 1;
+
+	PgfText name;
+};
+
+struct PGF_INTERNAL_DECL PgfPattAs {
+    static const uint8_t tag = 2;
+
+	PgfPatt patt;
+	PgfText name;
+};
+
+struct PGF_INTERNAL_DECL PgfPattWild {
+    static const uint8_t tag = 3;
+};
+
+struct PGF_INTERNAL_DECL PgfPattLit {
+    static const uint8_t tag = 4;
+
+	PgfLiteral lit;
+};
+
+struct PGF_INTERNAL_DECL PgfPattImplArg {
+    static const uint8_t tag = 5;
+
+	PgfPatt patt;
+};
+
+struct PGF_INTERNAL_DECL PgfPattTilde {
+    static const uint8_t tag = 6;
+
+	PgfExpr expr;
+};
+
 typedef float prob_t;
 
 typedef struct {
@@ -191,4 +237,23 @@ public:
 
 PGF_INTERNAL_DECL extern PgfText wildcard;
 
+/* The following functions release the memory in the database,
+ * allocated for values of the corresponding types.
+ */
+
+PGF_INTERNAL_DECL
+void pgf_literal_free(PgfLiteral literal);
+
+PGF_INTERNAL_DECL
+void pgf_expr_free(PgfExpr expr);
+
+PGF_INTERNAL_DECL
+void pgf_context_free(ref<PgfVector<PgfHypo>> hypos);
+
+PGF_INTERNAL_DECL
+void pgf_type_free(ref<PgfDTyp> dtyp);
+
+PGF_INTERNAL_DECL
+void pgf_patt_free(PgfPatt patt);
+
 #endif /* EXPR_H_ */

src/runtime/c/pgf/namespace.h

@@ -3,6 +3,19 @@
 
 #include "db.h"
 
+// #define DEBUG_NAMESPACE
+
+/* Namespace<V> expects that the class V contains:
+ *
+ * - A member 'size_t ref_count' which keeps track of the number of
+ * references to the particular object.
+ * - A member 'PgfText name' which contains the name of the object.
+ * - A method:
+ *      static void release(ref<V> object)
+ * which is executed when ref_count becomes zero. After that the memory
+ * for the object is released as well.
+ */
+
 template <class V>
 class Node;
 
@@ -29,6 +42,10 @@ public:
         node->value     = value;
         node->left      = 0;
         node->right     = 0;
+
+#ifdef DEBUG_NAMESPACE
+        printf("new     node %6ld %s\n", node.as_object(), node->value->name.text);
+#endif
         return node;
     }
 
@@ -41,21 +58,48 @@ public:
         node->value     = value;
         node->left      = left;
         node->right     = right;
+
+#ifdef DEBUG_NAMESPACE
+        printf("new     node %6ld %s(%ld,%ld)\n", node.as_object(), node->value->name.text, left.as_object(), right.as_object());
+#endif
         return node;
     }
 
+    static
+    void add_node_ref(ref<Node> node)
+    {
+        node->ref_count++;
+#ifdef DEBUG_NAMESPACE
+        printf("add_ref node %6ld %s (ref_count=%ld)\n", node.as_object(), node->value->name.text, node->ref_count);
+#endif
+    }
+
+    static
+    void add_value_ref(ref<V> value)
+    {
+        value->ref_count++;
+#ifdef DEBUG_NAMESPACE
+        printf("add_ref value %5ld %s (ref_count=%ld)\n", value.as_object(), value->name.text, value->ref_count);
+#endif
+    }
+
     static
     ref<Node> balanceL(ref<V> value, ref<Node> left, ref<Node> right)
     {
         if (right == 0) {
             if (left == 0) {
+                value->ref_count++;
                 return new_node(value);
             } else {
                 if (left->left == 0) {
                     if (left->right == 0) {
-                        left->ref_count++;
+                        add_value_ref(value);
+                        add_node_ref(left);
                         return new_node(value,left,0);
                     } else {
+                        add_value_ref(value);
+                        add_value_ref(left->value);
+                        add_value_ref(left->right->value);
                         Namespace<V> new_left  = new_node(left->value);
                         Namespace<V> new_right = new_node(value);
                         return new_node(left->right->value,
@@ -64,15 +108,19 @@ public:
                     }
                 } else {
                     if (left->right == 0) {
+                        add_value_ref(value);
                         Namespace<V> new_right = new_node(value);
-                        left->left->ref_count++;
+                        add_value_ref(left->value);
+                        add_node_ref(left->left);
                         return new_node(left->value,
                                         left->left,
                                         new_right);
                     } else {
                         if (left->right->sz < 2 * left->left->sz) {
-                            left->left->ref_count++;
+                            add_value_ref(value);
-                            left->right->ref_count++;
+                            add_value_ref(left->value);
+                            add_node_ref(left->left);
+                            add_node_ref(left->right);
                             Namespace<V> new_right =
                                 new_node(value,
                                          left->right,
@@ -81,11 +129,14 @@ public:
                                             left->left,
                                             new_right);
                         } else {
-                            left->left->ref_count++;
+                            add_value_ref(value);
+                            add_value_ref(left->value);
+                            add_value_ref(left->right->value);
+                            add_node_ref(left->left);
                             if (left->right->left != 0)
-                                left->right->left->ref_count++;
+                                add_node_ref(left->right->left);
                             if (left->right->right != 0)
-                                left->right->right->ref_count++;
+                                add_node_ref(left->right->right);
                             Namespace<V> new_left  =
                                 new_node(left->value,
                                          left->left,
@@ -103,14 +154,17 @@ public:
             }
         } else {
             if (left == 0) {
-                right->ref_count++;
+                add_value_ref(value);
+                add_node_ref(right);
                 return new_node(value,0,right);
             } else {
                 if (left->sz > 3*right->sz) {
                     if (left->right->sz < 2*left->left->sz) {
-                        left->left->ref_count++;
+                        add_value_ref(value);
-                        left->right->ref_count++;
+                        add_value_ref(left->value);
-                        right->ref_count++;
+                        add_node_ref(left->left);
+                        add_node_ref(left->right);
+                        add_node_ref(right);
                         Namespace<V> new_right =
                             new_node(value,
                                      left->right,
@@ -119,12 +173,15 @@ public:
                                         left->left,
                                         new_right);
                     } else {
-                        left->left->ref_count++;
+                        add_value_ref(value);
+                        add_value_ref(left->value);
+                        add_value_ref(left->right->value);
+                        add_node_ref(left->left);
                         if (left->right->left != 0)
-                            left->right->left->ref_count++;
+                            add_node_ref(left->right->left);
                         if (left->right->right != 0)
-                            left->right->right->ref_count++;
+                            add_node_ref(left->right->right);
-                        right->ref_count++;
+                        add_node_ref(right);
                         Namespace<V> new_left =
                             new_node(left->value,
                                      left->left,
@@ -138,8 +195,9 @@ public:
                                         new_right);
                     }
                 } else {
-                    left->ref_count++;
+                    add_value_ref(value);
-                    right->ref_count++;
+                    add_node_ref(left);
+                    add_node_ref(right);
                     return new_node(value,left,right);
                 }
             }
@@ -151,14 +209,18 @@ public:
     {
         if (left == 0) {
             if (right == 0) {
+                add_value_ref(value);
                 return new_node(value);
             } else {
                 if (right->left == 0) {
                     if (right->right == 0) {
-                        right->ref_count++;
+                        add_value_ref(value);
+                        add_node_ref(right);
                         return new_node(value,0,right);
                     } else {
-                        right->right->ref_count++;
+                        add_value_ref(value);
+                        add_value_ref(right->value);
+                        add_node_ref(right->right);
                         Namespace<V> new_left =
                             new_node(value);
                         return new_node(right->value,
@@ -167,6 +229,9 @@ public:
                     }
                 } else {
                     if (right->right == 0) {
+                        add_value_ref(value);
+                        add_value_ref(right->value);
+                        add_value_ref(right->left->value);
                         Namespace<V> new_left =
                             new_node(value);
                         Namespace<V> new_right =
@@ -176,8 +241,10 @@ public:
                                         new_right);
                     } else {
                         if (right->left->sz < 2 * right->right->sz) {
-                            right->left->ref_count++;
+                            add_value_ref(value);
-                            right->right->ref_count++;
+                            add_value_ref(right->value);
+                            add_node_ref(right->left);
+                            add_node_ref(right->right);
                             Namespace<V> new_left =
                                 new_node(value,
                                          0,
@@ -186,11 +253,14 @@ public:
                                             new_left,
                                             right->right);
                         } else {
+                            add_value_ref(value);
+                            add_value_ref(right->value);
+                            add_value_ref(right->left->value);
                             if (right->left->left != 0)
-                                right->left->left->ref_count++;
+                                add_node_ref(right->left->left);
                             if (right->left->right != 0)
-                                right->left->right->ref_count++;
+                                add_node_ref(right->left->right);
-                            right->right->ref_count++;
+                            add_node_ref(right->right);
                             Namespace<V> new_left =
                                 new_node(value,
                                          0,
@@ -208,14 +278,17 @@ public:
             }
         } else {
             if (right == 0) {
-                left->ref_count++;
+                add_value_ref(value);
+                add_node_ref(left);
                 return new_node(value,left,0);
             } else {
                 if (right->sz > 3*left->sz) {
                     if (right->left->sz < 2*right->right->sz) {
-                        left->ref_count++;
+                        add_value_ref(value);
-                        right->left->ref_count++;
+                        add_value_ref(right->value);
-                        right->right->ref_count++;
+                        add_node_ref(left);
+                        add_node_ref(right->left);
+                        add_node_ref(right->right);
                         Namespace<V> new_left =
                             new_node(value,
                                      left,
@@ -224,12 +297,15 @@ public:
                                         new_left,
                                         right->right);
                     } else {
-                        left->ref_count++;
+                        add_value_ref(value);
+                        add_value_ref(right->value);
+                        add_value_ref(right->left->value);
+                        add_node_ref(left);
                         if (right->left->left != 0)
-                            right->left->left->ref_count++;
+                            add_node_ref(right->left->left);
                         if (right->left->right != 0)
-                            right->left->right->ref_count++;
+                            add_node_ref(right->left->right);
-                        right->right->ref_count++;
+                        add_node_ref(right->right);
                         Namespace<V> new_left =
                             new_node(value,
                                      left,
@@ -243,8 +319,9 @@ public:
                                         new_right);
                     }
                 } else {
-                    left->ref_count++;
+                    add_value_ref(value);
-                    right->ref_count++;
+                    add_node_ref(left);
+                    add_node_ref(right);
                     return new_node(value,left,right);
                 }
             }
@@ -416,9 +493,23 @@ void namespace_release(Namespace<V> node)
     if (node == 0)
         return;
 
+#ifdef DEBUG_NAMESPACE
+    printf("release node %6ld %s (ref_count=%ld)\n", node.as_object(), node->value->name.text, node->ref_count-1);
+#endif
+
     if (!(--node->ref_count)) {
         namespace_release(node->left);
         namespace_release(node->right);
+
+#ifdef DEBUG_NAMESPACE
+        printf("release value %5ld %s (ref_count=%ld)\n", node->value.as_object(), node->value->name.text, node->value->ref_count-1);
+#endif
+
+        if (!(--node->value->ref_count)) {
+            V::release(node->value);
+            PgfDB::free(node->value);
+        }
+
         PgfDB::free(node);
     }
 }

src/runtime/c/pgf/pgf.cxx

@@ -116,9 +116,11 @@ PgfDB *pgf_read_ngf(const char *fpath,
         {
             DB_scope scope(db, WRITER_SCOPE);
 
-            if (PgfDB::get_revision(&master) == 0) {
+            ref<PgfPGF> pgf = PgfDB::get_revision(&master);
+            if (pgf == 0) {
                 is_new = true;
-                ref<PgfPGF> pgf = PgfDB::malloc<PgfPGF>(master.size+1);
+                pgf = PgfDB::malloc<PgfPGF>(master.size+1);
+                pgf->ref_count = 1;
                 pgf->major_version = 2;
                 pgf->minor_version = 0;
                 pgf->gflags = 0;
@@ -131,10 +133,10 @@ PgfDB *pgf_read_ngf(const char *fpath,
                 pgf->next = 0;
                 memcpy(&pgf->name, &master, sizeof(PgfText)+master.size+1);
                 PgfDB::set_revision(pgf);
-                *revision = pgf.as_object();
             } else {
-                *revision = PgfDB::get_revision(&master).as_object();
+                Node<PgfPGF>::add_value_ref(pgf);
             }
+            *revision = pgf.as_object();
         }
 
         return db;
@@ -159,15 +161,20 @@ PGF_API_DECL
 void pgf_free_revision(PgfDB *db, PgfRevision revision)
 {
     try {
-        DB_scope scope(db, READER_SCOPE);
+        DB_scope scope(db, WRITER_SCOPE);
         ref<PgfPGF> pgf = PgfDB::revision2pgf(revision);
 
-        if (PgfDB::unlink_transient_revision(pgf)) {
+        if (pgf->ref_count == 1 && PgfDB::is_persistant_revision(pgf)) {
-            namespace_release(pgf->gflags);
+            // Someone is trying to release the last reference count
-            PgfDB::free(pgf->abstract.name);
+            // to a persistant revision. Mostly likely this is an
-            namespace_release(pgf->abstract.aflags);
+            // error in the reference counting for one of the clients.
-            namespace_release(pgf->abstract.funs);
+            // The best that we can do is to ignore the request.
-            namespace_release(pgf->abstract.cats);
+            return;
+        }
+
+        if (!(--pgf->ref_count)) {
+            PgfDB::unlink_transient_revision(pgf);
+            PgfPGF::release(pgf);
             PgfDB::free(pgf);
         }
     } catch (std::runtime_error& e) {
@@ -461,26 +468,27 @@ PgfRevision pgf_clone_revision(PgfDB *db, PgfRevision revision,
             (name == NULL) ? pgf->name.size : name->size;
 
         ref<PgfPGF> new_pgf = PgfDB::malloc<PgfPGF>(name_size+1);
+        new_pgf->ref_count = 1;
         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++;
+            Node<PgfFlag>::add_node_ref(pgf->gflags);
 
         new_pgf->abstract.name = textdup_db(&(*pgf->abstract.name));
 
         new_pgf->abstract.aflags = pgf->abstract.aflags;
         if (pgf->abstract.aflags != 0)
-            pgf->abstract.aflags->ref_count++;
+            Node<PgfFlag>::add_node_ref(pgf->abstract.aflags);
 
         new_pgf->abstract.funs = pgf->abstract.funs;
         if (pgf->abstract.funs != 0)
-            pgf->abstract.funs->ref_count++;
+            Node<PgfAbsFun>::add_node_ref(pgf->abstract.funs);
 
         new_pgf->abstract.cats = pgf->abstract.cats;
         if (pgf->abstract.cats != 0)
-            pgf->abstract.cats->ref_count++;
+            Node<PgfAbsCat>::add_node_ref(pgf->abstract.cats);
 
         new_pgf->prev = 0;
         new_pgf->next = 0;
@@ -519,7 +527,9 @@ PgfRevision pgf_checkout_revision(PgfDB *db, PgfText *name,
 {
     PGF_API_BEGIN {
         DB_scope scope(db, WRITER_SCOPE);
-        return PgfDB::get_revision(name).as_object();
+        ref<PgfPGF> pgf = PgfDB::get_revision(name);
+        Node<PgfPGF>::add_value_ref(pgf);
+        return pgf.as_object();
     } PGF_API_END
 
     return 0;
@@ -539,6 +549,7 @@ void pgf_create_function(PgfDB *db, PgfRevision revision,
 
         ref<PgfPGF> pgf = PgfDB::revision2pgf(revision);
         ref<PgfAbsFun> absfun = PgfDB::malloc<PgfAbsFun>(name->size+1);
+        absfun->ref_count = 1;
         absfun->type  = m->match_type(&u, ty);
         absfun->arity = 0;
         absfun->defns = 0;
@@ -586,6 +597,7 @@ void pgf_create_category(PgfDB *db, PgfRevision revision,
 
         ref<PgfPGF> pgf = PgfDB::revision2pgf(revision);
         ref<PgfAbsCat> abscat = PgfDB::malloc<PgfAbsCat>(name->size+1);
+        abscat->ref_count = 1;
         abscat->context = vector_new<PgfHypo>(n_hypos);
         abscat->prob    = prob;
         memcpy(&abscat->name, name, sizeof(PgfText)+name->size+1);

src/runtime/c/pgf/reader.cxx

@@ -227,6 +227,7 @@ PgfLiteral PgfReader::read_literal()
 ref<PgfFlag> PgfReader::read_flag()
 {
     ref<PgfFlag> flag = read_name(&PgfFlag::name);
+    flag->ref_count = 1;
     flag->value = read_literal();
     return flag;
 }
@@ -380,6 +381,7 @@ ref<PgfAbsFun> PgfReader::read_absfun()
 {
     ref<PgfAbsFun> absfun =
         read_name<PgfAbsFun>(&PgfAbsFun::name);
+    absfun->ref_count = 1;
     ref<PgfExprFun> efun =
         ref<PgfExprFun>::from_ptr((PgfExprFun*) &absfun->name);
     absfun->ep.expr = ref<PgfExprFun>::tagged(efun);
@@ -405,6 +407,7 @@ ref<PgfAbsFun> PgfReader::read_absfun()
 ref<PgfAbsCat> PgfReader::read_abscat()
 {
     ref<PgfAbsCat> abscat = read_name<PgfAbsCat>(&PgfAbsCat::name);
+    abscat->ref_count = 1;
     abscat->context = read_vector<PgfHypo>(&PgfReader::read_hypo);
 
     // for now we just read the set of functions per category and ignore them
@@ -430,6 +433,7 @@ ref<PgfPGF> PgfReader::read_pgf()
 {
     ref<PgfPGF> pgf = PgfDB::malloc<PgfPGF>(master.size+1);
 
+    pgf->ref_count = 1;
     pgf->major_version = read_u16be();
     pgf->minor_version = read_u16be();
 

src/runtime/haskell/tests/transactions.hs

@@ -1,6 +1,8 @@
 import Test.HUnit
 import PGF2
 import PGF2.Transactions
+import System.Mem
+import System.Exit (exitSuccess, exitFailure)
 
 main = do
   gr1 <- readPGF "tests/basic.pgf"
@@ -16,7 +18,7 @@ main = do
 
   gr6 <- modifyPGF gr1 (dropFunction "ind" >> dropCategory "S")
 
-  runTestTTAndExit $
+  c <- runTestTT $
     TestList $
       [TestCase (assertEqual "original functions" ["c","ind","s","z"] (functions gr1))
       ,TestCase (assertEqual "extended functions" ["c","foo","ind","s","z"] (functions gr2))
@@ -35,3 +37,9 @@ main = do
       ,TestCase (assertEqual "old function prob" (-log 0)  (functionProb gr1 "foo"))
       ,TestCase (assertEqual "new function prob" pi        (functionProb gr2 "foo"))
       ]
+  
+  performMajorGC
+
+  if (errors c == 0) && (failures c == 0)
+    then exitSuccess
+    else exitFailure