From 28321cc02343a615049c5b2d0bf58727b1a63073 Mon Sep 17 00:00:00 2001 From: krangelov Date: Thu, 9 Sep 2021 09:47:26 +0200 Subject: [PATCH] added dropFunction --- src/runtime/c/pgf/db.h | 4 +- src/runtime/c/pgf/namespace.h | 82 ++++++++++++++++++++++- src/runtime/c/pgf/pgf.cxx | 21 +++++- src/runtime/haskell/PGF2/FFI.hsc | 2 + src/runtime/haskell/PGF2/Transactions.hsc | 6 ++ src/runtime/haskell/tests/transactions.hs | 3 + 6 files changed, 113 insertions(+), 5 deletions(-) diff --git a/src/runtime/c/pgf/db.h b/src/runtime/c/pgf/db.h index 2dbca1c75..810510e80 100644 --- a/src/runtime/c/pgf/db.h +++ b/src/runtime/c/pgf/db.h @@ -22,8 +22,8 @@ public: A* operator->() const { return (A*) (current_base+offset); } operator A*() const { return (A*) (current_base+offset); } - bool operator ==(ref& other) const { return offset==other->offset; } - bool operator !=(ref& other) const { return offset!=other->offset; } + bool operator ==(ref& other) const { return offset==other.as_object(); } + bool operator !=(ref& other) const { return offset!=other.as_object(); } bool operator ==(object other_offset) const { return offset==other_offset; } bool operator !=(object other_offset) const { return offset!=other_offset; } diff --git a/src/runtime/c/pgf/namespace.h b/src/runtime/c/pgf/namespace.h index 2a0b2c694..32b8668f7 100644 --- a/src/runtime/c/pgf/namespace.h +++ b/src/runtime/c/pgf/namespace.h @@ -287,7 +287,87 @@ Namespace namespace_insert(Namespace map, ref value) return Node::new_node(value,map->left,map->right); } } - + +template +Namespace namespace_delete(Namespace map, PgfText* name) +{ + if (map == 0) + return 0; + + int cmp = textcmp(name,&map->value->name); + if (cmp < 0) { + Namespace left = namespace_delete(map->left, name); + if (left == map->left) + return map; + Namespace node = Node::balanceR(map->value,left,map->right); + namespace_release(left); + return node; + } else if (cmp > 0) { + Namespace right = namespace_delete(map->right, name); + if (right == map->right) + return map; + Namespace node = Node::balanceL(map->value,map->left,right); + namespace_release(right); + return node; + } else { + if (map->left == 0) { + if (map->right != 0) + map->right->ref_count++; + return map->right; + } else if (map->right == 0) { + if (map->left != 0) + map->left->ref_count++; + return map->left; + } else if (map->left->sz > map->right->sz) { + ref value; + Namespace new_left = namespace_pop_last(map->left, &value); + Namespace node = Node::balanceR(value, new_left, map->right); + namespace_release(new_left); + return node; + } else { + ref value; + Namespace new_right = namespace_pop_first(map->right, &value); + Namespace node = Node::balanceL(value, map->left, new_right); + namespace_release(new_right); + return node; + } + } +} + +template +Namespace namespace_pop_first(Namespace map, ref *res) +{ + if (map == 0) { + return 0; + } else if (map->left == 0) { + *res = map->value; + if (map->right != 0) + map->right->ref_count++; + return map->right; + } else { + Namespace new_left = namespace_pop_first(map->left, res); + Namespace node = Node::balanceR(map->value, new_left, map->right); + namespace_release(new_left); + return node; + } +} + +template +Namespace namespace_pop_last(Namespace map, ref *res) +{ + if (map == 0) { + return 0; + } else if (map->right == 0) { + *res = map->value; + if (map->left != 0) + map->left->ref_count++; + return map->left; + } else { + Namespace new_right = namespace_pop_last(map->right, res); + return Node::balanceR(map->value, map->left, new_right); + } +} + template ref namespace_lookup(Namespace map, PgfText *name) { diff --git a/src/runtime/c/pgf/pgf.cxx b/src/runtime/c/pgf/pgf.cxx index 32ed0d4af..ece0580e8 100644 --- a/src/runtime/c/pgf/pgf.cxx +++ b/src/runtime/c/pgf/pgf.cxx @@ -534,9 +534,26 @@ void pgf_create_function(PgfDB *db, PgfRevision revision, absfun->ep.expr = ref::tagged(efun); memcpy(&absfun->name, name, sizeof(PgfText)+name->size+1); - Namespace nmsp = + Namespace funs = namespace_insert(pgf->abstract.funs, absfun); namespace_release(pgf->abstract.funs); - pgf->abstract.funs = nmsp; + pgf->abstract.funs = funs; + } PGF_API_END +} + +PGF_API +void pgf_drop_function(PgfDB *db, PgfRevision revision, + PgfText *name, + PgfExn *err) +{ + PGF_API_BEGIN { + DB_scope scope(db, WRITER_SCOPE); + + ref pgf = PgfDB::revision2pgf(revision); + + Namespace funs = + namespace_delete(pgf->abstract.funs, name); + namespace_release(pgf->abstract.funs); + pgf->abstract.funs = funs; } PGF_API_END } diff --git a/src/runtime/haskell/PGF2/FFI.hsc b/src/runtime/haskell/PGF2/FFI.hsc index b2f1f8cdc..1aa8d6e0e 100644 --- a/src/runtime/haskell/PGF2/FFI.hsc +++ b/src/runtime/haskell/PGF2/FFI.hsc @@ -116,6 +116,8 @@ foreign import ccall pgf_checkout_revision :: Ptr PgfDB -> Ptr PgfText -> Ptr Pg foreign import ccall pgf_create_function :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> StablePtr Type -> (#type prob_t) -> Ptr PgfMarshaller -> Ptr PgfExn -> IO () +foreign import ccall pgf_drop_function :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> Ptr PgfExn -> IO () + ----------------------------------------------------------------------- -- Texts diff --git a/src/runtime/haskell/PGF2/Transactions.hsc b/src/runtime/haskell/PGF2/Transactions.hsc index c6e03f0a2..e67027f97 100644 --- a/src/runtime/haskell/PGF2/Transactions.hsc +++ b/src/runtime/haskell/PGF2/Transactions.hsc @@ -4,6 +4,7 @@ module PGF2.Transactions , branchPGF , checkoutPGF , createFunction + , dropFunction ) where import PGF2.FFI @@ -110,3 +111,8 @@ createFunction name ty prob = Transaction $ \c_db c_revision c_exn -> bracket (newStablePtr ty) freeStablePtr $ \c_ty -> withForeignPtr marshaller $ \m -> do pgf_create_function c_db c_revision c_name c_ty prob m c_exn + +dropFunction :: Fun -> Transaction () +dropFunction name = Transaction $ \c_db c_revision c_exn -> + withText name $ \c_name -> do + pgf_drop_function c_db c_revision c_name c_exn diff --git a/src/runtime/haskell/tests/transactions.hs b/src/runtime/haskell/tests/transactions.hs index 21010f615..3ae455518 100644 --- a/src/runtime/haskell/tests/transactions.hs +++ b/src/runtime/haskell/tests/transactions.hs @@ -12,6 +12,8 @@ main = do Just gr4 <- checkoutPGF gr1 "master" Just gr5 <- checkoutPGF gr1 "bar_branch" + gr6 <- modifyPGF gr1 (dropFunction "ind") + runTestTTAndExit $ TestList $ [TestCase (assertEqual "original functions" ["c","ind","s","z"] (functions gr1)) @@ -19,6 +21,7 @@ main = do ,TestCase (assertEqual "branched functions" ["bar","c","ind","s","z"] (functions gr3)) ,TestCase (assertEqual "checked-out extended functions" ["c","foo","ind","s","z"] (functions gr4)) ,TestCase (assertEqual "checked-out branched functions" ["bar","c","ind","s","z"] (functions gr5)) + ,TestCase (assertEqual "reduced functions" ["c","s","z"] (functions gr6)) ,TestCase (assertEqual "old function type" Nothing (functionType gr1 "foo")) ,TestCase (assertEqual "new function type" (Just ty) (functionType gr2 "foo")) ,TestCase (assertEqual "old function prob" (-log 0) (functionProb gr1 "foo"))