added dropFunction

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<A>& other) const { return offset==other->offset; }
+    bool operator ==(ref<A>& other) const { return offset==other.as_object(); }
-    bool operator !=(ref<A>& other) const { return offset!=other->offset; }
+    bool operator !=(ref<A>& 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; }
 

src/runtime/c/pgf/namespace.h

@@ -287,7 +287,87 @@ Namespace<V> namespace_insert(Namespace<V> map, ref<V> value)
         return Node<V>::new_node(value,map->left,map->right);
     }
 }
-    
+
+template <class V>
+Namespace<V> namespace_delete(Namespace<V> map, PgfText* name)
+{
+    if (map == 0)
+        return 0;
+
+    int cmp = textcmp(name,&map->value->name);
+    if (cmp < 0) {
+        Namespace<V> left = namespace_delete(map->left, name);
+        if (left == map->left)
+            return map;
+        Namespace<V> node = Node<V>::balanceR(map->value,left,map->right);
+        namespace_release(left);
+        return node;
+    } else if (cmp > 0) {
+        Namespace<V> right = namespace_delete(map->right, name);
+        if (right == map->right)
+            return map;
+        Namespace<V> node  = Node<V>::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<V> value;
+            Namespace<V> new_left = namespace_pop_last(map->left, &value);
+            Namespace<V> node = Node<V>::balanceR(value, new_left, map->right);
+            namespace_release(new_left);
+            return node;
+        } else {
+            ref<V> value;
+            Namespace<V> new_right = namespace_pop_first(map->right, &value);
+            Namespace<V> node = Node<V>::balanceL(value, map->left, new_right);
+            namespace_release(new_right);
+            return node;
+        }
+    }
+}
+
+template <class V>
+Namespace<V> namespace_pop_first(Namespace<V> map, ref<V> *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<V> new_left = namespace_pop_first(map->left, res);
+        Namespace<V> node = Node<V>::balanceR(map->value, new_left, map->right);
+        namespace_release(new_left);
+        return node;
+    }
+}
+
+template <class V>
+Namespace<V> namespace_pop_last(Namespace<V> map, ref<V> *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<V> new_right = namespace_pop_last(map->right, res);
+        return Node<V>::balanceR(map->value, map->left, new_right);
+    }
+}
+
 template <class V>
 ref<V> namespace_lookup(Namespace<V> map, PgfText *name)
 {

src/runtime/c/pgf/pgf.cxx

@@ -534,9 +534,26 @@ void pgf_create_function(PgfDB *db, PgfRevision revision,
         absfun->ep.expr = ref<PgfExprFun>::tagged(efun);
         memcpy(&absfun->name, name, sizeof(PgfText)+name->size+1);
         
-        Namespace<PgfAbsFun> nmsp =
+        Namespace<PgfAbsFun> 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<PgfPGF> pgf = PgfDB::revision2pgf(revision);
+
+        Namespace<PgfAbsFun> funs =
+            namespace_delete(pgf->abstract.funs, name);
+        namespace_release(pgf->abstract.funs);
+        pgf->abstract.funs = funs;
     } PGF_API_END
 }

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

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

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"))