forked from GitHub/gf-core
a number of new API functions for the concrete syntax.
This commit is contained in:
@@ -106,6 +106,9 @@ typedef struct {
|
|||||||
|
|
||||||
struct PGF_INTERNAL_DECL PgfConcrLincat {
|
struct PGF_INTERNAL_DECL PgfConcrLincat {
|
||||||
size_t ref_count;
|
size_t ref_count;
|
||||||
|
|
||||||
|
ref<PgfAbsCat> abscat;
|
||||||
|
|
||||||
ref<Vector<ref<PgfText>>> fields;
|
ref<Vector<ref<PgfText>>> fields;
|
||||||
PgfText name;
|
PgfText name;
|
||||||
|
|
||||||
|
|||||||
@@ -955,6 +955,56 @@ void pgf_drop_concrete(PgfDB *db, PgfRevision revision,
|
|||||||
} PGF_API_END
|
} PGF_API_END
|
||||||
}
|
}
|
||||||
|
|
||||||
|
PGF_API
|
||||||
|
void pgf_create_lincat(PgfDB *db,
|
||||||
|
PgfRevision revision, PgfConcrRevision cnc_revision,
|
||||||
|
PgfText *name, size_t n_fields, PgfExn *err)
|
||||||
|
{
|
||||||
|
PGF_API_BEGIN {
|
||||||
|
DB_scope scope(db, WRITER_SCOPE);
|
||||||
|
|
||||||
|
ref<PgfPGF> pgf = PgfDB::revision2pgf(revision);
|
||||||
|
ref<PgfConcr> concr = PgfDB::revision2concr(cnc_revision);
|
||||||
|
|
||||||
|
ref<PgfAbsCat> abscat =
|
||||||
|
namespace_lookup(pgf->abstract.cats, name);
|
||||||
|
if (abscat == 0) {
|
||||||
|
throw pgf_error("There is no corresponding category in the abstract syntax");
|
||||||
|
}
|
||||||
|
|
||||||
|
ref<PgfConcrLincat> lincat = PgfDB::malloc<PgfConcrLincat>(name->size+1);
|
||||||
|
memcpy(&lincat->name, name, sizeof(PgfText)+name->size+1);
|
||||||
|
lincat->ref_count = 1;
|
||||||
|
lincat->abscat = abscat;
|
||||||
|
lincat->fields = vector_new<ref<PgfText>>(n_fields);
|
||||||
|
|
||||||
|
for (size_t i = 0; i < n_fields; i++) {
|
||||||
|
}
|
||||||
|
|
||||||
|
Namespace<PgfConcrLincat> lincats =
|
||||||
|
namespace_insert(concr->lincats, lincat);
|
||||||
|
namespace_release(concr->lincats);
|
||||||
|
concr->lincats = lincats;
|
||||||
|
} PGF_API_END
|
||||||
|
}
|
||||||
|
|
||||||
|
PGF_API
|
||||||
|
void pgf_drop_lincat(PgfDB *db,
|
||||||
|
PgfConcrRevision revision,
|
||||||
|
PgfText *name, PgfExn *err)
|
||||||
|
{
|
||||||
|
PGF_API_BEGIN {
|
||||||
|
DB_scope scope(db, WRITER_SCOPE);
|
||||||
|
|
||||||
|
ref<PgfConcr> concr = PgfDB::revision2concr(revision);
|
||||||
|
|
||||||
|
Namespace<PgfConcrLincat> lincats =
|
||||||
|
namespace_delete(concr->lincats, name);
|
||||||
|
namespace_release(concr->lincats);
|
||||||
|
concr->lincats = lincats;
|
||||||
|
} PGF_API_END
|
||||||
|
}
|
||||||
|
|
||||||
PGF_API
|
PGF_API
|
||||||
void pgf_create_lin(PgfDB *db,
|
void pgf_create_lin(PgfDB *db,
|
||||||
PgfRevision revision, PgfConcrRevision cnc_revision,
|
PgfRevision revision, PgfConcrRevision cnc_revision,
|
||||||
@@ -996,6 +1046,41 @@ void pgf_create_lin(PgfDB *db,
|
|||||||
} PGF_API_END
|
} PGF_API_END
|
||||||
}
|
}
|
||||||
|
|
||||||
|
PGF_API
|
||||||
|
void pgf_drop_lin(PgfDB *db,
|
||||||
|
PgfConcrRevision revision,
|
||||||
|
PgfText *name, PgfExn *err)
|
||||||
|
{
|
||||||
|
PGF_API_BEGIN {
|
||||||
|
DB_scope scope(db, WRITER_SCOPE);
|
||||||
|
|
||||||
|
ref<PgfConcr> concr = PgfDB::revision2concr(revision);
|
||||||
|
|
||||||
|
Namespace<PgfConcrLin> lins =
|
||||||
|
namespace_delete(concr->lins, name);
|
||||||
|
namespace_release(concr->lins);
|
||||||
|
concr->lins = lins;
|
||||||
|
} PGF_API_END
|
||||||
|
}
|
||||||
|
|
||||||
|
PGF_API
|
||||||
|
int pgf_has_linearization(PgfDB *db, PgfConcrRevision revision,
|
||||||
|
PgfText *name, PgfExn *err)
|
||||||
|
{
|
||||||
|
PGF_API_BEGIN {
|
||||||
|
DB_scope scope(db, READER_SCOPE);
|
||||||
|
|
||||||
|
ref<PgfConcr> concr = PgfDB::revision2concr(revision);
|
||||||
|
|
||||||
|
ref<PgfConcrLin> lin =
|
||||||
|
namespace_lookup(concr->lins, name);
|
||||||
|
|
||||||
|
return (lin != 0);
|
||||||
|
} PGF_API_END
|
||||||
|
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
PGF_API
|
PGF_API
|
||||||
PgfLiteral pgf_get_global_flag(PgfDB *db, PgfRevision revision,
|
PgfLiteral pgf_get_global_flag(PgfDB *db, PgfRevision revision,
|
||||||
PgfText *name,
|
PgfText *name,
|
||||||
|
|||||||
@@ -418,11 +418,28 @@ void pgf_drop_concrete(PgfDB *db, PgfRevision revision,
|
|||||||
PgfText *name,
|
PgfText *name,
|
||||||
PgfExn *err);
|
PgfExn *err);
|
||||||
|
|
||||||
|
PGF_API_DECL
|
||||||
|
void pgf_create_lincat(PgfDB *db,
|
||||||
|
PgfRevision revision, PgfConcrRevision cnc_revision,
|
||||||
|
PgfText *name, size_t n_fields, PgfExn *err);
|
||||||
|
|
||||||
|
PGF_API_DECL
|
||||||
|
void pgf_drop_lincat(PgfDB *db, PgfConcrRevision revision,
|
||||||
|
PgfText *name, PgfExn *err);
|
||||||
|
|
||||||
PGF_API_DECL
|
PGF_API_DECL
|
||||||
void pgf_create_lin(PgfDB *db,
|
void pgf_create_lin(PgfDB *db,
|
||||||
PgfRevision revision, PgfConcrRevision cnc_revision,
|
PgfRevision revision, PgfConcrRevision cnc_revision,
|
||||||
PgfText *name, size_t n_prods, PgfExn *err);
|
PgfText *name, size_t n_prods, PgfExn *err);
|
||||||
|
|
||||||
|
PGF_API_DECL
|
||||||
|
void pgf_drop_lin(PgfDB *db, PgfConcrRevision revision,
|
||||||
|
PgfText *name, PgfExn *err);
|
||||||
|
|
||||||
|
PGF_API_DECL
|
||||||
|
int pgf_has_linearization(PgfDB *db, PgfConcrRevision revision,
|
||||||
|
PgfText *name, PgfExn *err);
|
||||||
|
|
||||||
PGF_API_DECL
|
PGF_API_DECL
|
||||||
PgfLiteral pgf_get_global_flag(PgfDB *db, PgfRevision revision,
|
PgfLiteral pgf_get_global_flag(PgfDB *db, PgfRevision revision,
|
||||||
PgfText *name,
|
PgfText *name,
|
||||||
|
|||||||
@@ -544,6 +544,7 @@ ref<PgfConcrLincat> PgfReader::read_lincat()
|
|||||||
{
|
{
|
||||||
ref<PgfConcrLincat> lincat = read_name(&PgfConcrLincat::name);
|
ref<PgfConcrLincat> lincat = read_name(&PgfConcrLincat::name);
|
||||||
lincat->ref_count = 1;
|
lincat->ref_count = 1;
|
||||||
|
lincat->abscat = namespace_lookup(abstract->cats, &lincat->name);
|
||||||
lincat->fields = read_vector(&PgfReader::read_text2);
|
lincat->fields = read_vector(&PgfReader::read_text2);
|
||||||
return lincat;
|
return lincat;
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -433,7 +433,12 @@ complete = error "TODO: complete"
|
|||||||
|
|
||||||
-- | Returns True if there is a linearization defined for that function in that language
|
-- | Returns True if there is a linearization defined for that function in that language
|
||||||
hasLinearization :: Concr -> Fun -> Bool
|
hasLinearization :: Concr -> Fun -> Bool
|
||||||
hasLinearization = error "TODO: linearize"
|
hasLinearization c name =
|
||||||
|
unsafePerformIO $
|
||||||
|
withText name $ \c_name ->
|
||||||
|
withForeignPtr (c_revision c) $ \c_revision -> do
|
||||||
|
c_res <- withPgfExn "hasLinearization" (pgf_has_linearization (c_db c) c_revision c_name)
|
||||||
|
return (c_res /= 0)
|
||||||
|
|
||||||
-- | Linearizes an expression as a string in the language
|
-- | Linearizes an expression as a string in the language
|
||||||
linearize :: Concr -> Expr -> String
|
linearize :: Concr -> Expr -> String
|
||||||
|
|||||||
@@ -139,8 +139,16 @@ foreign import ccall pgf_clone_concrete :: Ptr PgfDB -> Ptr PGF -> Ptr PgfText -
|
|||||||
|
|
||||||
foreign import ccall pgf_drop_concrete :: Ptr PgfDB -> Ptr PGF -> Ptr PgfText -> Ptr PgfExn -> IO ()
|
foreign import ccall pgf_drop_concrete :: Ptr PgfDB -> Ptr PGF -> Ptr PgfText -> Ptr PgfExn -> IO ()
|
||||||
|
|
||||||
|
foreign import ccall pgf_create_lincat :: Ptr PgfDB -> Ptr PGF -> Ptr Concr -> Ptr PgfText -> CSize -> Ptr PgfExn -> IO ()
|
||||||
|
|
||||||
|
foreign import ccall pgf_drop_lincat :: Ptr PgfDB -> Ptr Concr -> Ptr PgfText -> Ptr PgfExn -> IO ()
|
||||||
|
|
||||||
foreign import ccall pgf_create_lin :: Ptr PgfDB -> Ptr PGF -> Ptr Concr -> Ptr PgfText -> CSize -> Ptr PgfExn -> IO ()
|
foreign import ccall pgf_create_lin :: Ptr PgfDB -> Ptr PGF -> Ptr Concr -> Ptr PgfText -> CSize -> Ptr PgfExn -> IO ()
|
||||||
|
|
||||||
|
foreign import ccall pgf_drop_lin :: Ptr PgfDB -> Ptr Concr -> Ptr PgfText -> Ptr PgfExn -> IO ()
|
||||||
|
|
||||||
|
foreign import ccall pgf_has_linearization :: Ptr PgfDB -> Ptr Concr -> Ptr PgfText -> Ptr PgfExn -> IO CInt
|
||||||
|
|
||||||
foreign import ccall pgf_get_global_flag :: Ptr PgfDB -> Ptr PGF -> Ptr PgfText -> Ptr PgfUnmarshaller -> Ptr PgfExn -> IO (StablePtr Literal)
|
foreign import ccall pgf_get_global_flag :: Ptr PgfDB -> Ptr PGF -> Ptr PgfText -> Ptr PgfUnmarshaller -> Ptr PgfExn -> IO (StablePtr Literal)
|
||||||
|
|
||||||
foreign import ccall pgf_set_global_flag :: Ptr PgfDB -> Ptr PGF -> Ptr PgfText -> StablePtr Literal -> Ptr PgfMarshaller -> Ptr PgfExn -> IO ()
|
foreign import ccall pgf_set_global_flag :: Ptr PgfDB -> Ptr PGF -> Ptr PgfText -> StablePtr Literal -> Ptr PgfMarshaller -> Ptr PgfExn -> IO ()
|
||||||
|
|||||||
@@ -20,7 +20,10 @@ module PGF2.Transactions
|
|||||||
, alterConcrete
|
, alterConcrete
|
||||||
, dropConcrete
|
, dropConcrete
|
||||||
, setConcreteFlag
|
, setConcreteFlag
|
||||||
|
, createLincat
|
||||||
|
, dropLincat
|
||||||
, createLin
|
, createLin
|
||||||
|
, dropLin
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import PGF2.FFI
|
import PGF2.FFI
|
||||||
@@ -210,7 +213,22 @@ data PArg = PArg [(LIndex,LIndex)] {-# UNPACK #-} !LParam
|
|||||||
data Production = Production [PArg] LParam [[Symbol]]
|
data Production = Production [PArg] LParam [[Symbol]]
|
||||||
deriving (Eq,Show)
|
deriving (Eq,Show)
|
||||||
|
|
||||||
|
createLincat :: Cat -> [String] -> Transaction Concr ()
|
||||||
|
createLincat name fields = Transaction $ \c_db c_abstr c_revision c_exn ->
|
||||||
|
withText name $ \c_name ->
|
||||||
|
pgf_create_lincat c_db c_abstr c_revision c_name (fromIntegral (length fields)) c_exn
|
||||||
|
|
||||||
|
dropLincat :: Cat -> Transaction Concr ()
|
||||||
|
dropLincat name = Transaction $ \c_db _ c_revision c_exn ->
|
||||||
|
withText name $ \c_name ->
|
||||||
|
pgf_drop_lincat c_db c_revision c_name c_exn
|
||||||
|
|
||||||
createLin :: Fun -> [Production] -> Transaction Concr ()
|
createLin :: Fun -> [Production] -> Transaction Concr ()
|
||||||
createLin name rules = Transaction $ \c_db c_abstr c_revision c_exn ->
|
createLin name rules = Transaction $ \c_db c_abstr c_revision c_exn ->
|
||||||
withText name $ \c_name ->
|
withText name $ \c_name ->
|
||||||
pgf_create_lin c_db c_abstr c_revision c_name (fromIntegral (length rules)) c_exn
|
pgf_create_lin c_db c_abstr c_revision c_name (fromIntegral (length rules)) c_exn
|
||||||
|
|
||||||
|
dropLin :: Fun -> Transaction Concr ()
|
||||||
|
dropLin name = Transaction $ \c_db _ c_revision c_exn ->
|
||||||
|
withText name $ \c_name ->
|
||||||
|
pgf_drop_lin c_db c_revision c_name c_exn
|
||||||
|
|||||||
Reference in New Issue
Block a user