added function abstractName from the API

src/runtime/c/pgf.cxx

@@ -65,3 +65,9 @@ void pgf_free(PgfPGF *pgf)
 {
     delete pgf;
 }
+
+PGF_API
+PgfText *pgf_abstract_name(PgfPGF* pgf)
+{
+	return textdup(&(*pgf->abstract.name));
+}

src/runtime/c/pgf.h

@@ -37,6 +37,12 @@
 
 #endif
 
+/* A generic structure to store text. The last field is variable length */
+typedef struct {
+    size_t size;
+    char text[];
+} PgfText;
+
 typedef struct PgfPGF PgfPGF;
 
 /* All functions that may fail take a reference to a PgfExn structure.

src/runtime/c/text.cxx

@@ -17,3 +17,39 @@ int textcmp(PgfText &t1, PgfText &t2)
         i++;
     }
 }
+
+PGF_INTERNAL
+PgfText* textdup(PgfText *t1)
+{
+    PgfText *t2 = (PgfText *) malloc(sizeof(PgfText) + t1->size + 1);
+    t2->size = t1->size;
+    memcpy(t2->text, t1->text, t1->size+1);
+    return t2;
+}
+
+PGF_API uint32_t
+pgf_utf8_decode(const uint8_t** src_inout)
+{
+	const uint8_t* src = *src_inout;
+	uint8_t c = src[0];
+	if (c < 0x80) {
+		*src_inout = src + 1;
+		return c;
+	}
+	size_t len = (c < 0xe0 ? 1 :
+	              c < 0xf0 ? 2 :
+	              c < 0xf8 ? 3 :
+	              c < 0xfc ? 4 :
+	                         5
+	             );
+	uint64_t mask = 0x0103070F1f7f;
+	uint32_t u = c & (mask >> (len * 8));
+	for (size_t i = 1; i <= len; i++) {
+		c = src[i];
+		u = u << 6 | (c & 0x3f);
+	}
+	*src_inout = &src[len + 1];
+	return u;
+}
+
+

src/runtime/c/text.h

@@ -1,12 +1,13 @@
 #ifndef TEXT_H
 #define TEXT_H
 
-typedef struct {
-    size_t size;
-    char text[];
-} PgfText;
-
 PGF_INTERNAL_DECL
 int textcmp(PgfText &t1, PgfText &t2);
 
+PGF_INTERNAL_DECL
+PgfText* textdup(PgfText *t1);
+
+PGF_API uint32_t
+pgf_utf8_decode(const uint8_t** src_inout);
+
 #endif

src/runtime/haskell/PGF2.hsc

@@ -14,10 +14,17 @@
 -------------------------------------------------
 
 module PGF2 (-- * PGF
-             PGF,readPGF
+             PGF,readPGF,
+
+             -- * Abstract syntax
+             AbsName,abstractName,
+
+             -- * Concrete syntax
+             ConcName
             ) where
 
-import Control.Exception(Exception,throwIO,mask_)
+import Control.Exception(Exception,throwIO,mask_,bracket)
+import System.IO.Unsafe(unsafePerformIO)
 import PGF2.FFI
 
 import Foreign
@@ -27,6 +34,9 @@ import qualified Data.Map as Map
 
 #include <pgf.h>
 
+type AbsName  = String -- ^ Name of abstract syntax
+type ConcName = String -- ^ Name of concrete syntax
+
 readPGF :: FilePath -> IO PGF
 readPGF fpath =
   withCString fpath $ \c_fpath ->
@@ -45,6 +55,15 @@ readPGF fpath =
                      free c_msg
                      throwIO (PGFError msg)
 
+-- | The abstract language name is the name of the top-level
+-- abstract module
+abstractName :: PGF -> AbsName
+abstractName p =
+  unsafePerformIO $
+  withForeignPtr (a_pgf p) $ \c_pgf ->
+  bracket (pgf_abstract_name c_pgf) free $ \c_text ->
+    peekText c_text
+
 -----------------------------------------------------------------------
 -- Exceptions
 

src/runtime/haskell/PGF2/FFI.hsc

@@ -2,11 +2,15 @@
 
 module PGF2.FFI where
 
+import Data.Word
+import Foreign ( alloca, peek, poke, peekByteOff )
 import Foreign.C
 import Foreign.Ptr
 import Foreign.ForeignPtr
 import qualified Data.Map as Map
 
+#include <pgf.h>
+
 -- | An abstract data type representing multilingual grammar
 -- in Portable Grammar Format.
 data PGF = PGF {a_pgf :: ForeignPtr PgfPGF, langs :: Map.Map String Concr}
@@ -16,12 +20,34 @@ data Concr = Concr {c_pgf :: ForeignPtr PgfPGF, concr :: Ptr PgfConcr}
 -- libpgf API
 
 data PgfExn
+data PgfText
 data PgfPGF
 data PgfConcr
 
+foreign import ccall unsafe "pgf_utf8_decode"
+  pgf_utf8_decode :: Ptr CString -> IO Word32
+
 foreign import ccall "pgf.h pgf_read"
   pgf_read :: CString -> Ptr PgfExn -> IO (Ptr PgfPGF)
 
 foreign import ccall "&pgf_free"
   pgf_free_fptr :: FinalizerPtr PgfPGF
 
+foreign import ccall "pgf/pgf.h pgf_abstract_name"
+  pgf_abstract_name :: Ptr PgfPGF -> IO (Ptr PgfText)
+
+peekText :: Ptr PgfText -> IO String
+peekText ptr =
+  alloca $ \pptr -> do
+    size <- ((#peek PgfText, size) ptr) :: IO CSize
+    let c_text = castPtr ptr `plusPtr` (#offset PgfText, text)
+    poke pptr c_text
+    decode pptr (c_text `plusPtr` fromIntegral size)
+  where
+    decode pptr end = do
+      ptr <- peek pptr
+      if ptr >= end
+        then return []
+        else do x <- pgf_utf8_decode pptr
+                cs <- decode pptr end
+                return (((toEnum . fromEnum) x) : cs)