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

2021-10-21 19:18:14 +02:00
parent 259ed52a77
commit 1413c273cc
15 changed files with 529 additions and 197 deletions
--- a/src/compiler/GF/Compile/GrammarToPGF.hs
+++ b/src/compiler/GF/Compile/GrammarToPGF.hs
@@ -18,6 +18,7 @@ import GF.Infra.Option
 import GF.Infra.UseIO (IOE)
 import GF.Data.Operations

+import Control.Monad(forM)
 import Data.List
 import Data.Char
 import qualified Data.Set as Set
@@ -28,125 +29,61 @@ import Data.Maybe(fromMaybe)
 import System.FilePath
 import System.Directory

-import GHC.Prim
-import GHC.Base(getTag)
-
 grammar2PGF :: Options -> SourceGrammar -> ModuleName -> Map.Map PGF2.Fun Double -> IO PGF
 grammar2PGF opts gr am probs = do
-  gr <- mkAbstr am probs
-  return gr {-do
-  cnc_infos <- getConcreteInfos gr am
-  return $
-    build (let gflags   = if flag optSplitPGF opts 
-                            then [("split", LStr "true")]
-                            else []
-               (an,abs) = mkAbstr am probs
-               cncs     = map (mkConcr opts abs) cnc_infos
-           in newPGF gflags an abs cncs)-}
+  let abs_name = mi2i am
+  mb_ngf_path <-
+     if snd (flag optLinkTargets opts)
+       then do let fname = maybe id (</>)
+                                 (flag optOutputDir opts)
+                                 (fromMaybe abs_name (flag optName opts)<.>"ngf")
+               exists <- doesFileExist fname
+               if exists
+                 then removeFile fname
+                 else return ()
+               putStr ("(Boot image "++fname++") ")
+               return (Just fname)
+       else do return Nothing
+  pgf <- newNGF abs_name mb_ngf_path
+  pgf <- modifyPGF pgf $ do
+    sequence_ [setAbstractFlag name value | (name,value) <- optionsPGF aflags]
+    sequence_ [createCategory c ctxt p | (c,ctxt,p) <- cats]
+    sequence_ [createFunction f ty arity p | (f,ty,arity,_,p) <- funs]
+    forM (allConcretes gr am) $ \cm ->
+      createConcrete (mi2i cm) $ do
+        let cflags = err (const noOptions) mflags (lookupModule gr cm)
+        sequence_ [setConcreteFlag name value | (name,value) <- optionsPGF cflags]
+  return pgf
  where
    aflags = err (const noOptions) mflags (lookupModule gr am)

-    mkAbstr :: ModuleName -> Map.Map PGF2.Fun Double -> IO PGF
-    mkAbstr am probs = do
-      let abs_name = mi2i am
-      mb_ngf_path <-
-         if snd (flag optLinkTargets opts)
-           then do let fname = maybe id (</>)
-                                     (flag optOutputDir opts)
-                                     (fromMaybe abs_name (flag optName opts)<.>"ngf")
-                   exists <- doesFileExist fname
-                   if exists
-                     then removeFile fname
-                     else return ()
-                   putStr ("(Boot image "++fname++") ")
-                   return (Just fname)
-           else do return Nothing
-      gr <- newNGF abs_name mb_ngf_path
-      modifyPGF gr $ do
-        sequence_ [setAbstractFlag name value | (name,value) <- flags]
-        sequence_ [createCategory c ctxt p | (c,ctxt,p) <- cats]
-        sequence_ [createFunction f ty arity p | (f,ty,arity,_,p) <- funs]
+    adefs =
+        [((cPredefAbs,c), AbsCat (Just (L NoLoc []))) | c <- [cFloat,cInt,cString]] ++ 
+        Look.allOrigInfos gr am
+
+    toLogProb = realToFrac . negate . log
+
+    cats = [(c', snd (mkContext [] cont), toLogProb (fromMaybe 0 (Map.lookup c' probs))) |
+                               ((m,c),AbsCat (Just (L _ cont))) <- adefs, let c' = i2i c]
+
+    funs = [(f', mkType [] ty, arity, bcode, toLogProb (fromMaybe 0 (Map.lookup f' funs_probs))) |
+                               ((m,f),AbsFun (Just (L _ ty)) ma mdef _) <- adefs,
+                               let arity = mkArity ma mdef ty,
+                               let bcode = mkDef gr arity mdef,
+                               let f' = i2i f]
+                               
+    funs_probs = (Map.fromList . concat . Map.elems . fmap pad . Map.fromListWith (++))
+                    [(i2i cat,[(i2i f,Map.lookup f' probs)]) | ((m,f),AbsFun (Just (L _ ty)) _ _ _) <- adefs,
+                                                               let (_,(_,cat),_) = GM.typeForm ty,
+                                                               let f' = i2i f]
      where
-        adefs =
-            [((cPredefAbs,c), AbsCat (Just (L NoLoc []))) | c <- [cFloat,cInt,cString]] ++ 
-            Look.allOrigInfos gr am
-
-        flags = optionsPGF aflags
-
-        toLogProb = realToFrac . negate . log
-
-        cats = [(c', snd (mkContext [] cont), toLogProb (fromMaybe 0 (Map.lookup c' probs))) |
-                                   ((m,c),AbsCat (Just (L _ cont))) <- adefs, let c' = i2i c]
-
-        funs = [(f', mkType [] ty, arity, bcode, toLogProb (fromMaybe 0 (Map.lookup f' funs_probs))) |
-                                   ((m,f),AbsFun (Just (L _ ty)) ma mdef _) <- adefs,
-                                   let arity = mkArity ma mdef ty,
-                                   let bcode = mkDef gr arity mdef,
-                                   let f' = i2i f]
-                                   
-        funs_probs = (Map.fromList . concat . Map.elems . fmap pad . Map.fromListWith (++))
-                        [(i2i cat,[(i2i f,Map.lookup f' probs)]) | ((m,f),AbsFun (Just (L _ ty)) _ _ _) <- adefs,
-                                                                   let (_,(_,cat),_) = GM.typeForm ty,
-                                                                   let f' = i2i f]
+        pad :: [(a,Maybe Double)] -> [(a,Double)]
+        pad pfs = [(f,fromMaybe deflt mb_p) | (f,mb_p) <- pfs]
          where
-            pad :: [(a,Maybe Double)] -> [(a,Double)]
-            pad pfs = [(f,fromMaybe deflt mb_p) | (f,mb_p) <- pfs]
-              where
-                deflt = case length [f | (f,Nothing) <- pfs] of
-                          0 -> 0
-                          n -> max 0 ((1 - sum [d | (f,Just d) <- pfs]) / fromIntegral n)
-{-
-    mkConcr opts abs (cm,ex_seqs,cdefs) =
-      let cflags = err (const noOptions) mflags (lookupModule gr cm)
-          ciCmp | flag optCaseSensitive cflags = compare
-                | otherwise                    = compareCaseInsensitive
+            deflt = case length [f | (f,Nothing) <- pfs] of
+                      0 -> 0
+                      n -> max 0 ((1 - sum [d | (f,Just d) <- pfs]) / fromIntegral n)

-          flags = optionsPGF aflags
-
-          seqs = (mkSetArray . Set.fromList . concat) $
-                       (elems (ex_seqs :: Array SeqId [Symbol]) : [maybe [] elems (mseqs mi) | (m,mi) <- allExtends gr cm])
-
-          !(!fid_cnt1,!cnccats) = genCncCats gr am cm cdefs
-          cnccat_ranges = Map.fromList (map (\(cid,s,e,_) -> (cid,(s,e))) cnccats)
-          !(!fid_cnt2,!productions,!lindefs,!linrefs,!cncfuns)
-                                = genCncFuns gr am cm ex_seqs ciCmp seqs cdefs fid_cnt1 cnccat_ranges
-
-          printnames = genPrintNames cdefs
-
-          startCat = (fromMaybe "S" (flag optStartCat aflags))
-
-          (lindefs',linrefs',productions',cncfuns',sequences',cnccats') =
-               (if flag optOptimizePGF opts then optimizePGF startCat else id)
-                    (lindefs,linrefs,productions,cncfuns,elems seqs,cnccats)
-
-      in (mi2i cm, newConcr abs
-                            flags
-                            printnames
-                            lindefs'
-                            linrefs'
-                            productions'
-                            cncfuns'
-                            sequences'
-                            cnccats'
-                            fid_cnt2)
-
-    getConcreteInfos gr am = mapM flatten (allConcretes gr am)
-      where
-        flatten cm = do
-          (seqs,infos) <- addMissingPMCFGs cm Map.empty
-                                           (lit_infos ++ Look.allOrigInfos gr cm)
-          return (cm,mkMapArray seqs :: Array SeqId [Symbol],infos)
-
-        lit_infos = [((cPredefAbs,c), CncCat (Just (L NoLoc GM.defLinType)) Nothing Nothing Nothing Nothing) | c <- [cInt,cFloat,cString]]
-
-        -- if some module was compiled with -no-pmcfg, then
-        -- we have to create the PMCFG code just before linking
-        addMissingPMCFGs cm seqs []                  = return (seqs,[])
-        addMissingPMCFGs cm seqs (((m,id), info):is) = do
-          (seqs,info)  <- addPMCFG opts gr cenv Nothing am cm seqs id info
-          (seqs,infos) <- addMissingPMCFGs cm seqs is
-          return (seqs, ((m,id), info) : infos)
-}
 i2i :: Ident -> String
 i2i = showIdent

--- 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