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 the "alter lin" command

Browse Source
This commit is contained in:
Krasimir Angelov
2023-03-07 15:29:58 +01:00
parent c7e988dacf
commit 9dc36a0f5f
9 changed files with 108 additions and 18 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
src/compiler/GF/Command/Abstract.hs
View File

@@ -17,7 +17,7 @@ data TransactionCommand
= CreateFun [Option] Fun Type
| CreateCat [Option] Cat [Hypo]
| CreateConcrete [Option] ConcName
| CreateLin [Option] Fun Term
| CreateLin [Option] Fun Term Bool
| CreateLincat [Option] Cat Term
| DropFun [Option] Fun
| DropCat [Option] Cat

14
src/compiler/GF/Command/Commands.hs
View File

@@ -716,6 +716,20 @@ pgfCommands = Map.fromList [
],
needsTypeCheck = False
}),
("a", emptyCommandInfo {
longname = "alter",
syntax = "alter lin f = ..",
synopsis = "Dynamically updates the linearization of a function in the current grammar.",
explanation = unlines [
"The syntax is the same as if the definition was in a module. If you want to use",
"any operations inside the lin definition, you should import them",
"by using the command `i -resource <file path>`."
],
flags = [
("lang","the language in which to alter the lin")
],
needsTypeCheck = False
}),
("d", emptyCommandInfo {
longname = "drop",
syntax = "drop fun f; drop cat c; drop concrete l; drop lin c; or drop lincat c",

4
src/compiler/GF/Command/Parse.hs
View File

@@ -82,7 +82,7 @@ pTransactionCommand = do
| take 1 cmd == "d" -> do
name <- pIdent
return (DropConcrete opts name)
"lin" | take 1 cmd == "c" -> do
"lin" | elem (take 1 cmd) ["c","a"] -> do
f <- pIdent
skipSpaces
args <- sepBy pIdent skipSpaces
@@ -92,7 +92,7 @@ pTransactionCommand = do
t <- readS_to_P (\s -> case runPartial pTerm s of
Right (s,t) -> [(t,s)]
_ -> [])
return (CreateLin opts f (foldr (Abs Explicit . identS) t args))
return (CreateLin opts f (foldr (Abs Explicit . identS) t args) (take 1 cmd == "a"))
| take 1 cmd == "d" -> do
f <- pIdent
return (DropLin opts f)

6
src/compiler/GF/Interactive.hs
View File

@@ -138,7 +138,7 @@ execute1 readNGF s0 =
continue
_ -> do putStrLnE $ "no import in history"
continue
(w :ws) | w == "c" || w == "d" -> do
(w :ws) | elem w ["c","a","d"] -> do
case readTransactionCommand s0 of
Just cmd -> do checkout
env <- gets pgfenv
@@ -282,7 +282,7 @@ transactionCommand (CreateCat opts c ctxt) pgf mb_txnid = do
transactionCommand (CreateConcrete opts name) pgf mb_txnid = do
lift $ updatePGF pgf mb_txnid (createConcrete name (return ()))
return ()
transactionCommand (CreateLin opts f t) pgf mb_txnid = do
transactionCommand (CreateLin opts f t is_alter) pgf mb_txnid = do
sgr <- getGrammar
lang <- optLang pgf opts
mo <- maybe (fail "no source grammar in scope") return $
@@ -297,7 +297,7 @@ transactionCommand (CreateLin opts f t) pgf mb_txnid = do
Just fields -> case runCheck (compileLinTerm sgr mo t (type2term mo ty)) of
Ok ((prods,seqtbl,fields'),_)
| fields == fields' -> do
createLin f prods seqtbl
(if is_alter then alterLin else createLin) f prods seqtbl
return ()
| otherwise -> fail "The linearization categories in the resource and the compiled grammar does not match"
Bad msg -> fail msg

12
src/runtime/c/pgf/namespace.h
View File

@@ -406,22 +406,26 @@ Namespace<V> namespace_insert(Namespace<V> map, ref<V> value)
}
template <class V>
Namespace<V> namespace_update(Namespace<V> map, ref<V> value)
Namespace<V> namespace_replace(Namespace<V> map,
ref<V> value, ref<V> *old_value)
{
if (map == 0)
if (map == 0) {
*old_value = 0;
return Node<ref<V>>::new_node(value);
}
int cmp = textcmp(&value->name,&map->value->name);
if (cmp < 0) {
Namespace<V> left = namespace_update(map->left, value);
Namespace<V> left = namespace_replace(map->left, value, old_value);
map = Node<ref<V>>::upd_node(map,left,map->right);
return Node<ref<V>>::balanceL(map);
} else if (cmp > 0) {
Namespace<V> right = namespace_update(map->right, value);
Namespace<V> right = namespace_replace(map->right, value, old_value);
map = Node<ref<V>>::upd_node(map,map->left,right);
return Node<ref<V>>::balanceR(map);
} else {
map = Node<ref<V>>::upd_node(map,map->left,map->right);
*old_value = map->value;
map->value = value;
return map;
}

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

@@ -1364,8 +1364,9 @@ ref<PgfConcr> clone_concrete(ref<PgfPGF> pgf, ref<PgfConcr> concr)
clone->printnames = concr->printnames;
memcpy(&clone->name, &concr->name, sizeof(PgfText)+concr->name.size+1);
ref<PgfConcr> old_concr;
Namespace<PgfConcr> concrs =
namespace_update(pgf->concretes, clone);
namespace_replace(pgf->concretes, clone, &old_concr);
pgf->concretes = concrs;
PgfDB::free(concr, concr->name.size+1);
@@ -2301,6 +2302,47 @@ void pgf_create_lin(PgfDB *db,
} PGF_API_END
}
PGF_API
void pgf_alter_lin(PgfDB *db,
PgfRevision revision, PgfConcrRevision cnc_revision,
PgfText *name, size_t n_prods,
PgfBuildLinIface *build,
PgfExn *err)
{
PGF_API_BEGIN {
DB_scope scope(db, WRITER_SCOPE);
ref<PgfPGF> pgf = db->revision2pgf(revision);
ref<PgfConcr> concr = db->revision2concr(cnc_revision);
ref<PgfAbsFun> absfun =
namespace_lookup(pgf->abstract.funs, name);
if (absfun == 0) {
throw pgf_error("There is no corresponding function in the abstract syntax");
}
ref<PgfConcrLin> lin =
PgfLinBuilder(concr).build(absfun, n_prods, build, err);
if (lin != 0) {
ref<PgfConcrLin> old_lin;
Namespace<PgfConcrLin> lins =
namespace_replace(concr->lins, lin, &old_lin);
concr->lins = lins;
if (old_lin != 0) {
object container = old_lin.tagged();
PgfPhrasetable phrasetable = concr->phrasetable;
for (size_t i = 0; i < old_lin->seqs->len; i++) {
ref<PgfSequence> seq = *vector_elem(old_lin->seqs, i);
phrasetable =
phrasetable_delete(phrasetable,container,i,seq);
}
concr->phrasetable = phrasetable;
PgfConcrLin::release(old_lin);
}
}
} PGF_API_END
}
PGF_API
void pgf_drop_lin(PgfDB *db,
PgfRevision revision, PgfConcrRevision cnc_revision,
@@ -2635,8 +2677,12 @@ void pgf_set_printname(PgfDB *db, PgfConcrRevision revision,
memcpy(&printname->name, fun, sizeof(PgfText)+fun->size+1);
printname->printname = textdup_db(name);
ref<PgfConcrPrintname> old_printname;
Namespace<PgfConcrPrintname> printnames =
namespace_update(concr->printnames, printname);
namespace_replace(concr->printnames, printname, &old_printname);
if (old_printname != 0) {
PgfConcrPrintname::release(old_printname);
}
concr->printnames = printnames;
} PGF_API_END
}
@@ -2680,8 +2726,13 @@ void pgf_set_global_flag(PgfDB *db, PgfRevision revision,
memcpy(&flag->name, name, sizeof(PgfText)+name->size+1);
PgfLiteral lit = m->match_lit(&u, value);
flag->value = lit;
ref<PgfFlag> old_flag;
Namespace<PgfFlag> gflags =
namespace_update(pgf->gflags, flag);
namespace_replace(pgf->gflags, flag, &old_flag);
if (old_flag != 0) {
PgfFlag::release(old_flag);
}
pgf->gflags = gflags;
} PGF_API_END
}
@@ -2725,8 +2776,13 @@ void pgf_set_abstract_flag(PgfDB *db, PgfRevision revision,
memcpy(&flag->name, name, sizeof(PgfText)+name->size+1);
PgfLiteral lit = m->match_lit(&u, value);
flag->value = lit;
ref<PgfFlag> old_flag;
Namespace<PgfFlag> aflags =
namespace_update(pgf->abstract.aflags, flag);
namespace_replace(pgf->abstract.aflags, flag, &old_flag);
if (old_flag != 0) {
PgfFlag::release(old_flag);
}
pgf->abstract.aflags = aflags;
} PGF_API_END
}
@@ -2770,8 +2826,13 @@ void pgf_set_concrete_flag(PgfDB *db, PgfConcrRevision revision,
memcpy(&flag->name, name, sizeof(PgfText)+name->size+1);
PgfLiteral lit = m->match_lit(&u, value);
flag->value = lit;
ref<PgfFlag> old_flag;
Namespace<PgfFlag> cflags =
namespace_update(concr->cflags, flag);
namespace_replace(concr->cflags, flag, &old_flag);
if (old_flag != 0) {
PgfFlag::release(old_flag);
}
concr->cflags = cflags;
} PGF_API_END
}

7
src/runtime/c/pgf/reader.cxx
View File

@@ -891,7 +891,10 @@ void PgfReader::merge_pgf(ref<PgfPGF> pgf)
size_t len = read_len();
for (size_t i = 0; i < len; i++) {
ref<PgfConcr> concr = PgfReader::read_concrete();
pgf->concretes =
namespace_update(pgf->concretes, concr);
Namespace<PgfConcr> concretes =
namespace_insert(pgf->concretes, concr);
if (concretes != 0)
throw pgf_error("One and the same concrete syntax is included in several PGF files");
pgf->concretes = concretes;
}
}

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

@@ -243,6 +243,8 @@ foreign import ccall pgf_drop_lincat :: Ptr PgfDB -> Ptr PGF -> Ptr Concr -> Ptr
foreign import ccall pgf_create_lin :: Ptr PgfDB -> Ptr PGF -> Ptr Concr -> Ptr PgfText -> CSize -> Ptr PgfBuildLinIface -> Ptr PgfExn -> IO ()
foreign import ccall pgf_alter_lin :: Ptr PgfDB -> Ptr PGF -> Ptr Concr -> Ptr PgfText -> CSize -> Ptr PgfBuildLinIface -> Ptr PgfExn -> IO ()
foreign import ccall pgf_drop_lin :: Ptr PgfDB -> Ptr PGF -> Ptr Concr -> Ptr PgfText -> Ptr PgfExn -> IO ()
foreign import ccall pgf_has_linearization :: Ptr PgfDB -> Ptr Concr -> Ptr PgfText -> Ptr PgfExn -> IO CInt

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

@@ -29,7 +29,7 @@ module PGF2.Transactions
, SeqTable
, createLincat
, dropLincat
, createLin
, createLin, alterLin
, dropLin
, setPrintName
, getFunctionType
@@ -296,6 +296,12 @@ createLin name prods seqtbl = Transaction $ \c_db c_abstr c_revision c_exn ->
withBuildLinIface prods seqtbl $ \c_build ->
pgf_create_lin c_db c_abstr c_revision c_name (fromIntegral (length prods)) c_build c_exn
alterLin :: Fun -> [Production] -> SeqTable -> Transaction Concr SeqTable
alterLin name prods seqtbl = Transaction $ \c_db c_abstr c_revision c_exn ->
withText name $ \c_name ->
withBuildLinIface prods seqtbl $ \c_build ->
pgf_alter_lin c_db c_abstr c_revision c_name (fromIntegral (length prods)) c_build c_exn
withBuildLinIface prods seqtbl f = do
ref <- newIORef seqtbl
(allocaBytes (#size PgfBuildLinIface) $ \c_build ->