API for adding concrete syntaxes. Garbage collection to be fixed!

2026-05-21 09:02:50 -06:00 · 2021-10-21 19:18:14 +02:00
parent 259ed52a77
commit 1413c273cc
15 changed files with 529 additions and 197 deletions
--- a/src/runtime/c/pgf/data.cxx
+++ b/src/runtime/c/pgf/data.cxx
@@ -36,4 +36,10 @@ void PgfPGF::release(ref<PgfPGF> pgf)
    namespace_release(pgf->abstract.aflags);
    namespace_release(pgf->abstract.funs);
    namespace_release(pgf->abstract.cats);
+    namespace_release(pgf->concretes);
+}
+
+void PgfConcr::release(ref<PgfConcr> concr)
+{
+    namespace_release(concr->cflags);
 }
--- a/src/runtime/c/pgf/data.h
+++ b/src/runtime/c/pgf/data.h
@@ -54,6 +54,7 @@ private:
 };

 class PgfPGF;
+class PgfConcr;

 #include "db.h"
 #include "text.h"
@@ -103,6 +104,14 @@ typedef struct {
    Namespace<PgfAbsCat> cats;
 } PgfAbstr;

+struct PGF_INTERNAL_DECL PgfConcr {
+    size_t ref_count;
+	Namespace<PgfFlag> cflags;
+    PgfText name;
+
+    static void release(ref<PgfConcr> pgf);
+};
+
 struct PGF_INTERNAL_DECL PgfPGF {
    size_t ref_count;

@@ -110,7 +119,7 @@ struct PGF_INTERNAL_DECL PgfPGF {
 	uint16_t minor_version;
 	Namespace<PgfFlag> gflags;
 	PgfAbstr abstract;
-	//PgfConcrs* concretes;
+    Namespace<PgfConcr> concretes;

    // If the revision is transient, then it is in a double-linked list
    // with all other transient revisions.
--- a/src/runtime/c/pgf/db.cxx
+++ b/src/runtime/c/pgf/db.cxx
@@ -1043,6 +1043,23 @@ ref<PgfPGF> PgfDB::revision2pgf(PgfRevision revision)
    return pgf;
 }

+PGF_INTERNAL
+ref<PgfConcr> PgfDB::revision2concr(PgfConcrRevision revision)
+{
+    if (revision <= sizeof(*current_db->ms) || revision >= current_db->ms->top)
+        throw pgf_error("Invalid revision");
+
+    mchunk *chunk = mem2chunk(ptr(current_db->ms,revision));
+    if (chunksize(chunk) < sizeof(PgfConcr))
+        throw pgf_error("Invalid revision");
+
+    ref<PgfConcr> concr = revision;
+    if (chunksize(chunk) != request2size(sizeof(PgfConcr)+concr->name.size+1))
+        throw pgf_error("Invalid revision");
+
+    return concr;
+}
+
 PGF_INTERNAL
 bool PgfDB::is_persistant_revision(ref<PgfPGF> pgf)
 {
--- a/src/runtime/c/pgf/db.h
+++ b/src/runtime/c/pgf/db.h
@@ -85,6 +85,7 @@ public:
    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 ref<PgfConcr> revision2concr(PgfConcrRevision 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 void unlink_transient_revision(ref<PgfPGF> pgf);
--- a/src/runtime/c/pgf/namespace.h
+++ b/src/runtime/c/pgf/namespace.h
@@ -480,7 +480,7 @@ void namespace_iter(Namespace<V> map, PgfItor* itor, PgfExn *err)
    if (err->type != PGF_EXN_NONE)
        return;

-    itor->fn(itor, &map->value->name, &(*map->value), err);
+    itor->fn(itor, &map->value->name, map->value.as_object(), err);
    if (err->type != PGF_EXN_NONE)
        return;

--- a/src/runtime/c/pgf/pgf.cxx
+++ b/src/runtime/c/pgf/pgf.cxx
@@ -175,6 +175,7 @@ PgfDB *pgf_new_ngf(PgfText *abstract_name,
            pgf->abstract.aflags = 0;
            pgf->abstract.funs = 0;
            pgf->abstract.cats = 0;
+            pgf->concretes = 0;
            pgf->prev = 0;
            pgf->next = 0;
            pgf->name.size = master_size;
@@ -255,6 +256,36 @@ void pgf_free_revision(PgfDB *db, PgfRevision revision)
        delete db;
 }

+PGF_API_DECL
+void pgf_free_concr_revision(PgfDB *db, PgfConcrRevision revision)
+{
+/*    try {
+        DB_scope scope(db, WRITER_SCOPE);
+        ref<PgfPGF> pgf = PgfDB::revision2pgf(revision);
+
+        if (pgf->ref_count == 1 && PgfDB::is_persistant_revision(pgf)) {
+            // Someone is trying to release the last reference count
+            // to a persistant revision. Mostly likely this is an
+            // error in the reference counting for one of the clients.
+            // The best that we can do is to ignore the request.
+            return;
+        }
+
+        if (!(--pgf->ref_count)) {
+            PgfDB::unlink_transient_revision(pgf);
+            PgfPGF::release(pgf);
+            PgfDB::free(pgf);
+        }
+
+        db->ref_count--;
+    } catch (std::runtime_error& e) {
+        // silently ignore and hope for the best
+    }
+
+    if (!db->ref_count)
+        delete db;*/
+}
+
 PGF_API
 PgfText *pgf_abstract_name(PgfDB *db, PgfRevision revision,
                           PgfExn *err)
@@ -281,6 +312,18 @@ void pgf_iter_categories(PgfDB *db, PgfRevision revision,
    } PGF_API_END
 }

+PGF_API
+void pgf_iter_concretes(PgfDB *db, PgfRevision revision,
+                        PgfItor *itor, PgfExn *err)
+{
+    PGF_API_BEGIN {
+        DB_scope scope(db, READER_SCOPE);
+        ref<PgfPGF> pgf = PgfDB::revision2pgf(revision);
+
+        namespace_iter(pgf->concretes, itor, err);
+    } PGF_API_END
+}
+
 PGF_API
 PgfType pgf_start_cat(PgfDB *db, PgfRevision revision,
                      PgfUnmarshaller *u,
@@ -397,11 +440,11 @@ struct PgfItorHelper : PgfItor
 };

 static
-void iter_by_cat_helper(PgfItor *itor, PgfText *key, void *value,
+void iter_by_cat_helper(PgfItor *itor, PgfText *key, object value,
 		                PgfExn *err)
 {
    PgfItorHelper* helper = (PgfItorHelper*) itor;
-    PgfAbsFun* absfun = (PgfAbsFun*) value;
+    ref<PgfAbsFun> absfun = value;
    if (textcmp(helper->cat, &absfun->type->name) == 0)
        helper->itor->fn(helper->itor, key, value, err);
 }
@@ -483,6 +526,46 @@ prob_t pgf_function_prob(PgfDB *db, PgfRevision revision,
    return INFINITY;
 }

+PGF_API
+PgfText *pgf_concrete_name(PgfDB *db, PgfConcrRevision revision,
+                           PgfExn *err)
+{
+    PGF_API_BEGIN {
+        DB_scope scope(db, READER_SCOPE);
+        ref<PgfConcr> concr = PgfDB::revision2concr(revision);
+
+        return textdup(&concr->name);
+    } PGF_API_END
+
+    return NULL;
+}
+
+PGF_API
+PgfText *pgf_concrete_language_code(PgfDB *db, PgfConcrRevision revision,
+                                    PgfExn *err)
+{
+    PGF_API_BEGIN {
+        DB_scope scope(db, READER_SCOPE);
+
+        ref<PgfConcr> concr = PgfDB::revision2concr(revision);
+
+        size_t size = strlen("language");
+        PgfText *language = (PgfText *) alloca(sizeof(PgfText)+size+1);
+        language->size = size;
+        strcpy((char*) &language->text, "language");
+
+        ref<PgfFlag> flag =
+            namespace_lookup(concr->cflags, language);
+        if (flag != 0 &&
+            ref<PgfLiteral>::get_tag(flag->value) == PgfLiteralStr::tag) {
+            ref<PgfLiteralStr> lstr = ref<PgfLiteralStr>::untagged(flag->value);
+            return textdup(&lstr->val);
+        }
+    } PGF_API_END
+
+    return NULL;
+}
+
 PGF_API
 PgfText *pgf_print_expr(PgfExpr e,
                        PgfPrintContext *ctxt, int prio,
@@ -604,6 +687,10 @@ PgfRevision pgf_clone_revision(PgfDB *db, PgfRevision revision,
        if (pgf->abstract.cats != 0)
            Node<PgfAbsCat>::add_node_ref(pgf->abstract.cats);

+        new_pgf->concretes = pgf->concretes;
+        if (pgf->concretes != 0)
+            Node<PgfConcr>::add_node_ref(pgf->concretes);
+
        new_pgf->prev = 0;
        new_pgf->next = 0;
        PgfDB::link_transient_revision(new_pgf);
@@ -752,6 +839,81 @@ void pgf_drop_category(PgfDB *db, PgfRevision revision,
    } PGF_API_END
 }

+PGF_API
+PgfConcrRevision pgf_create_concrete(PgfDB *db, PgfRevision revision,
+                                     PgfText *name,
+                                     PgfExn *err)
+{
+    PGF_API_BEGIN {
+        DB_scope scope(db, WRITER_SCOPE);
+
+        ref<PgfPGF> pgf = PgfDB::revision2pgf(revision);
+
+        ref<PgfConcr> concr =
+            namespace_lookup(pgf->concretes, name);
+        if (concr != 0)
+            throw pgf_error("The concrete syntax already exists");
+
+        concr = PgfDB::malloc<PgfConcr>(name->size+1);
+        concr->ref_count = 1;
+        concr->cflags = 0;
+        memcpy(&concr->name, name, sizeof(PgfText)+name->size+1);
+
+        Namespace<PgfConcr> concrs =
+            namespace_insert(pgf->concretes, concr);
+        namespace_release(pgf->concretes);
+        pgf->concretes = concrs;
+        return concr.as_object();
+    } PGF_API_END
+    return 0;
+}
+
+PGF_API
+PgfConcrRevision pgf_clone_concrete(PgfDB *db, PgfRevision revision,
+                                    PgfText *name,
+                                    PgfExn *err)
+{
+    PGF_API_BEGIN {
+        DB_scope scope(db, WRITER_SCOPE);
+
+        ref<PgfPGF> pgf = PgfDB::revision2pgf(revision);
+        
+        ref<PgfConcr> concr =
+            namespace_lookup(pgf->concretes, name);
+        if (concr == 0)
+            throw pgf_error("Unknown concrete syntax");
+
+        ref<PgfConcr> clone = PgfDB::malloc<PgfConcr>(name->size+1);
+        clone->ref_count = 1;
+        clone->cflags = concr->cflags;
+        memcpy(&clone->name, name, sizeof(PgfText)+name->size+1);
+
+        Namespace<PgfConcr> concrs =
+            namespace_insert(pgf->concretes, clone);
+        namespace_release(pgf->concretes);
+        pgf->concretes = concrs;
+        return clone.as_object();
+    } PGF_API_END
+    return 0;
+}
+
+PGF_API
+void pgf_drop_concrete(PgfDB *db, PgfRevision revision,
+                       PgfText *name,
+                       PgfExn *err)
+{
+    PGF_API_BEGIN {
+        DB_scope scope(db, WRITER_SCOPE);
+
+        ref<PgfPGF> pgf = PgfDB::revision2pgf(revision);
+
+        Namespace<PgfConcr> concrs =
+            namespace_delete(pgf->concretes, name);
+        namespace_release(pgf->concretes);
+        pgf->concretes = concrs;
+    } PGF_API_END
+}
+
 PGF_API
 PgfLiteral pgf_get_global_flag(PgfDB *db, PgfRevision revision,
                               PgfText *name,
@@ -843,3 +1005,49 @@ void pgf_set_abstract_flag(PgfDB *db, PgfRevision revision,
        pgf->abstract.aflags = aflags;
    } PGF_API_END
 }
+
+PGF_API
+PgfLiteral pgf_get_concrete_flag(PgfDB *db, PgfConcrRevision revision,
+                                 PgfText *name,
+                                 PgfUnmarshaller *u,
+                                 PgfExn *err)
+{
+    PGF_API_BEGIN {
+        DB_scope scope(db, READER_SCOPE);
+
+        ref<PgfConcr> concr = PgfDB::revision2concr(revision);
+
+        ref<PgfFlag> flag =
+            namespace_lookup(concr->cflags, name);
+        if (flag != 0) {
+            return PgfDBMarshaller().match_lit(u, flag->value);
+        }
+    } PGF_API_END
+
+    return 0;
+}
+
+PGF_API
+void pgf_set_concrete_flag(PgfDB *db, PgfConcrRevision revision,
+                           PgfText *name,
+                           PgfLiteral value,
+                           PgfMarshaller *m,
+                           PgfExn *err)
+{
+    PGF_API_BEGIN {
+        DB_scope scope(db, WRITER_SCOPE);
+
+        PgfDBUnmarshaller u(m);
+
+        ref<PgfConcr> concr = PgfDB::revision2concr(revision);
+
+        ref<PgfFlag> flag = PgfDB::malloc<PgfFlag>(name->size+1);
+        flag->ref_count = 1;
+        memcpy(&flag->name, name, sizeof(PgfText)+name->size+1);
+        flag->value = m->match_lit(&u, value);
+        Namespace<PgfFlag> cflags =
+            namespace_insert(concr->cflags, flag);
+        namespace_release(concr->cflags);
+        concr->cflags = cflags;
+    } PGF_API_END
+}
--- a/src/runtime/c/pgf/pgf.h
+++ b/src/runtime/c/pgf/pgf.h
@@ -85,16 +85,16 @@ typedef struct {
    const char *msg;
 } PgfExn;

+typedef uintptr_t object;
+
 /* A generic structure to pass a callback for iteration over a collection */
 typedef struct PgfItor PgfItor;

 struct PgfItor {
-	void (*fn)(PgfItor* self, PgfText* key, void *value,
+	void (*fn)(PgfItor* self, PgfText* key, object value,
 		       PgfExn *err);
 };

-typedef uintptr_t object;
-
 /// An abstract syntax tree
 typedef object PgfExpr;

@@ -219,6 +219,7 @@ typedef float prob_t;

 typedef struct PgfDB PgfDB;
 typedef object PgfRevision;
+typedef object PgfConcrRevision;

 /* Reads a PGF file and builds the database in memory.
 * If successful, *revision will contain the initial revision of
@@ -264,6 +265,9 @@ void pgf_write_pgf(const char* fpath,
 PGF_API_DECL
 void pgf_free_revision(PgfDB *pgf, PgfRevision revision);

+PGF_API_DECL
+void pgf_free_concr_revision(PgfDB *db, PgfConcrRevision revision);
+
 /* Returns a newly allocated text which contains the abstract name of
 * the grammar. The text must be released with a call to free.
 */
@@ -275,6 +279,10 @@ PGF_API_DECL
 void pgf_iter_categories(PgfDB *db, PgfRevision revision,
                         PgfItor *itor, PgfExn *err);

+PGF_API
+void pgf_iter_concretes(PgfDB *db, PgfRevision revision,
+                        PgfItor *itor, PgfExn *err);
+
 PGF_API_DECL
 PgfType pgf_start_cat(PgfDB *db, PgfRevision revision,
                      PgfUnmarshaller *u,
@@ -313,6 +321,14 @@ prob_t pgf_function_prob(PgfDB *db, PgfRevision revision,
                         PgfText *funname,
                         PgfExn* err);

+PGF_API_DECL
+PgfText *pgf_concrete_name(PgfDB *db, PgfConcrRevision revision,
+                           PgfExn* err);
+
+PGF_API_DECL
+PgfText *pgf_concrete_language_code(PgfDB *db, PgfConcrRevision revision,
+                                    PgfExn* err);
+
 typedef struct PgfPrintContext PgfPrintContext;

 struct PgfPrintContext {
@@ -387,6 +403,21 @@ void pgf_drop_category(PgfDB *db, PgfRevision revision,
                       PgfText *name,
                       PgfExn *err);

+PGF_API_DECL
+PgfConcrRevision pgf_create_concrete(PgfDB *db, PgfRevision revision,
+                                     PgfText *name,
+                                     PgfExn *err);
+
+PGF_API_DECL
+PgfConcrRevision pgf_clone_concrete(PgfDB *db, PgfRevision revision,
+                                    PgfText *name,
+                                    PgfExn *err);
+
+PGF_API_DECL
+void pgf_drop_concrete(PgfDB *db, PgfRevision revision,
+                       PgfText *name,
+                       PgfExn *err);
+
 PGF_API_DECL
 PgfLiteral pgf_get_global_flag(PgfDB *db, PgfRevision revision,
                               PgfText *name,
@@ -409,5 +440,16 @@ void pgf_set_abstract_flag(PgfDB *db, PgfRevision revision,
                           PgfLiteral value,
                           PgfMarshaller *m,
                           PgfExn *err);
+PGF_API_DECL
+PgfLiteral pgf_get_concrete_flag(PgfDB *db, PgfConcrRevision revision,
+                                 PgfText *name,
+                                 PgfUnmarshaller *u,
+                                 PgfExn *err);
+PGF_API_DECL
+void pgf_set_concrete_flag(PgfDB *db, PgfConcrRevision revision,
+                           PgfText *name,
+                           PgfLiteral value,
+                           PgfMarshaller *m,
+                           PgfExn *err);

 #endif // PGF_H_
--- a/src/runtime/c/pgf/reader.cxx
+++ b/src/runtime/c/pgf/reader.cxx
@@ -203,10 +203,13 @@ PgfLiteral PgfReader::read_literal()
 		break;
 	}
 	case PgfLiteralInt::tag: {
+        size_t size = read_len();
 		ref<PgfLiteralInt> lit_int =
-			PgfDB::malloc<PgfLiteralInt>(sizeof(uintmax_t));
-        lit_int->size   = 1;
-		lit_int->val[0] = read_int();
+			PgfDB::malloc<PgfLiteralInt>(sizeof(uintmax_t)*size);
+        lit_int->size   = size;
+        for (size_t i = 0; i < size; i++) {
+            lit_int->val[i] = (uintmax_t) read_uint();
+        }
        lit = ref<PgfLiteralInt>::tagged(lit_int);
 		break;
 	}
@@ -428,6 +431,14 @@ void PgfReader::read_abstract(ref<PgfAbstr> abstract)
    abstract->cats = read_namespace<PgfAbsCat>(&PgfReader::read_abscat);
 }

+ref<PgfConcr> PgfReader::read_concrete()
+{
+    ref<PgfConcr> concr = read_name(&PgfConcr::name);
+    concr->ref_count = 1;
+	concr->cflags = read_namespace<PgfFlag>(&PgfReader::read_flag);
+    return concr;
+}
+
 ref<PgfPGF> PgfReader::read_pgf()
 {
    ref<PgfPGF> pgf = PgfDB::malloc<PgfPGF>(master_size+1);
@@ -445,6 +456,8 @@ ref<PgfPGF> PgfReader::read_pgf()

    read_abstract(ref<PgfAbstr>::from_ptr(&pgf->abstract));

+    pgf->concretes = read_namespace<PgfConcr>(&PgfReader::read_concrete);
+
    pgf->prev = 0;
    pgf->next = 0;

--- a/src/runtime/c/pgf/reader.h
+++ b/src/runtime/c/pgf/reader.h
@@ -68,6 +68,8 @@ public:
    ref<PgfAbsCat> read_abscat();
    void read_abstract(ref<PgfAbstr> abstract);

+    ref<PgfConcr> read_concrete();
+
    ref<PgfPGF> read_pgf();

 private:
--- a/src/runtime/c/pgf/writer.cxx
+++ b/src/runtime/c/pgf/writer.cxx
@@ -385,6 +385,12 @@ void PgfWriter::write_abstract(ref<PgfAbstr> abstract)
    this->abstract = 0;
 }

+void PgfWriter::write_concrete(ref<PgfConcr> concr)
+{
+    write_name(&concr->name);
+    write_namespace<PgfFlag>(concr->cflags, &PgfWriter::write_flag);
+}
+
 void PgfWriter::write_pgf(ref<PgfPGF> pgf)
 {
    write_u16be(pgf->major_version);
@@ -393,4 +399,5 @@ void PgfWriter::write_pgf(ref<PgfPGF> pgf)
    write_namespace<PgfFlag>(pgf->gflags, &PgfWriter::write_flag);

    write_abstract(ref<PgfAbstr>::from_ptr(&pgf->abstract));
+    write_namespace<PgfConcr>(pgf->concretes, &PgfWriter::write_concrete);
 }
--- a/src/runtime/c/pgf/writer.h
+++ b/src/runtime/c/pgf/writer.h
@@ -42,6 +42,8 @@ public:
    void write_abscat(ref<PgfAbsCat> abscat);
    void write_abstract(ref<PgfAbstr> abstract);

+    void write_concrete(ref<PgfConcr> concr);
+
    void write_pgf(ref<PgfPGF> pgf);

 private:
--- a/src/runtime/haskell/PGF2.hsc
+++ b/src/runtime/haskell/PGF2.hsc
@@ -67,7 +67,7 @@ module PGF2 (-- * PGF
             graphvizWordAlignment,

             -- * Concrete syntax
-             ConcName,Concr,languages,concreteName,languageCode,
+             ConcName,Concr,languages,concreteName,languageCode,concreteFlag,

             -- ** Linearization
             linearize, linearizeAll, tabularLinearize, tabularLinearizeAll,
@@ -115,7 +115,8 @@ readPGF fpath =
    c_db <- withPgfExn "readPGF" (pgf_read_pgf c_fpath p_revision)
    c_revision <- peek p_revision
    fptr <- C.newForeignPtr c_revision (pgf_free_revision c_db c_revision)
-    return (PGF c_db fptr Map.empty)
+    langs <- getConcretes c_db fptr
+    return (PGF c_db fptr langs)

 -- | 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.
@@ -130,7 +131,8 @@ bootNGF pgf_path ngf_path =
    c_db <- withPgfExn "bootNGF" (pgf_boot_ngf c_pgf_path c_ngf_path p_revision)
    c_revision <- peek p_revision
    fptr <- C.newForeignPtr c_revision (pgf_free_revision c_db c_revision)
-    return (PGF c_db fptr Map.empty)
+    langs <- getConcretes c_db fptr
+    return (PGF c_db fptr langs)

 -- | Reads the grammar from an already booted NGF file.
 -- The function fails if the file does not exist.
@@ -142,7 +144,8 @@ readNGF fpath =
    c_db <- withPgfExn "readNGF" (pgf_read_ngf c_fpath p_revision)
    c_revision <- peek p_revision
    fptr <- C.newForeignPtr c_revision (pgf_free_revision c_db c_revision)
-    return (PGF c_db fptr Map.empty)
+    langs <- getConcretes c_db fptr
+    return (PGF c_db fptr langs)

 -- | Creates a new NGF file with a grammar with the given abstract_name.
 -- Aside from the name, the grammar is otherwise empty but can be later
@@ -162,7 +165,7 @@ newNGF abs_name mb_fpath =
 writePGF :: FilePath -> PGF -> IO ()
 writePGF fpath p =
  withCString fpath $ \c_fpath ->
-  withForeignPtr (revision p) $ \c_revision ->
+  withForeignPtr (a_revision p) $ \c_revision ->
    withPgfExn "writePGF" (pgf_write_pgf c_fpath (a_db p) c_revision)

 showPGF :: PGF -> String
@@ -173,7 +176,7 @@ showPGF = error "TODO: showPGF"
 abstractName :: PGF -> AbsName
 abstractName p =
  unsafePerformIO $
-  withForeignPtr (revision p) $ \c_revision ->
+  withForeignPtr (a_revision p) $ \c_revision ->
  bracket (withPgfExn "abstractName" (pgf_abstract_name (a_db p) c_revision)) free $ \c_text ->
    peekText c_text

@@ -186,7 +189,7 @@ startCat :: PGF -> Type
 startCat p =
  unsafePerformIO $
  withForeignPtr unmarshaller $ \u ->
-  withForeignPtr (revision p) $ \c_revision -> do
+  withForeignPtr (a_revision p) $ \c_revision -> do
    c_typ <- withPgfExn "startCat" (pgf_start_cat (a_db p) c_revision u)
    typ <- deRefStablePtr c_typ
    freeStablePtr c_typ
@@ -197,7 +200,7 @@ functionType :: PGF -> Fun -> Maybe Type
 functionType p fn =
  unsafePerformIO $
  withForeignPtr unmarshaller $ \u ->
-  withForeignPtr (revision p) $ \c_revision ->
+  withForeignPtr (a_revision p) $ \c_revision ->
  withText fn $ \c_fn -> do
    c_typ <- withPgfExn "functionType" (pgf_function_type (a_db p) c_revision c_fn u)
    if c_typ == castPtrToStablePtr nullPtr
@@ -210,7 +213,7 @@ functionIsConstructor :: PGF -> Fun -> Bool
 functionIsConstructor p fun =
  unsafePerformIO $
  withText fun $ \c_fun ->
-  withForeignPtr (revision p) $ \c_revision ->
+  withForeignPtr (a_revision p) $ \c_revision ->
      do res <- withPgfExn "functionIsConstructor" (pgf_function_is_constructor (a_db p) c_revision c_fun)
         return (res /= 0)

@@ -218,13 +221,13 @@ functionProbability :: PGF -> Fun -> Float
 functionProbability p fun =
  unsafePerformIO $
  withText fun $ \c_fun ->
-  withForeignPtr (revision p) $ \c_revision ->
+  withForeignPtr (a_revision p) $ \c_revision ->
      withPgfExn "functionProbability" (pgf_function_prob (a_db p) c_revision c_fun)

 exprProbability :: PGF -> Expr -> Float
 exprProbability p e =
  unsafePerformIO $
-  withForeignPtr (revision p) $ \c_revision ->
+  withForeignPtr (a_revision p) $ \c_revision ->
  bracket (newStablePtr e) freeStablePtr $ \c_e ->
  withForeignPtr marshaller $ \m ->
    withPgfExn "exprProbability" (pgf_expr_prob (a_db p) c_revision c_e m)
@@ -248,10 +251,33 @@ compute :: PGF -> Expr -> Expr
 compute = error "TODO: compute"

 concreteName :: Concr -> ConcName
-concreteName c = error "TODO: concreteName"
+concreteName c =
+  unsafePerformIO $
+  withForeignPtr (c_revision c) $ \c_revision ->
+  bracket (withPgfExn "concreteName" (pgf_concrete_name (c_db c) c_revision)) free $ \c_text ->
+    peekText c_text

 languageCode :: Concr -> Maybe String
-languageCode c = error "TODO: languageCode"
+languageCode c =
+  unsafePerformIO $
+  withForeignPtr (c_revision c) $ \c_revision ->
+  bracket (withPgfExn "languageCode" (pgf_concrete_language_code (c_db c) c_revision)) free $ \c_text ->
+    if c_text == nullPtr
+      then return Nothing
+      else fmap Just (peekText c_text)
+
+concreteFlag :: Concr -> String -> Maybe Literal
+concreteFlag c name =
+  unsafePerformIO $
+  withText name $ \c_name ->
+  withForeignPtr (c_revision c) $ \c_revision ->
+  withForeignPtr unmarshaller $ \u -> do
+    c_lit <- withPgfExn "concreteFlag" (pgf_get_concrete_flag (c_db c) c_revision c_name u)
+    if c_lit == castPtrToStablePtr nullPtr
+      then return Nothing
+      else do lit <- deRefStablePtr c_lit
+              freeStablePtr c_lit
+              return (Just lit)

 printName :: Concr -> Fun -> Maybe String
 printName lang fun = error "TODO: printName"
@@ -492,14 +518,14 @@ categories p =
    ref <- newIORef []
    (allocaBytes (#size PgfItor) $ \itor ->
     bracket (wrapItorCallback (getCategories ref)) freeHaskellFunPtr $ \fptr ->
-     withForeignPtr (revision p) $ \c_revision -> do
+     withForeignPtr (a_revision p) $ \c_revision -> do
      (#poke PgfItor, fn) itor fptr
      withPgfExn "categories" (pgf_iter_categories (a_db p) c_revision itor)
      cs <- readIORef ref
      return (reverse cs))
  where
    getCategories :: IORef [String] -> ItorCallback
-    getCategories ref itor key exn = do
+    getCategories ref itor key _ exn = do
      names <- readIORef ref
      name  <- peekText key
      writeIORef ref $ (name : names)
@@ -510,7 +536,7 @@ categoryContext p cat =
  withText cat $ \c_cat ->
  alloca $ \p_n_hypos ->
  withForeignPtr unmarshaller $ \u ->
-  withForeignPtr (revision p) $ \c_revision ->
+  withForeignPtr (a_revision p) $ \c_revision ->
  mask_ $ do
    c_hypos <- withPgfExn "categoryContext" (pgf_category_context (a_db p) c_revision c_cat p_n_hypos u)
    if c_hypos == nullPtr
@@ -537,7 +563,7 @@ categoryProbability :: PGF -> Cat -> Float
 categoryProbability p cat =
  unsafePerformIO $
  withText cat $ \c_cat ->
-  withForeignPtr (revision p) $ \c_revision ->
+  withForeignPtr (a_revision p) $ \c_revision ->
      withPgfExn "categoryProbability" (pgf_category_prob (a_db p) c_revision c_cat)

 -- | List of all functions defined in the abstract syntax
@@ -547,14 +573,14 @@ functions p =
    ref <- newIORef []
    (allocaBytes (#size PgfItor) $ \itor ->
     bracket (wrapItorCallback (getFunctions ref)) freeHaskellFunPtr $ \fptr ->
-     withForeignPtr (revision p) $ \c_revision -> do
+     withForeignPtr (a_revision p) $ \c_revision -> do
      (#poke PgfItor, fn) itor fptr
      withPgfExn "functions" (pgf_iter_functions (a_db p) c_revision itor)
      fs <- readIORef ref
      return (reverse fs))
  where
    getFunctions :: IORef [String] -> ItorCallback
-    getFunctions ref itor key exn = do
+    getFunctions ref itor key _ exn = do
      names <- readIORef ref
      name  <- peekText key
      writeIORef ref $ (name : names)
@@ -567,14 +593,14 @@ functionsByCat p cat =
    (withText cat $ \c_cat ->
     allocaBytes (#size PgfItor) $ \itor ->
     bracket (wrapItorCallback (getFunctions ref)) freeHaskellFunPtr $ \fptr ->
-     withForeignPtr (revision p) $ \c_revision -> do
+     withForeignPtr (a_revision p) $ \c_revision -> do
      (#poke PgfItor, fn) itor fptr
      withPgfExn "functionsByCat" (pgf_iter_functions_by_cat (a_db p) c_revision c_cat itor)
      fs <- readIORef ref
      return (reverse fs))
  where
    getFunctions :: IORef [String] -> ItorCallback
-    getFunctions ref itor key exn = do
+    getFunctions ref itor key _ exn = do
      names <- readIORef ref
      name  <- peekText key
      writeIORef ref $ (name : names)
@@ -583,7 +609,7 @@ globalFlag :: PGF -> String -> Maybe Literal
 globalFlag p name =
  unsafePerformIO $
  withText name $ \c_name ->
-  withForeignPtr (revision p) $ \c_revision ->
+  withForeignPtr (a_revision p) $ \c_revision ->
  withForeignPtr unmarshaller $ \u -> do
    c_lit <- withPgfExn "globalFlag" (pgf_get_global_flag (a_db p) c_revision c_name u)
    if c_lit == castPtrToStablePtr nullPtr
@@ -596,7 +622,7 @@ abstractFlag :: PGF -> String -> Maybe Literal
 abstractFlag p name =
  unsafePerformIO $
  withText name $ \c_name ->
-  withForeignPtr (revision p) $ \c_revision ->
+  withForeignPtr (a_revision p) $ \c_revision ->
  withForeignPtr unmarshaller $ \u -> do
    c_lit <- withPgfExn "abstractFlag" (pgf_get_abstract_flag (a_db p) c_revision c_name u)
    if c_lit == castPtrToStablePtr nullPtr
--- a/src/runtime/haskell/PGF2/FFI.hsc
+++ b/src/runtime/haskell/PGF2/FFI.hsc
@@ -6,10 +6,12 @@ import GHC.Exts
 import GHC.Prim
 import GHC.Integer.Logarithms
 import Data.Word
+import Data.IORef
 import Data.Typeable
 import Foreign
 import Foreign.C
 import Foreign.Ptr
+import qualified Foreign.Concurrent as C
 import qualified Data.Map as Map
 import Control.Exception(Exception,bracket,mask_,throwIO)
 import System.IO.Unsafe(unsafePerformIO)
@@ -23,11 +25,11 @@ type ConcName = String -- ^ Name of concrete syntax

 -- | An abstract data type representing multilingual grammar
 -- in Portable Grammar Format.
-data PGF = PGF { a_db     :: Ptr PgfDB
-               , revision :: ForeignPtr PgfRevision
-               , languages:: Map.Map ConcName Concr
+data PGF = PGF { a_db       :: Ptr PgfDB
+               , a_revision :: ForeignPtr (PgfRevision PGF)
+               , languages  :: Map.Map ConcName Concr
               }
-data Concr = Concr {c_pgf :: Ptr PgfDB, concr :: Ptr PgfConcr}
+data Concr = Concr {c_db :: Ptr PgfDB, c_revision :: ForeignPtr (PgfRevision Concr)}

 ------------------------------------------------------------------
 -- libpgf API
@@ -36,9 +38,8 @@ data PgfExn
 data PgfText
 data PgfItor
 data PgfDB
-data PgfRevision
+data PgfRevision a
 data PgfPrintContext
-data PgfConcr
 data PgfTypeHypo
 data PgfMarshaller
 data PgfUnmarshaller
@@ -50,23 +51,24 @@ 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 (Ptr PgfRevision) -> Ptr PgfExn -> IO (Ptr PgfDB)
+  pgf_read_pgf :: CString -> Ptr (Ptr (PgfRevision PGF)) -> Ptr PgfExn -> IO (Ptr PgfDB)

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

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

-foreign import ccall pgf_new_ngf :: Ptr PgfText -> CString -> Ptr (Ptr PgfRevision) -> Ptr PgfExn -> IO (Ptr PgfDB)
+foreign import ccall pgf_new_ngf :: Ptr PgfText -> CString -> Ptr (Ptr (PgfRevision PGF)) -> Ptr PgfExn -> IO (Ptr PgfDB)

-foreign import ccall pgf_write_pgf :: CString -> Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfExn -> IO ()
+foreign import ccall pgf_write_pgf :: CString -> Ptr PgfDB -> Ptr (PgfRevision PGF) -> Ptr PgfExn -> IO ()

-foreign import ccall "pgf_free_revision"
-  pgf_free_revision :: Ptr PgfDB -> Ptr PgfRevision -> IO ()
+foreign import ccall pgf_free_revision :: Ptr PgfDB -> Ptr (PgfRevision PGF) -> IO ()
+
+foreign import ccall pgf_free_concr_revision :: Ptr PgfDB -> Ptr (PgfRevision Concr) -> IO ()

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

 foreign import ccall "pgf_print_expr"
  pgf_print_expr :: StablePtr Expr -> Ptr PgfPrintContext -> CInt -> Ptr PgfMarshaller -> IO (Ptr PgfText)
@@ -84,61 +86,77 @@ foreign import ccall pgf_print_context :: CSize -> Ptr PgfTypeHypo -> Ptr PgfPri
 foreign import ccall "pgf_read_type"
  pgf_read_type :: Ptr PgfText -> Ptr PgfUnmarshaller -> IO (StablePtr Type)

-type ItorCallback = Ptr PgfItor -> Ptr PgfText -> Ptr PgfExn -> IO ()
+type ItorCallback = Ptr PgfItor -> Ptr PgfText -> Ptr () -> Ptr PgfExn -> IO ()

 foreign import ccall "wrapper"
  wrapItorCallback :: ItorCallback -> IO (FunPtr ItorCallback)

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

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

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

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

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

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

 foreign import ccall "pgf_function_type"
-   pgf_function_type :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> Ptr PgfUnmarshaller -> Ptr PgfExn -> IO (StablePtr Type)
+   pgf_function_type :: Ptr PgfDB -> Ptr (PgfRevision PGF) -> Ptr PgfText -> Ptr PgfUnmarshaller -> Ptr PgfExn -> IO (StablePtr Type)

 foreign import ccall "pgf_function_is_constructor"
-   pgf_function_is_constructor :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> Ptr PgfExn -> IO (#type int)
+   pgf_function_is_constructor :: Ptr PgfDB -> Ptr (PgfRevision PGF) -> Ptr PgfText -> Ptr PgfExn -> IO (#type int)

 foreign import ccall "pgf_function_prob"
-   pgf_function_prob :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> Ptr PgfExn -> IO (#type prob_t)
+   pgf_function_prob :: Ptr PgfDB -> Ptr (PgfRevision PGF) -> Ptr PgfText -> Ptr PgfExn -> IO (#type prob_t)

-foreign import ccall pgf_expr_prob :: Ptr PgfDB -> Ptr PgfRevision -> StablePtr Expr -> Ptr PgfMarshaller -> Ptr PgfExn -> IO (#type prob_t)
+foreign import ccall pgf_concrete_name :: Ptr PgfDB -> Ptr (PgfRevision Concr) -> Ptr PgfExn -> IO (Ptr PgfText)

-foreign import ccall pgf_clone_revision :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> Ptr PgfExn -> IO (Ptr PgfRevision)
+foreign import ccall pgf_concrete_language_code :: Ptr PgfDB -> Ptr (PgfRevision Concr) -> Ptr PgfExn -> IO (Ptr PgfText)

-foreign import ccall pgf_commit_revision :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfExn -> IO ()
+foreign import ccall pgf_expr_prob :: Ptr PgfDB -> Ptr (PgfRevision PGF) -> StablePtr Expr -> Ptr PgfMarshaller -> Ptr PgfExn -> IO (#type prob_t)

-foreign import ccall pgf_checkout_revision :: Ptr PgfDB -> Ptr PgfText -> Ptr PgfExn -> IO (Ptr PgfRevision)
+foreign import ccall pgf_clone_revision :: Ptr PgfDB -> Ptr (PgfRevision PGF) -> Ptr PgfText -> Ptr PgfExn -> IO (Ptr (PgfRevision PGF))

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

-foreign import ccall pgf_drop_function :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> Ptr PgfExn -> IO ()
+foreign import ccall pgf_checkout_revision :: Ptr PgfDB -> Ptr PgfText -> Ptr PgfExn -> IO (Ptr (PgfRevision PGF))

-foreign import ccall pgf_create_category :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> CSize -> Ptr PgfTypeHypo -> (#type prob_t) -> Ptr PgfMarshaller -> Ptr PgfExn -> IO ()
+foreign import ccall pgf_create_function :: Ptr PgfDB -> Ptr (PgfRevision PGF) -> Ptr PgfText -> StablePtr Type -> CSize -> (#type prob_t) -> Ptr PgfMarshaller -> Ptr PgfExn -> IO ()

-foreign import ccall pgf_drop_category :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> Ptr PgfExn -> IO ()
+foreign import ccall pgf_drop_function :: Ptr PgfDB -> Ptr (PgfRevision PGF) -> Ptr PgfText -> Ptr PgfExn -> IO ()

-foreign import ccall pgf_get_global_flag :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> Ptr PgfUnmarshaller -> Ptr PgfExn -> IO (StablePtr Literal)
+foreign import ccall pgf_create_category :: Ptr PgfDB -> Ptr (PgfRevision PGF) -> Ptr PgfText -> CSize -> Ptr PgfTypeHypo -> (#type prob_t) -> Ptr PgfMarshaller -> Ptr PgfExn -> IO ()

-foreign import ccall pgf_set_global_flag :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> StablePtr Literal -> Ptr PgfMarshaller -> Ptr PgfExn -> IO ()
+foreign import ccall pgf_drop_category :: Ptr PgfDB -> Ptr (PgfRevision PGF) -> Ptr PgfText -> Ptr PgfExn -> IO ()

-foreign import ccall pgf_get_abstract_flag :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> Ptr PgfUnmarshaller -> Ptr PgfExn -> IO (StablePtr Literal)
+foreign import ccall pgf_create_concrete :: Ptr PgfDB -> Ptr (PgfRevision PGF) -> Ptr PgfText -> Ptr PgfExn -> IO (Ptr (PgfRevision Concr))

-foreign import ccall pgf_set_abstract_flag :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> StablePtr Literal -> Ptr PgfMarshaller -> Ptr PgfExn -> IO ()
+foreign import ccall pgf_clone_concrete :: Ptr PgfDB -> Ptr (PgfRevision PGF) -> Ptr PgfText -> Ptr PgfExn -> IO (Ptr (PgfRevision Concr))
+
+foreign import ccall pgf_drop_concrete :: Ptr PgfDB -> Ptr (PgfRevision PGF) -> Ptr PgfText -> Ptr PgfExn -> IO ()
+
+foreign import ccall pgf_get_global_flag :: Ptr PgfDB -> Ptr (PgfRevision PGF) -> Ptr PgfText -> Ptr PgfUnmarshaller -> Ptr PgfExn -> IO (StablePtr Literal)
+
+foreign import ccall pgf_set_global_flag :: Ptr PgfDB -> Ptr (PgfRevision PGF) -> Ptr PgfText -> StablePtr Literal -> Ptr PgfMarshaller -> Ptr PgfExn -> IO ()
+
+foreign import ccall pgf_get_abstract_flag :: Ptr PgfDB -> Ptr (PgfRevision PGF) -> Ptr PgfText -> Ptr PgfUnmarshaller -> Ptr PgfExn -> IO (StablePtr Literal)
+
+foreign import ccall pgf_set_abstract_flag :: Ptr PgfDB -> Ptr (PgfRevision PGF) -> Ptr PgfText -> StablePtr Literal -> Ptr PgfMarshaller -> Ptr PgfExn -> IO ()
+
+foreign import ccall pgf_get_concrete_flag :: Ptr PgfDB -> Ptr (PgfRevision Concr) -> Ptr PgfText -> Ptr PgfUnmarshaller -> Ptr PgfExn -> IO (StablePtr Literal)
+
+foreign import ccall pgf_set_concrete_flag :: Ptr PgfDB -> Ptr (PgfRevision Concr) -> Ptr PgfText -> StablePtr Literal -> Ptr PgfMarshaller -> Ptr PgfExn -> IO ()

 -----------------------------------------------------------------------
 -- Texts
@@ -581,3 +599,19 @@ withHypos hypos f =
      (#peek PgfTypeHypo, type) ptr >>= freeStablePtr
      freeHypos (n-1) (ptr `plusPtr` (#size PgfTypeHypo))

+getConcretes c_db c_revision = do
+  ref <- newIORef Map.empty
+  (withForeignPtr c_revision $ \c_revision ->
+   allocaBytes (#size PgfItor) $ \itor ->
+   bracket (wrapItorCallback (getConcretes ref)) freeHaskellFunPtr $ \fptr -> do
+     (#poke PgfItor, fn) itor fptr
+     withPgfExn "getConcretes" (pgf_iter_concretes c_db c_revision itor)
+     readIORef ref)
+  where
+    getConcretes :: IORef (Map.Map ConcName Concr) -> ItorCallback
+    getConcretes ref itor key c_revision exn = do
+      print 1
+      concrs <- readIORef ref
+      name  <- peekText key
+      fptr <- C.newForeignPtr (castPtr c_revision) (pgf_free_concr_revision c_db (castPtr c_revision))
+      writeIORef ref (Map.insert name (Concr c_db fptr) concrs)
--- a/src/runtime/haskell/PGF2/Transactions.hsc
+++ b/src/runtime/haskell/PGF2/Transactions.hsc
@@ -9,8 +9,11 @@ module PGF2.Transactions
          , dropFunction
          , createCategory
          , dropCategory
+          , createConcrete
+          , dropConcrete
          , setGlobalFlag
          , setAbstractFlag
+          , setConcreteFlag

            -- concrete syntax
          , Token, LIndex, LParam, Symbol(..)
@@ -26,22 +29,22 @@ import Control.Exception

 #include <pgf/pgf.h>

-newtype Transaction a =
-  Transaction (Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfExn -> IO a)
+newtype Transaction k a =
+  Transaction (Ptr PgfDB -> Ptr (PgfRevision k) -> Ptr PgfExn -> IO a)

-instance Functor Transaction where
+instance Functor (Transaction k) 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
+instance Applicative (Transaction k) where
  pure x = Transaction $ \c_db c_revision c_exn -> return x
  f <*> g = do
    f <- f
    g <- g
    return (f g)

-instance Monad Transaction where
+instance Monad (Transaction k) 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
@@ -65,20 +68,20 @@ instance Monad Transaction where
   both @gr1@ and @gr2@ will refer to the new grammar which contains
   the new function @foo@.
 -}
-modifyPGF :: PGF -> Transaction a -> IO PGF
+modifyPGF :: PGF -> Transaction PGF a -> IO PGF
 modifyPGF = branchPGF_ nullPtr

 {- | @branchPGF gr branch_name t@ is similar to @modifyPGF gr t@,
   except that it stores the result as a branch with the given name.
 -}
-branchPGF :: PGF -> String -> Transaction a -> IO PGF
+branchPGF :: PGF -> String -> Transaction PGF a -> IO PGF
 branchPGF p name t =
  withText name $ \c_name ->
    branchPGF_ c_name p t

-branchPGF_ :: Ptr PgfText -> PGF -> Transaction a -> IO PGF
+branchPGF_ :: Ptr PgfText -> PGF -> Transaction PGF a -> IO PGF
 branchPGF_ c_name p (Transaction f) =
-  withForeignPtr (revision p) $ \c_revision ->
+  withForeignPtr (a_revision p) $ \c_revision ->
  withPgfExn "branchPGF" $ \c_exn ->
  mask $ \restore -> do
    c_revision <- pgf_clone_revision (a_db p) c_revision c_name c_exn
@@ -95,7 +98,8 @@ branchPGF_ c_name p (Transaction f) =
                        ex_type <- (#peek PgfExn, type) c_exn
                        if (ex_type :: (#type PgfExnType)) == (#const PGF_EXN_NONE)
                          then do fptr <- C.newForeignPtr c_revision (pgf_free_revision (a_db p) c_revision)
-                                  return (PGF (a_db p) fptr (languages p))
+                                  langs <- getConcretes (a_db p) fptr
+                                  return (PGF (a_db p) fptr langs)
                          else do pgf_free_revision (a_db p) c_revision
                                  return p
                else do pgf_free_revision (a_db p) c_revision
@@ -110,46 +114,70 @@ checkoutPGF p name =
    if c_revision == nullPtr
      then return Nothing
      else do fptr <- C.newForeignPtr c_revision (pgf_free_revision (a_db p) c_revision)
-              return (Just (PGF (a_db p) fptr (languages p)))
+              langs <- getConcretes (a_db p) fptr
+              return (Just (PGF (a_db p) fptr langs))

-createFunction :: Fun -> Type -> Int -> Float -> Transaction ()
+createFunction :: Fun -> Type -> Int -> Float -> Transaction PGF ()
 createFunction name ty arity 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 (fromIntegral arity) prob m c_exn

-dropFunction :: Fun -> Transaction ()
+dropFunction :: Fun -> Transaction PGF ()
 dropFunction name = Transaction $ \c_db c_revision c_exn ->
  withText name $ \c_name -> do
    pgf_drop_function c_db c_revision c_name c_exn

-createCategory :: Fun -> [Hypo] -> Float -> Transaction ()
+createCategory :: Fun -> [Hypo] -> Float -> Transaction PGF ()
 createCategory name hypos prob = Transaction $ \c_db c_revision c_exn ->
  withText name $ \c_name ->
  withHypos hypos $ \n_hypos c_hypos ->
  withForeignPtr marshaller $ \m -> do
    pgf_create_category c_db c_revision c_name n_hypos c_hypos prob m c_exn

-dropCategory :: Cat -> Transaction ()
+dropCategory :: Cat -> Transaction PGF ()
 dropCategory name = Transaction $ \c_db c_revision c_exn ->
  withText name $ \c_name -> do
    pgf_drop_category c_db c_revision c_name c_exn

-setGlobalFlag :: String -> Literal -> Transaction ()
+createConcrete :: ConcName -> Transaction Concr () -> Transaction PGF ()
+createConcrete name (Transaction f) = Transaction $ \c_db c_revision c_exn ->
+  withText name $ \c_name -> do
+    c_concr_revision <- pgf_create_concrete c_db c_revision c_name c_exn
+    f c_db c_concr_revision c_exn
+
+alterConcrete :: ConcName -> Transaction Concr () -> Transaction PGF ()
+alterConcrete name (Transaction f) = Transaction $ \c_db c_revision c_exn ->
+  withText name $ \c_name -> do
+    c_concr_revision <- pgf_clone_concrete c_db c_revision c_name c_exn
+    f c_db c_concr_revision c_exn
+
+dropConcrete :: ConcName -> Transaction PGF ()
+dropConcrete name = Transaction $ \c_db c_revision c_exn ->
+  withText name $ \c_name -> do
+    pgf_drop_concrete c_db c_revision c_name c_exn
+
+setGlobalFlag :: String -> Literal -> Transaction PGF ()
 setGlobalFlag name value = Transaction $ \c_db c_revision c_exn ->
  withText name $ \c_name ->
  bracket (newStablePtr value) freeStablePtr $ \c_value ->
  withForeignPtr marshaller $ \m ->
    pgf_set_global_flag c_db c_revision c_name c_value m c_exn

-setAbstractFlag :: String -> Literal -> Transaction ()
+setAbstractFlag :: String -> Literal -> Transaction PGF ()
 setAbstractFlag name value = Transaction $ \c_db c_revision c_exn ->
  withText name $ \c_name ->
  bracket (newStablePtr value) freeStablePtr $ \c_value ->
  withForeignPtr marshaller $ \m ->
    pgf_set_abstract_flag c_db c_revision c_name c_value m c_exn

+setConcreteFlag :: String -> Literal -> Transaction Concr ()
+setConcreteFlag name value = Transaction $ \c_db c_revision c_exn ->
+  withText name $ \c_name ->
+  bracket (newStablePtr value) freeStablePtr $ \c_value ->
+  withForeignPtr marshaller $ \m ->
+    pgf_set_concrete_flag c_db c_revision c_name c_value m c_exn

 type Token  = String
 type LIndex = Int