From 217e0d8cc69ee39977e3a585b276553521321fc8 Mon Sep 17 00:00:00 2001 From: krangelov Date: Thu, 5 Aug 2021 19:30:05 +0200 Subject: [PATCH] added function abstractName from the API --- src/runtime/c/pgf.cxx | 6 ++++++ src/runtime/c/pgf.h | 6 ++++++ src/runtime/c/text.cxx | 36 ++++++++++++++++++++++++++++++++ src/runtime/c/text.h | 11 +++++----- src/runtime/haskell/PGF2.hsc | 23 ++++++++++++++++++-- src/runtime/haskell/PGF2/FFI.hsc | 26 +++++++++++++++++++++++ 6 files changed, 101 insertions(+), 7 deletions(-) diff --git a/src/runtime/c/pgf.cxx b/src/runtime/c/pgf.cxx index 3af02ae47..7d5e33a68 100644 --- a/src/runtime/c/pgf.cxx +++ b/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)); +} diff --git a/src/runtime/c/pgf.h b/src/runtime/c/pgf.h index f0814e0ff..c71a032de 100644 --- a/src/runtime/c/pgf.h +++ b/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. diff --git a/src/runtime/c/text.cxx b/src/runtime/c/text.cxx index dd1a8f78a..6e3b9804b 100644 --- a/src/runtime/c/text.cxx +++ b/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; +} + + diff --git a/src/runtime/c/text.h b/src/runtime/c/text.h index dfaab88d1..88b4266b5 100644 --- a/src/runtime/c/text.h +++ b/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 diff --git a/src/runtime/haskell/PGF2.hsc b/src/runtime/haskell/PGF2.hsc index d165b95e3..ac24d3b42 100644 --- a/src/runtime/haskell/PGF2.hsc +++ b/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 +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 diff --git a/src/runtime/haskell/PGF2/FFI.hsc b/src/runtime/haskell/PGF2/FFI.hsc index e66baefa3..e462dd571 100644 --- a/src/runtime/haskell/PGF2/FFI.hsc +++ b/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 + -- | 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)