4 files changed, 37 insertions, 7 deletions
diff --git a/src/runtime/haskell-bind/PGF2.hsc b/src/runtime/haskell-bind/PGF2.hsc
index 7910ece81..ad7deb1b1 100644
--- a/src/runtime/haskell-bind/PGF2.hsc
+++ b/src/runtime/haskell-bind/PGF2.hsc
@@ -267,8 +267,7 @@ addLiteral :: Concr -> String -> (Int -> String -> Int -> Maybe (Expr,Float,Int)
 addLiteral lang cat match =
   withCString cat $ \ccat ->
   withGuPool  $ \tmp_pool -> do
-    pool     <- pgf_concr_get_pool (concr lang)
-    callback <- gu_malloc pool (#size PgfLiteralCallback)
+    callback <- hspgf_new_literal_callback (concr lang)
     match    <- wrapLiteralMatchCallback match_callback
     predict  <- wrapLiteralPredictCallback predict_callback
     (#poke PgfLiteralCallback, match)   callback match
@@ -283,7 +282,7 @@ addLiteral lang cat match =
                         msg <- peekCString c_msg
                         throwIO (PGFError msg)
                 else throwIO (PGFError "The literal cannot be added")
-      else do return ()
+      else return ()
   where
     match_callback _ clin_idx csentence poffset out_pool = do
       sentence <- peekCString csentence
diff --git a/src/runtime/haskell-bind/PGF2/FFI.hs b/src/runtime/haskell-bind/PGF2/FFI.hs
index 9b0f9961e..a467f7ddc 100644
--- a/src/runtime/haskell-bind/PGF2/FFI.hs
+++ b/src/runtime/haskell-bind/PGF2/FFI.hs
@@ -97,6 +97,7 @@ data PgfFullFormEntry
 data PgfMorphoCallback
 data PgfPrintContext
 data PgfType
+data PgfLiteralCallback
 
 foreign import ccall "pgf/pgf.h pgf_read"
   pgf_read :: CString -> Ptr GuPool -> Ptr GuExn -> IO (Ptr PgfPGF)
@@ -146,9 +147,6 @@ foreign import ccall "pgf/pgf.h pgf_linearize"
 foreign import ccall "pgf/pgf.h pgf_parse"
   pgf_parse :: Ptr PgfConcr -> CString -> CString -> Ptr GuExn -> Ptr GuPool -> Ptr GuPool -> IO (Ptr GuEnum)
 
-foreign import ccall "pgf/pgf.h pgf_concr_get_pool"
-  pgf_concr_get_pool :: Ptr PgfConcr -> IO (Ptr GuPool)
-
 type LiteralMatchCallback = Ptr () -> CInt -> CString -> Ptr CInt -> Ptr GuPool -> IO (Ptr PgfExprProb)
 
 foreign import ccall "wrapper"
@@ -159,8 +157,11 @@ type LiteralPredictCallback = Ptr () -> CInt -> CString -> Ptr GuPool -> IO (Ptr
 foreign import ccall "wrapper"
   wrapLiteralPredictCallback :: LiteralPredictCallback -> IO (FunPtr LiteralPredictCallback)
 
+foreign import ccall 
+  hspgf_new_literal_callback :: Ptr PgfConcr -> IO (Ptr PgfLiteralCallback)
+
 foreign import ccall "pgf/pgf.h pgf_concr_add_literal"
-  pgf_concr_add_literal :: Ptr PgfConcr -> CString -> Ptr () -> Ptr GuExn -> IO ()
+  pgf_concr_add_literal :: Ptr PgfConcr -> CString -> Ptr PgfLiteralCallback -> Ptr GuExn -> IO ()
 
 foreign import ccall "pgf/pgf.h pgf_lookup_morpho"
   pgf_lookup_morpho :: Ptr PgfConcr -> CString -> Ptr PgfMorphoCallback -> Ptr GuExn -> IO ()
diff --git a/src/runtime/haskell-bind/pgf2-bind.cabal b/src/runtime/haskell-bind/pgf2-bind.cabal
index f2496e7eb..3d505de35 100644
--- a/src/runtime/haskell-bind/pgf2-bind.cabal
+++ b/src/runtime/haskell-bind/pgf2-bind.cabal
@@ -28,6 +28,7 @@ library
   extra-libraries:     gu pgf
   cc-options:          -std=c99
   default-language:    Haskell2010
+  c-sources:           utils.c
 
 executable pgf-shell
   main-is:             pgf-shell.hs
diff --git a/src/runtime/haskell-bind/utils.c b/src/runtime/haskell-bind/utils.c
new file mode 100644
index 000000000..8ab1e53e3
--- /dev/null
+++ b/src/runtime/haskell-bind/utils.c
@@ -0,0 +1,29 @@
+#include <HsFFI.h>
+#include <pgf/pgf.h>
+
+typedef struct {
+	PgfLiteralCallback callback;
+	GuFinalizer fin;
+} HSPgfLiteralCallback;
+
+static void 
+hspgf_literal_callback_fin(GuFinalizer* self)
+{
+	HSPgfLiteralCallback* callback = gu_container(self, HSPgfLiteralCallback, fin);
+	
+	if (callback->callback.match != NULL)
+		hs_free_fun_ptr((HsFunPtr) callback->callback.match);
+	if (callback->callback.predict != NULL)
+		hs_free_fun_ptr((HsFunPtr) callback->callback.predict);
+}
+
+PgfLiteralCallback*
+hspgf_new_literal_callback(PgfConcr* concr) {
+	GuPool* pool = pgf_concr_get_pool(concr);
+	HSPgfLiteralCallback* callback = gu_new(HSPgfLiteralCallback, pool);
+	callback->callback.match   = NULL;
+	callback->callback.predict = NULL;
+	callback->fin.fn = hspgf_literal_callback_fin;
+	gu_pool_finally(pool, &callback->fin);
+	return &callback->callback;
+}