an API to retrieve a single language

GrammaticalFramework · Sep 20, 2024 · 8878edd · 8878edd
1 parent e722916
commit 8878edd
Show file tree

Hide file tree

Showing 4 changed files with 39 additions and 1 deletion.
diff --git a/src/runtime/c/pgf/pgf.cxx b/src/runtime/c/pgf/pgf.cxx
@@ -485,6 +485,28 @@ void pgf_iter_concretes(PgfDB *db, PgfRevision revision,
     } PGF_API_END
 }
 
+PGF_API
+PgfConcrRevision pgf_get_concrete(PgfDB *db, PgfRevision revision,
+                                  PgfText *name, PgfExn *err)
+{
+    PGF_API_BEGIN {
+        size_t txn_id;
+
+        DB_scope scope(db, READER_SCOPE);
+        ref<PgfPGF> pgf = db->revision2pgf(revision, &txn_id);
+
+        ref<PgfConcr> concr =
+            namespace_lookup(pgf->concretes, name);
+        if (concr == 0)
+            return 0;
+
+        db->ref_count++;
+        return db->register_revision(concr.tagged(), txn_id);
+    } PGF_API_END
+
+    return 0;
+}
+
 PGF_API
 PgfType pgf_start_cat(PgfDB *db, PgfRevision revision,
                       PgfUnmarshaller *u,

diff --git a/src/runtime/c/pgf/pgf.h b/src/runtime/c/pgf/pgf.h
@@ -347,6 +347,10 @@ PGF_API_DECL
 void pgf_iter_concretes(PgfDB *db, PgfRevision revision,
                         PgfItor *itor, PgfExn *err);
 
+PGF_API_DECL
+PgfConcrRevision pgf_get_concrete(PgfDB *db, PgfRevision revision,
+                                  PgfText *name, PgfExn *err);
+
 PGF_API_DECL
 PgfType pgf_start_cat(PgfDB *db, PgfRevision revision,
                       PgfUnmarshaller *u,

diff --git a/src/runtime/haskell/PGF2.hsc b/src/runtime/haskell/PGF2.hsc
@@ -76,7 +76,7 @@ module PGF2 (-- * PGF
              graphvizWordAlignment, graphvizLRAutomaton,
 
              -- * Concrete syntax
-             ConcName,Concr,languages,concreteName,languageCode,concreteFlag,
+             ConcName,Concr,languages,language,concreteName,languageCode,concreteFlag,
 
              -- ** Linearization
              linearize, linearizeAll, tabularLinearize, tabularLinearizeAll,
@@ -299,6 +299,16 @@ languages p = unsafePerformIO $ do
       fptr <- newForeignPtrEnv pgf_free_concr_revision (a_db p) (castPtr c_revision)
       writeIORef ref (Map.insert name (Concr (a_db p) fptr) concrs)
 
+language :: PGF -> ConcName -> Maybe Concr
+language p name = unsafePerformIO $
+  (withForeignPtr (a_revision p) $ \c_revision ->
+   withText name $ \c_name -> do
+      res <- withPgfExn "language" (pgf_get_concrete (a_db p) c_revision c_name)
+      if res == nullPtr
+        then return Nothing
+        else do fptr <- newForeignPtrEnv pgf_free_concr_revision (a_db p) res
+                return (Just (Concr (a_db p) fptr)))
+
 showPGF :: PGF -> String
 showPGF p =
   render (text "abstract" <+> ppAbstractName p <+> char '{' $$

diff --git a/src/runtime/haskell/PGF2/FFI.hsc b/src/runtime/haskell/PGF2/FFI.hsc
@@ -178,6 +178,8 @@ foreign import ccall pgf_iter_categories :: Ptr PgfDB -> Ptr PGF -> Ptr PgfItor
 
 foreign import ccall pgf_iter_concretes :: Ptr PgfDB -> Ptr PGF -> Ptr PgfItor -> Ptr PgfExn -> IO ()
 
+foreign import ccall pgf_get_concrete :: Ptr PgfDB -> Ptr PGF -> Ptr PgfItor -> Ptr PgfExn -> IO (Ptr Concr)
+
 foreign import ccall pgf_start_cat :: Ptr PgfDB -> Ptr PGF -> Ptr PgfUnmarshaller -> Ptr PgfExn -> IO (StablePtr Type)
 
 foreign import ccall pgf_category_context :: Ptr PgfDB -> Ptr PGF -> Ptr PgfText -> Ptr CSize -> Ptr PgfUnmarshaller -> Ptr PgfExn -> IO (Ptr PgfTypeHypo)