From 6cb4bef521d6dc2ff91af29854fb8d28c9e1825b Mon Sep 17 00:00:00 2001 From: krangelov Date: Sun, 12 Sep 2021 12:57:45 +0200 Subject: [PATCH] added API for accessing flags --- src/runtime/c/pgf/pgf.cxx | 92 +++++++++++++++++++++++ src/runtime/c/pgf/pgf.h | 23 ++++++ src/runtime/haskell/PGF2.hsc | 30 +++++++- src/runtime/haskell/PGF2/FFI.hsc | 7 ++ src/runtime/haskell/PGF2/Transactions.hsc | 16 ++++ 5 files changed, 167 insertions(+), 1 deletion(-) diff --git a/src/runtime/c/pgf/pgf.cxx b/src/runtime/c/pgf/pgf.cxx index 0e7f300cf..71ab27f4f 100644 --- a/src/runtime/c/pgf/pgf.cxx +++ b/src/runtime/c/pgf/pgf.cxx @@ -629,3 +629,95 @@ void pgf_drop_category(PgfDB *db, PgfRevision revision, pgf->abstract.cats = cats; } PGF_API_END } + +PGF_API +PgfLiteral pgf_get_global_flag(PgfDB *db, PgfRevision revision, + PgfText *name, + PgfUnmarshaller *u, + PgfExn *err) +{ + PGF_API_BEGIN { + DB_scope scope(db, READER_SCOPE); + + ref pgf = PgfDB::revision2pgf(revision); + + ref flag = + namespace_lookup(pgf->gflags, name); + if (flag != 0) { + return PgfDBMarshaller().match_lit(u, flag->value); + } + } PGF_API_END + + return 0; +} + +PGF_API +void pgf_set_global_flag(PgfDB *db, PgfRevision revision, + PgfText *name, + PgfLiteral value, + PgfMarshaller *m, + PgfExn *err) +{ + PGF_API_BEGIN { + DB_scope scope(db, WRITER_SCOPE); + + PgfDBUnmarshaller u(m); + + ref pgf = PgfDB::revision2pgf(revision); + + ref flag = PgfDB::malloc(name->size+1); + flag->ref_count = 1; + memcpy(&flag->name, name, sizeof(PgfText)+name->size+1); + flag->value = m->match_lit(&u, value); + Namespace gflags = + namespace_insert(pgf->gflags, flag); + namespace_release(pgf->gflags); + pgf->gflags = gflags; + } PGF_API_END +} + +PGF_API +PgfLiteral pgf_get_abstract_flag(PgfDB *db, PgfRevision revision, + PgfText *name, + PgfUnmarshaller *u, + PgfExn *err) +{ + PGF_API_BEGIN { + DB_scope scope(db, READER_SCOPE); + + ref pgf = PgfDB::revision2pgf(revision); + + ref flag = + namespace_lookup(pgf->abstract.aflags, name); + if (flag != 0) { + return PgfDBMarshaller().match_lit(u, flag->value); + } + } PGF_API_END + + return 0; +} + +PGF_API +void pgf_set_abstract_flag(PgfDB *db, PgfRevision revision, + PgfText *name, + PgfLiteral value, + PgfMarshaller *m, + PgfExn *err) +{ + PGF_API_BEGIN { + DB_scope scope(db, WRITER_SCOPE); + + PgfDBUnmarshaller u(m); + + ref pgf = PgfDB::revision2pgf(revision); + + ref flag = PgfDB::malloc(name->size+1); + flag->ref_count = 1; + memcpy(&flag->name, name, sizeof(PgfText)+name->size+1); + flag->value = m->match_lit(&u, value); + Namespace aflags = + namespace_insert(pgf->abstract.aflags, flag); + namespace_release(pgf->abstract.aflags); + pgf->abstract.aflags = aflags; + } PGF_API_END +} diff --git a/src/runtime/c/pgf/pgf.h b/src/runtime/c/pgf/pgf.h index 2710b3c03..d9cec6e9d 100644 --- a/src/runtime/c/pgf/pgf.h +++ b/src/runtime/c/pgf/pgf.h @@ -362,4 +362,27 @@ void pgf_drop_category(PgfDB *db, PgfRevision revision, PgfText *name, PgfExn *err); +PGF_API_DECL +PgfLiteral pgf_get_global_flag(PgfDB *db, PgfRevision revision, + PgfText *name, + PgfUnmarshaller *u, + PgfExn *err); +PGF_API_DECL +void pgf_set_global_flag(PgfDB *db, PgfRevision revision, + PgfText *name, + PgfLiteral value, + PgfMarshaller *m, + PgfExn *err); +PGF_API_DECL +PgfLiteral pgf_get_abstract_flag(PgfDB *db, PgfRevision revision, + PgfText *name, + PgfUnmarshaller *u, + PgfExn *err); +PGF_API_DECL +void pgf_set_abstract_flag(PgfDB *db, PgfRevision revision, + PgfText *name, + PgfLiteral value, + PgfMarshaller *m, + PgfExn *err); + #endif // PGF_H_ diff --git a/src/runtime/haskell/PGF2.hsc b/src/runtime/haskell/PGF2.hsc index dac0ec3d6..eee6639f8 100644 --- a/src/runtime/haskell/PGF2.hsc +++ b/src/runtime/haskell/PGF2.hsc @@ -17,7 +17,7 @@ module PGF2 (-- * PGF PGF,readPGF,bootNGF,readNGF, -- * Abstract syntax - AbsName,abstractName, + AbsName,abstractName,globalFlag,abstractFlag, -- ** Categories Cat,categories,categoryContext,categoryProb, -- ** Functions @@ -263,6 +263,34 @@ functionsByCat p cat = name <- peekText key writeIORef ref $ (name : names) +globalFlag :: PGF -> String -> Maybe Literal +globalFlag p name = + unsafePerformIO $ + withText name $ \c_name -> + withForeignPtr (a_db p) $ \c_db -> + withForeignPtr (revision p) $ \c_revision -> + withForeignPtr unmarshaller $ \u -> do + c_lit <- withPgfExn (pgf_get_global_flag c_db 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) + +abstractFlag :: PGF -> String -> Maybe Literal +abstractFlag p name = + unsafePerformIO $ + withText name $ \c_name -> + withForeignPtr (a_db p) $ \c_db -> + withForeignPtr (revision p) $ \c_revision -> + withForeignPtr unmarshaller $ \u -> do + c_lit <- withPgfExn (pgf_get_abstract_flag c_db 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) + ----------------------------------------------------------------------- -- Expressions & types diff --git a/src/runtime/haskell/PGF2/FFI.hsc b/src/runtime/haskell/PGF2/FFI.hsc index abf5052a6..1e9e843a9 100644 --- a/src/runtime/haskell/PGF2/FFI.hsc +++ b/src/runtime/haskell/PGF2/FFI.hsc @@ -122,6 +122,13 @@ foreign import ccall pgf_create_category :: Ptr PgfDB -> Ptr PgfRevision -> Ptr foreign import ccall pgf_drop_category :: Ptr PgfDB -> Ptr PgfRevision -> 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_set_global_flag :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> StablePtr Literal -> Ptr PgfMarshaller -> 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_set_abstract_flag :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> StablePtr Literal -> Ptr PgfMarshaller -> Ptr PgfExn -> IO () ----------------------------------------------------------------------- -- Texts diff --git a/src/runtime/haskell/PGF2/Transactions.hsc b/src/runtime/haskell/PGF2/Transactions.hsc index 230d00bed..5e9a9542d 100644 --- a/src/runtime/haskell/PGF2/Transactions.hsc +++ b/src/runtime/haskell/PGF2/Transactions.hsc @@ -7,6 +7,8 @@ module PGF2.Transactions , dropFunction , createCategory , dropCategory + , setGlobalFlag + , setAbstractFlag ) where import PGF2.FFI @@ -130,3 +132,17 @@ dropCategory :: Cat -> Transaction () 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 () +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 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