GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-09 04:59:31 -06:00
Code Issues Packages Projects Releases Wiki Activity

added API for accessing flags

Browse Source
This commit is contained in:
krangelov
2021-09-12 12:57:45 +02:00
parent f1e1564228
commit 6cb4bef521
5 changed files with 167 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

92
src/runtime/c/pgf/pgf.cxx
View File

@@ -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<PgfPGF> pgf = PgfDB::revision2pgf(revision);
ref<PgfFlag> 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<PgfPGF> pgf = PgfDB::revision2pgf(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> 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<PgfPGF> pgf = PgfDB::revision2pgf(revision);
ref<PgfFlag> 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<PgfPGF> pgf = PgfDB::revision2pgf(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> aflags =
namespace_insert(pgf->abstract.aflags, flag);
namespace_release(pgf->abstract.aflags);
pgf->abstract.aflags = aflags;
} PGF_API_END
}

23
src/runtime/c/pgf/pgf.h
View File

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

30
src/runtime/haskell/PGF2.hsc
View File

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

7
src/runtime/haskell/PGF2/FFI.hsc
View File

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

16
src/runtime/haskell/PGF2/Transactions.hsc
View File

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