cleanup the code for the FFI binding. The API is now more uniform with the Python and the Java bindings. Fixed a lot of memory leaks.

7 files changed, 312 insertions, 571 deletions

diff --git a/src/runtime/haskell-bind/CId.hs b/src/runtime/haskell-bind/CId.hs
deleted file mode 100644
index 74db63c2c..000000000
--- a/src/runtime/haskell-bind/CId.hs
+++ /dev/null
@@ -1,56 +0,0 @@
-module CId (CId(..), 
-                mkCId, wildCId,
-                readCId, showCId,
-                
-                -- utils
-                pCId, pIdent, ppCId) where
-
-import Control.Monad
-import qualified Data.ByteString.Char8 as BS
-import Data.Char
-import qualified Text.ParserCombinators.ReadP as RP
-import qualified Text.PrettyPrint as PP
-
-
-
--- | An abstract data type that represents
--- identifiers for functions and categories in PGF.
-newtype CId = CId BS.ByteString deriving (Eq,Ord)
-
-wildCId :: CId
-wildCId = CId (BS.singleton '_')
-
--- | Creates a new identifier from 'String'
-mkCId :: String -> CId
-mkCId s = CId (BS.pack s)
-
--- | Reads an identifier from 'String'. The function returns 'Nothing' if the string is not valid identifier.
-readCId :: String -> Maybe CId
-readCId s = case [x | (x,cs) <- RP.readP_to_S pCId s, all isSpace cs] of
-              [x] -> Just x
-              _   -> Nothing
-
--- | Renders the identifier as 'String'
-showCId :: CId -> String
-showCId (CId x) = BS.unpack x
-
-instance Show CId where
-    showsPrec _ = showString . showCId
-
-instance Read CId where
-    readsPrec _ = RP.readP_to_S pCId
-
-pCId :: RP.ReadP CId
-pCId = do s <- pIdent
-          if s == "_"
-            then RP.pfail
-            else return (mkCId s)
-
-pIdent :: RP.ReadP String
-pIdent = liftM2 (:) (RP.satisfy isIdentFirst) (RP.munch isIdentRest)
-  where
-    isIdentFirst c = c == '_' || isLetter c
-    isIdentRest c = c == '_' || c == '\'' || isAlphaNum c
-
-ppCId :: CId -> PP.Doc
-ppCId = PP.text . showCId
diff --git a/src/runtime/haskell-bind/CRuntimeFFI.hsc b/src/runtime/haskell-bind/CRuntimeFFI.hsc
deleted file mode 100644
index 6564ac70e..000000000
--- a/src/runtime/haskell-bind/CRuntimeFFI.hsc
+++ /dev/null
@@ -1,310 +0,0 @@
-{-# LANGUAGE ForeignFunctionInterface, ExistentialQuantification, TypeSynonymInstances, FlexibleInstances #-}
-#include <pgf/pgf.h>
-#include <gu/enum.h>
-#include <gu/exn.h>
-
-module CRuntimeFFI(-- * PGF
-                   PGF,readPGF,abstractName,startCat,
-                   -- * Concrete syntax
-                   Concr,Language,languages,getConcr,parse,linearize,
-                   -- * Trees
-                   Expr,Tree,readExpr,showExpr,unApp,
-                   -- * Morphology
-                   MorphoAnalysis,lookupMorpho,fullFormLexicon,
-                   printLexEntry,
-                   ) where
-
-import Prelude hiding (fromEnum)
-import Control.Exception
-import System.IO
-import System.IO.Unsafe
-import CId (CId(..), 
-            mkCId, wildCId,
-            readCId, showCId)
-import Gu
-import PgfLow
-
-import Foreign hiding ( Pool, newPool, unsafePerformIO )
-import Foreign.C
-import Foreign.C.String
-import Foreign.Ptr
-
-
-import Data.Char
-import Data.Map (Map, empty, insert)
-import qualified Data.ByteString as BS
-import Data.IORef
-
-
------------------------------------------------------------------------------
--- How to compile
--- hsc2hs Gu.hsc CRuntimeFFI.hsc -v --cflag="-std=c99" && ghc -lpgf -lgu --make CRuntimeFFI 
------------------------------------------------------------------------------
--- Mindless copypasting and translating of the C functions in Gu.hsc and PgfLow.hs
--- More user-friendly functions here 
-
------------------------------------------------------------------------------
---Memory management, pools and outs
-type Pool = ForeignPtr GuPool
-type Out = (Ptr GuStringBuf, Ptr GuOut)
-
-
---when you create a GuOut, you create also a GuStringBuf
---and when you give GuOut to a function that outputs something,
---the result goes into that GuStringBuf
-newOut :: Ptr GuPool -> IO Out 
-newOut pool =
-   do sb <- gu_string_buf pool
-      out <- gu_string_buf_out sb
-      return (sb,out)
---Don't create newOut using withGuPool inside
---Rather do like this:
-{-
-withGuPool $ \pl ->
-  do out <- newOut pl
-     <other stuff>
--}
-  -- withGuPool $ \pl -> 
-  --   do sb <- gu_string_buf pl
-  --      out <- gu_string_buf_out sb
-  --      return (sb,out)
-
-
------------------------------------------------------------------------------
--- Functions that take a PGF.
--- PGF has many Concrs.
--- A Concr retains its PGF in a field (memory management reasons?)
-
-data PGF = PGF {pgfPool :: Ptr GuPool, pgf :: Ptr PgfPGF} deriving Show
-data Concr = Concr {concr :: (Ptr PgfConcr), concrMaster :: PGF}
-type Language = CId
-
-readPGF :: FilePath -> IO PGF
-readPGF filepath =
-  do pl <- gu_new_pool
-     pgf <- withCString filepath $ \file -> 
-              pgf_read file pl nullPtr
-     return PGF {pgfPool = pl, pgf = pgf}
-
-
-getConcr :: PGF -> Language -> Maybe Concr
-getConcr p (CId lang) = unsafePerformIO $
-    BS.useAsCString lang $ \lng -> do
-        cnc <- pgf_get_language (pgf p) lng
-        return (if cnc==nullPtr then Nothing else Just (Concr cnc p))
-
-
-languages :: PGF -> Map Language Concr
-languages p = unsafePerformIO $
-    do ref <- newIORef empty
-       allocaBytes (#size GuMapItor) $ \itor ->
-                   do fptr <- wrapLanguages (getLanguages ref)
-                      (#poke GuMapItor, fn) itor fptr
-                      pgf_iter_languages (pgf p) itor nullPtr
-       readIORef ref
-    where
-       getLanguages :: IORef (Map Language Concr) -> Languages
-       getLanguages ref itor key value exn = do
-         langs <- readIORef ref
-         key'  <- fmap CId  $ BS.packCString (castPtr key)
-         value' <- fmap (\ptr -> Concr ptr p) $  peek (castPtr value)
-         writeIORef ref (insert key' value' langs)
---type Languages = Ptr GuMapItor -> Ptr () -> Ptr () -> Ptr GuExn -> IO (
-
-
-generateAll :: PGF -> CId -> [(Tree,Float)]
-generateAll p (CId cat) = unsafePerformIO $
-  withGuPool $ \iterPl ->
---    withGuPool $ \exprPl -> --segfaults if I use this
-      do exprPl <- gu_new_pool
-         pgfExprs <- BS.useAsCString cat $ \cat ->
-                     pgf_generate_all (pgf p) cat exprPl --this pool isn't freed. segfaults if I try.
-         fromPgfExprEnum pgfExprs iterPl p --this pool is freed afterwards. it's used in fromPgfExprEnum, and I imagine it makes more sense to give a pool as an argument, rather than in that function create and free new pools in its body (it calls itself recursively)
-         
-
-abstractName :: PGF -> Language
-abstractName p = unsafePerformIO $ fmap CId (BS.packCString =<< pgf_abstract_name (pgf p))
-
-startCat :: PGF -> CId
-startCat p = unsafePerformIO $ fmap CId (BS.packCString =<< pgf_start_cat (pgf p))
-
-printGrammar :: PGF -> String
-printGrammar p = unsafePerformIO $
-  withGuPool $ \outPl ->
-    withGuPool $ \printPl ->
-      do (sb,out) <- newOut outPl
-         pgf_print (pgf p) out nullPtr --nullPtr is for exception
-         grammar <- gu_string_buf_freeze sb printPl
-         peekCString grammar
- 
-
------------------------------------------------------------------------------
--- Expressions
-
---exprMaster is one of the following: 
--- * PGF 
--- * pool from which the expr is allocated
--- * iterator from generateAll
--- TODO ask more about this design
--- the master of an Expr needs to be retained because of memory management (?)
-data Expr = forall a . Expr {expr :: PgfExpr, exprMaster :: a}
-
-instance Show Expr where
-  show = showExpr
-
-instance Eq Expr where
-  (Expr e1 m1) == (Expr e2 m2) = e1 == e2
-
-type Tree = Expr
-
-
-unApp :: Expr -> Maybe (CId,[Expr])
-unApp (Expr expr master) = unsafePerformIO $
-  withGuPool $ \pl -> do
-     pgfAppl <- pgf_expr_unapply expr pl
-     if pgfAppl == nullPtr
-       then return Nothing
-       else do 
-          fun <- peekCString =<< (#peek PgfApplication, fun) pgfAppl
-          arity <- (#peek PgfApplication, n_args) pgfAppl :: IO CInt 
-          pgfExprs <- ptrToList pgfAppl (fromIntegral arity) --CInt to Int
-          --print (arity,fun)
-          let args = [Expr a master | a<-pgfExprs]
-          return $ Just (mkCId fun, args)
-
---Krasimir recommended not to use PgfApplication, but PgfExprApp instead.
---but then we found out that some of those functions don't behave nicely 
---with the FFI, so we need to use PgfApplication anyway, unless we do some
---C coding to make the C library nicer.
-
-
-readExpr :: String -> Maybe Expr
-readExpr str = unsafePerformIO $
- do exprPl <- gu_new_pool  --we return this pool with the Expr
-    withGuPool $ \inPl ->   --these pools are freed right after
-      withGuPool $ \exnPl ->
-        withCString str $ \str ->
-         do guin <- gu_string_in str inPl
-            exn <- gu_new_exn nullPtr gu_type__type exnPl
-            pgfExpr <- pgf_read_expr guin exprPl exn
-            status <- gu_exn_is_raised exn
-            if (status==False && pgfExpr /= nullPtr)
-              then return $ Just (Expr pgfExpr exprPl)
-              else do
-                   gu_pool_free exprPl --if Expr is not returned, free pool
-                   return Nothing
-
--- TODO: do we need 3 different pools for this?
-showExpr :: Expr -> String
-showExpr e = unsafePerformIO $
-  withGuPool $ \pl ->
-    do (sb,out) <- newOut pl
-       let printCtxt = nullPtr
-       exn <- gu_new_exn nullPtr gu_type__type pl
-       pgf_print_expr (expr e) printCtxt 1 out exn
-       abstree <- gu_string_buf_freeze sb pl
-       peekCString abstree
-
-
------------------------------------------------------------------------------
--- Functions using Concr
--- Morpho analyses, parsing & linearization
-
-type MorphoAnalysis = (CId,String,Float)
-
-
---There is no buildMorpho in the C library, just a lookupMorpho from a Concr
-lookupMorpho :: Concr -> String -> [MorphoAnalysis]
-lookupMorpho (Concr concr master) sent = unsafePerformIO $
-  do ref <- newIORef []
-     allocaBytes (#size PgfMorphoCallback) $ \cback -> 
-                        do fptr <- wrapLookupMorpho (getAnalysis ref)
-                           (#poke PgfMorphoCallback, callback) cback fptr
-                           withCString sent $ \sent ->
-                             pgf_lookup_morpho concr sent cback nullPtr
-
-     readIORef ref
-  where 
-    getAnalysis :: IORef [MorphoAnalysis] -> Ptr PgfMorphoCallback -> CString -> CString -> Float -> Ptr GuExn -> IO () --IORef [(CId, String, Float)] -> Callback
-    getAnalysis ref self clemma canal prob exn = do
-      ans <- readIORef ref
-      lemma <- fmap CId (BS.packCString clemma)
-      anal  <- peekCString canal
-      writeIORef ref ((lemma, anal, prob):ans)
-
-fullFormLexicon :: Concr -> [(String, [MorphoAnalysis])]
-fullFormLexicon lang = 
-  let lexicon  = fullformLexicon' lang
-      analyses = map (lookupMorpho lang) lexicon
-  in  zip lexicon analyses
-  where fullformLexicon' :: Concr -> [String]
-        fullformLexicon' lang = unsafePerformIO $
-            do pl <- gu_new_pool
-               lexEnum <- pgf_fullform_lexicon (concr lang) pl
-               fromFullFormEntry lexEnum  pl (concrMaster lang)
-
-printLexEntry :: (String, [MorphoAnalysis]) -> String
-printLexEntry (lemma, anals) = 
-  "Lemma: " ++ lemma ++ "\nAnalyses: " ++ show anals ++ "\n" -- map show' anals
---      where show' :: MorphoAnalysis -> String
---            show' (id,anal,prob) = showCId id ++ ", " ++ anal ++ ", " ++ show prob ++ "\n"
-
-
---Note: unlike in Haskell library, we give Concr -> ... and not PGF -> Lang -> ...
---Also this returns a list of tuples (tree,prob) instead of just trees
-parse :: Concr -> CId -> String -> [(Tree,Float)]
-parse (Concr lang master) (CId cat) sent = unsafePerformIO $
-   withGuPool $ \iterPl ->   -- this pool will get freed eventually
-     do inpool      <- gu_new_pool
-        outpool     <- gu_new_pool
-        treesEnum   <- parse_ lang cat sent inpool outpool
-        outpoolFPtr <- newForeignPtr gu_pool_free_ptr outpool
-        fromPgfExprEnum treesEnum iterPl (master,outpoolFPtr)
-  where  
-    parse_ :: Ptr PgfConcr -> BS.ByteString -> String -> Ptr GuPool -> Ptr GuPool -> IO (Ptr PgfExprEnum)
-    parse_ pgfcnc cat sent inpool outpool =
-      do BS.useAsCString cat $ \cat ->
-           withCString sent $ \sent ->
-             pgf_parse pgfcnc cat sent nullPtr inpool outpool
-
-
---In Haskell library, this function has type signature PGF -> Language -> Tree -> String
---Here we replace PGF -> Language with Concr
-linearize :: Concr -> Tree -> String
-linearize lang tree = unsafePerformIO $
-  withGuPool $ \outPl ->
-    withGuPool $ \linPl ->
-     do (sb,out) <- newOut outPl
-        pgf_linearize (concr lang) (expr tree) out nullPtr --linearization goes to stringbuf
-        lin <- gu_string_buf_freeze sb linPl
-        peekCString lin
-
-
------------------------------------------------------------------------------
--- Helper functions
-
--- # syntax: http://www.haskell.org/ghc/docs/7.2.1/html/users_guide/hsc2hs.html
-fromPgfExprEnum :: Ptr PgfExprEnum -> Ptr GuPool -> a -> IO [(Tree, Float)]
-fromPgfExprEnum enum pl master = 
-  do pgfExprProb <- alloca $ \ptr -> 
-                      do gu_enum_next enum ptr pl
-                         peek ptr
-     if pgfExprProb == nullPtr
-       then return []
-       else do expr <- (#peek PgfExprProb, expr) pgfExprProb
-               prob <- (#peek PgfExprProb, prob) pgfExprProb
-               ts <- unsafeInterleaveIO (fromPgfExprEnum enum pl master)
-               return ((Expr expr master,prob) : ts)
-
-
-fromFullFormEntry :: Ptr GuEnum -> Ptr GuPool -> PGF -> IO [String]
-fromFullFormEntry enum pl master = 
-  do ffEntry <- alloca $ \ptr ->
-                  do gu_enum_next enum ptr pl
-                     peek ptr 
---   ffEntry :: Ptr PgfFullFormEntry
-     if ffEntry == nullPtr
-       then return []
-       else do tok <- peekCString =<< pgf_fullform_get_string ffEntry
-               toks <- unsafeInterleaveIO (fromFullFormEntry enum pl master)
-               return (tok : toks)
diff --git a/src/runtime/haskell-bind/Gu.hsc b/src/runtime/haskell-bind/Gu.hsc
deleted file mode 100644
index 20a728c79..000000000
--- a/src/runtime/haskell-bind/Gu.hsc
+++ /dev/null
@@ -1,127 +0,0 @@
-{-# LANGUAGE ForeignFunctionInterface #-}
-#include <pgf/pgf.h>
-#include <gu/enum.h>
-#include <gu/exn.h>
-
-module Gu where
-
-import Foreign
-import Foreign.C
-import Foreign.C.String
-import Foreign.Ptr
-import Control.Exception
-
-
-data GuEnum
-data GuExn
-data GuIn
-data GuInStream
-data GuKind
-data GuString
-data GuStringBuf
-data GuMapItor
-data GuOut
-data GuOutStream
-data GuPool
-
-data PgfPGF
-data PgfApplication
-data PgfConcr
-type PgfExpr = Ptr ()
-data PgfExprEnum
-data PgfExprProb
-data PgfFullFormEntry
-data PgfMorphoCallback
-data PgfPrintContext
-data PgfType
-data PgfLexer
-
-------------------------------------------------------------------------------
--- Mindless copypasting and translating of the C functions used in CRuntimeFFI
--- GU stuff
-
-
-
-foreign import ccall "gu/mem.h gu_new_pool"
-  gu_new_pool :: IO (Ptr GuPool)
-
-foreign import ccall "gu/mem.h gu_pool_free"
-  gu_pool_free :: Ptr GuPool -> IO ()
-
-foreign import ccall "gu/mem.h &gu_pool_free"
-  gu_pool_free_ptr :: FunPtr (Ptr GuPool -> IO ())
-
-foreign import ccall "gu/exn.h gu_new_exn"
-  gu_new_exn :: Ptr GuExn -> Ptr GuKind -> Ptr GuPool -> IO (Ptr GuExn)
-
-foreign import ccall "gu/exn.h gu_exn_is_raised"
-  gu_exn_is_raised :: Ptr GuExn -> IO Bool
--- gu_ok exn = do
---   state <- (#peek GuExn, state) exn
---   return (state /= GU_EXN_RAISED)
-
-foreign import ccall "gu/type.h &gu_type__type"
-  gu_type__type :: Ptr GuKind
-
-
---GuIn* gu_string_in(GuString string, GuPool* pool);
-foreign import ccall "gu/string.h gu_string_in"
-  gu_string_in :: CString -> Ptr GuPool -> IO (Ptr GuIn)
-
---GuStringBuf* gu_string_buf(GuPool* pool);
-foreign import ccall "gu/string.h gu_string_buf"
-  gu_string_buf :: Ptr GuPool -> IO (Ptr GuStringBuf)
-
---GuOut* gu_string_buf_out(GuStringBuf* sb);
-foreign import ccall "gu/string.h gu_string_buf_out"
-  gu_string_buf_out :: Ptr GuStringBuf -> IO (Ptr GuOut)
-
-
---void gu_enum_next(GuEnum* en, void* to, GuPool* pool)
-foreign import ccall "gu/enum.h gu_enum_next"
-  gu_enum_next :: Ptr a -> Ptr (Ptr b) -> Ptr GuPool -> IO ()
-
-
---GuString gu_string_buf_freeze(GuStringBuf* sb, GuPool* pool);
-foreign import ccall "gu/string.h gu_string_buf_freeze"
-  gu_string_buf_freeze :: Ptr GuStringBuf -> Ptr GuPool -> IO CString
-
-{-
-typedef struct PgfMorphoCallback PgfMorphoCallback;
-struct PgfMorphoCallback {
-       void (*callback)(PgfMorphoCallback* self,
-                        PgfCId lemma, GuString analysis, prob_t prob,
-			                 GuExn* err);
-};
---allocate this type of structure in haskell
---make a function and do Something
--}
-
-{- Not used
---GuIn* gu_new_in(GuInStream* stream, GuPool* pool);
-foreign import ccall "gu/in.h gu_new_in"
-  gu_new_in :: Ptr GuInStream -> Ptr GuPool -> Ptr GuIn
-
---GuOut* gu_new_out(GuOutStream* stream, GuPool* pool);
-foreign import ccall "gu/mem.h gu_new_out"
-  gu_new_out :: Ptr GuOutStream -> Ptr GuPool -> IO (Ptr GuOut)
---TODO no idea how to get a GuOutStream
-
---GuOut* gu_file_out(FILE* file, GuPool* pool);
-foreign import ccall "gu/file.h gu_file_out"
-  gu_file_out :: Ptr CString -> Ptr GuPool -> IO (Ptr GuOut) -}
-
-
---Pointer magic here, using plusPtr etc.
-ptrToList :: Ptr PgfApplication -> Int -> IO [PgfExpr]
-ptrToList appl arity = do
-  let ptr = appl `plusPtr` (#offset PgfApplication, args) --args is not an argument, it's the actual field name
-  sequence [peek (ptr `plusPtr` (i * (#size PgfExpr))) | i<-[0..arity-1]]
-
-withGuPool :: (Ptr GuPool -> IO a) -> IO a
-withGuPool f = do
-  pl <- gu_new_pool
-  f pl `finally` gu_pool_free pl
-  -- for true haskell persons
-  -- withGuPool f = bracket gu_new_pool gu_pool_free f
-
diff --git a/src/runtime/haskell-bind/PGF2.hsc b/src/runtime/haskell-bind/PGF2.hsc
new file mode 100644
index 000000000..06bf30ef0
--- /dev/null
+++ b/src/runtime/haskell-bind/PGF2.hsc
@@ -0,0 +1,232 @@
+{-# LANGUAGE ExistentialQuantification #-}
+#include <pgf/pgf.h>
+#include <gu/enum.h>
+#include <gu/exn.h>
+
+module PGF2 (-- * PGF
+             PGF,readPGF,abstractName,startCat,
+             -- * Concrete syntax
+             Concr,languages,parse,linearize,
+             -- * Trees
+             Expr,readExpr,showExpr,unApp,
+             -- * Morphology
+             MorphoAnalysis, lookupMorpho, fullFormLexicon,
+            ) where
+
+import Prelude hiding (fromEnum)
+import Control.Exception
+import System.IO
+import System.IO.Unsafe
+import PGF2.FFI
+
+import Foreign hiding ( Pool, newPool, unsafePerformIO )
+import Foreign.C
+import Foreign.C.String
+import Foreign.Ptr
+import Data.Char
+import qualified Data.Map as Map
+import qualified Data.ByteString as BS
+import Data.IORef
+
+
+-----------------------------------------------------------------------------
+-- Functions that take a PGF.
+-- PGF has many Concrs.
+--
+-- A Concr retains its PGF in a field in order to retain a reference to
+-- the foreign pointer in case if the application still has a reference
+-- to Concr but has lost its reference to PGF.
+
+data PGF = PGF {pgf :: Ptr PgfPGF, pgfMaster :: ForeignPtr GuPool}
+data Concr = Concr {concr :: Ptr PgfConcr, concrMaster :: PGF}
+
+readPGF :: FilePath -> IO PGF
+readPGF fpath =
+  do pool <- gu_new_pool
+     pgf  <- withCString fpath $ \c_fpath -> 
+               pgf_read c_fpath pool nullPtr
+     master <- newForeignPtr gu_pool_finalizer pool
+     return PGF {pgf = pgf, pgfMaster = master}
+
+languages :: PGF -> Map.Map String Concr
+languages p =
+  unsafePerformIO $
+    do ref <- newIORef Map.empty
+       allocaBytes (#size GuMapItor) $ \itor ->
+                   do fptr <- wrapMapItorCallback (getLanguages ref)
+                      (#poke GuMapItor, fn) itor fptr
+                      pgf_iter_languages (pgf p) itor nullPtr
+       readIORef ref
+  where
+    getLanguages :: IORef (Map.Map String Concr) -> MapItorCallback
+    getLanguages ref itor key value exn = do
+      langs <- readIORef ref
+      name  <- peekCString (castPtr key)
+      concr <- fmap (\ptr -> Concr ptr p) $ peek (castPtr value)
+      writeIORef ref $! Map.insert name concr langs
+
+generateAll :: PGF -> String -> [(Expr,Float)]
+generateAll p cat =
+  unsafePerformIO $
+    do genPl  <- gu_new_pool
+       exprPl <- gu_new_pool
+       enum   <- withCString cat $ \cat ->
+                   pgf_generate_all (pgf p) cat genPl
+       genFPl  <- newForeignPtr gu_pool_finalizer genPl
+       exprFPl <- newForeignPtr gu_pool_finalizer exprPl
+       fromPgfExprEnum enum genFPl (p,exprFPl)
+
+abstractName :: PGF -> String
+abstractName p = unsafePerformIO (peekCString =<< pgf_abstract_name (pgf p))
+
+startCat :: PGF -> String
+startCat p = unsafePerformIO (peekCString =<< pgf_start_cat (pgf p))
+ 
+
+-----------------------------------------------------------------------------
+-- Expressions
+
+-- The C structure for the expression may point to other structures
+-- which are allocated from other pools. In order to ensure that
+-- they are not released prematurely we use the exprMaster to
+-- store references to other Haskell objects
+
+data Expr = forall a . Expr {expr :: PgfExpr, exprMaster :: a}
+
+instance Show Expr where
+  show = showExpr
+
+unApp :: Expr -> Maybe (String,[Expr])
+unApp (Expr expr master) =
+  unsafePerformIO $
+    withGuPool $ \pl -> do
+      appl <- pgf_expr_unapply expr pl
+      if appl == nullPtr
+        then return Nothing
+        else do 
+           fun <- peekCString =<< (#peek PgfApplication, fun) appl
+           arity <- (#peek PgfApplication, n_args) appl :: IO CInt 
+           c_args <- peekArray (fromIntegral arity) (appl `plusPtr` (#offset PgfApplication, args))
+           return $ Just (fun, [Expr c_arg master | c_arg <- c_args])
+
+readExpr :: String -> Maybe Expr
+readExpr str =
+  unsafePerformIO $
+    do exprPl <- gu_new_pool
+       withGuPool $ \tmpPl ->
+         withCString str $ \c_str ->
+           do guin <- gu_string_in c_str tmpPl
+              exn <- gu_new_exn nullPtr gu_type__type tmpPl
+              c_expr <- pgf_read_expr guin exprPl exn
+              status <- gu_exn_is_raised exn
+              if (not status && c_expr /= nullPtr)
+                then do exprFPl <- newForeignPtr gu_pool_finalizer exprPl
+                        return $ Just (Expr c_expr exprFPl)
+                else do gu_pool_free exprPl
+                        return Nothing
+
+showExpr :: Expr -> String
+showExpr e = 
+  unsafePerformIO $
+    withGuPool $ \tmpPl ->
+      do (sb,out) <- newOut tmpPl
+         let printCtxt = nullPtr
+         exn <- gu_new_exn nullPtr gu_type__type tmpPl
+         pgf_print_expr (expr e) printCtxt 1 out exn
+         s <- gu_string_buf_freeze sb tmpPl
+         peekCString s
+
+
+-----------------------------------------------------------------------------
+-- Functions using Concr
+-- Morpho analyses, parsing & linearization
+
+type MorphoAnalysis = (String,String,Float)
+
+lookupMorpho :: Concr -> String -> [MorphoAnalysis]
+lookupMorpho (Concr concr master) sent = unsafePerformIO $
+  do ref <- newIORef []
+     allocaBytes (#size PgfMorphoCallback) $ \cback -> 
+                        do fptr <- wrapLookupMorphoCallback (getAnalysis ref)
+                           (#poke PgfMorphoCallback, callback) cback fptr
+                           withCString sent $ \c_sent ->
+                             pgf_lookup_morpho concr c_sent cback nullPtr
+     readIORef ref
+
+fullFormLexicon :: Concr -> [(String, [MorphoAnalysis])]
+fullFormLexicon lang =
+  unsafePerformIO $
+    do pl <- gu_new_pool
+       enum <- pgf_fullform_lexicon (concr lang) pl
+       fpl <- newForeignPtr gu_pool_finalizer pl
+       fromFullFormEntry enum fpl
+  where
+    fromFullFormEntry :: Ptr GuEnum -> ForeignPtr GuPool -> IO [(String, [MorphoAnalysis])]
+    fromFullFormEntry enum fpl =
+      do ffEntry <- alloca $ \ptr ->
+                      withForeignPtr fpl $ \pl ->
+                        do gu_enum_next enum ptr pl
+                           peek ptr
+         if ffEntry == nullPtr
+           then do finalizeForeignPtr fpl
+                   return []
+           else do tok  <- peekCString =<< pgf_fullform_get_string ffEntry
+                   ref  <- newIORef []
+                   allocaBytes (#size PgfMorphoCallback) $ \cback ->
+                        do fptr <- wrapLookupMorphoCallback (getAnalysis ref)
+                           (#poke PgfMorphoCallback, callback) cback fptr
+                           pgf_fullform_get_analyses ffEntry cback nullPtr
+                   ans  <- readIORef ref
+                   toks <- unsafeInterleaveIO (fromFullFormEntry enum fpl)
+                   return ((tok,ans) : toks)
+
+getAnalysis :: IORef [MorphoAnalysis] -> LookupMorphoCallback
+getAnalysis ref self c_lemma c_anal prob exn = do
+  ans <- readIORef ref
+  lemma <- peekCString c_lemma
+  anal  <- peekCString c_anal
+  writeIORef ref ((lemma, anal, prob):ans)
+
+parse :: Concr -> String -> String -> [(Expr,Float)]
+parse lang cat sent =
+  unsafePerformIO $
+    do parsePl <- gu_new_pool
+       exprPl  <- gu_new_pool
+       enum    <- withCString cat $ \cat ->
+                    withCString sent $ \sent ->
+                      pgf_parse (concr lang) cat sent nullPtr parsePl exprPl
+       parseFPl <- newForeignPtr gu_pool_finalizer parsePl
+       exprFPl  <- newForeignPtr gu_pool_finalizer exprPl
+       fromPgfExprEnum enum parseFPl (lang,exprFPl)
+
+linearize :: Concr -> Expr -> String
+linearize lang e = unsafePerformIO $
+  withGuPool $ \pl ->
+    do (sb,out) <- newOut pl
+       pgf_linearize (concr lang) (expr e) out nullPtr
+       lin <- gu_string_buf_freeze sb pl
+       peekCString lin
+
+
+-----------------------------------------------------------------------------
+-- Helper functions
+
+newOut :: Ptr GuPool -> IO (Ptr GuStringBuf, Ptr GuOut)
+newOut pool =
+   do sb <- gu_string_buf pool
+      out <- gu_string_buf_out sb
+      return (sb,out)
+
+fromPgfExprEnum :: Ptr GuEnum -> ForeignPtr GuPool -> a -> IO [(Expr, Float)]
+fromPgfExprEnum enum fpl master =
+  do pgfExprProb <- alloca $ \ptr ->
+                      withForeignPtr fpl $ \pl ->
+                        do gu_enum_next enum ptr pl
+                           peek ptr
+     if pgfExprProb == nullPtr
+       then do finalizeForeignPtr fpl
+               return []
+       else do expr <- (#peek PgfExprProb, expr) pgfExprProb
+               ts <- unsafeInterleaveIO (fromPgfExprEnum enum fpl master)
+               prob <- (#peek PgfExprProb, prob) pgfExprProb
+               return ((Expr expr master,prob) : ts)
diff --git a/src/runtime/haskell-bind/PgfLow.hs b/src/runtime/haskell-bind/PGF2/FFI.hs
index 0caad1ab9..c0a9adf0a 100644
--- a/src/runtime/haskell-bind/PgfLow.hs
+++ b/src/runtime/haskell-bind/PGF2/FFI.hs
@@ -1,152 +1,154 @@
 {-# LANGUAGE ForeignFunctionInterface #-}
 
-module PgfLow where
+module PGF2.FFI where
 
 import Foreign.C
 import Foreign.C.String
 import Foreign.Ptr
-import Gu
+import Foreign.ForeignPtr
+import Control.Exception
 
-------------------------------------------------------------------------------
--- Mindless copypasting and translating of the C functions used in CRuntimeFFI
--- From pgf.h
+------------------------------------------------------------------
+-- libgu API
 
+data GuEnum
+data GuExn
+data GuIn
+data GuKind
+data GuString
+data GuStringBuf
+data GuMapItor
+data GuOut
+data GuPool
 
+foreign import ccall "gu/mem.h gu_new_pool"
+  gu_new_pool :: IO (Ptr GuPool)
+
+foreign import ccall "gu/mem.h gu_pool_free"
+  gu_pool_free :: Ptr GuPool -> IO ()
+
+foreign import ccall "gu/mem.h &gu_pool_free"
+  gu_pool_finalizer :: FinalizerPtr GuPool
+
+foreign import ccall "gu/exn.h gu_new_exn"
+  gu_new_exn :: Ptr GuExn -> Ptr GuKind -> Ptr GuPool -> IO (Ptr GuExn)
+
+foreign import ccall "gu/exn.h gu_exn_is_raised"
+  gu_exn_is_raised :: Ptr GuExn -> IO Bool
+
+foreign import ccall "gu/type.h &gu_type__type"
+  gu_type__type :: Ptr GuKind
+
+foreign import ccall "gu/string.h gu_string_in"
+  gu_string_in :: CString -> Ptr GuPool -> IO (Ptr GuIn)
+
+foreign import ccall "gu/string.h gu_string_buf"
+  gu_string_buf :: Ptr GuPool -> IO (Ptr GuStringBuf)
+
+foreign import ccall "gu/string.h gu_string_buf_out"
+  gu_string_buf_out :: Ptr GuStringBuf -> IO (Ptr GuOut)
+
+foreign import ccall "gu/enum.h gu_enum_next"
+  gu_enum_next :: Ptr a -> Ptr (Ptr b) -> Ptr GuPool -> IO ()
+
+foreign import ccall "gu/string.h gu_string_buf_freeze"
+  gu_string_buf_freeze :: Ptr GuStringBuf -> Ptr GuPool -> IO CString
+
+withGuPool :: (Ptr GuPool -> IO a) -> IO a
+withGuPool f = bracket gu_new_pool gu_pool_free f
+
+
+------------------------------------------------------------------
+-- libpgf API
+
+data PgfPGF
+data PgfApplication
+data PgfConcr
+type PgfExpr = Ptr ()
+data PgfExprProb
+data PgfFullFormEntry
+data PgfMorphoCallback
+data PgfPrintContext
+data PgfType
 
--- PgfPGF* pgf_read(const char* fpath, GuPool* pool, GuExn* err);
 foreign import ccall "pgf/pgf.h pgf_read"
   pgf_read :: CString -> Ptr GuPool -> Ptr GuExn -> IO (Ptr PgfPGF)
 
--- GuString pgf_abstract_name(PgfPGF*);
 foreign import ccall "pgf/pgf.h pgf_abstract_name"
   pgf_abstract_name :: Ptr PgfPGF -> IO CString
 
--- void pgf_iter_languages(PgfPGF*, GuMapItor*, GuExn* err);
 foreign import ccall "pgf/pgf.h pgf_iter_languages"
   pgf_iter_languages :: Ptr PgfPGF -> Ptr GuMapItor -> Ptr GuExn -> IO ()
--- TODO test this function
--- GuMapItor???
--- implement a fun in haskell, export it to c
--- GuMapItor contains a pointer to a function
--- Ask Koen
--- foreign export
-
--- PgfConcr* pgf_get_language(PgfPGF*, PgfCId lang);
+
 foreign import ccall "pgf/pgf.h pgf_get_language"
   pgf_get_language :: Ptr PgfPGF -> CString -> IO (Ptr PgfConcr)
 
-
--- GuString pgf_concrete_name(PgfConcr*);
 foreign import ccall "pgf/pgf.h pgf_concrete_name"
   pgf_concrete_name :: Ptr PgfConcr -> IO CString
 
--- GuString pgf_language_code(PgfConcr* concr);
 foreign import ccall "pgf/pgf.h pgf_language_code"
   pgf_language_code :: Ptr PgfConcr -> IO CString
 
-
---void pgf_iter_categories(PgfPGF* pgf, GuMapItor* fn, GuExn* err);
 foreign import ccall "pgf/pgf.h pgf_iter_categories"
   pgf_iter_categories :: Ptr PgfPGF -> Ptr GuMapItor -> Ptr GuExn -> IO ()
---TODO test this function
 
--- PgfCId pgf_start_cat(PgfPGF* pgf, GuPool* pool);
 foreign import ccall "pgf/pgf.h pgf_start_cat"
   pgf_start_cat :: Ptr PgfPGF -> IO CString
 
--- void pgf_iter_functions(PgfPGF* pgf, GuMapItor* fn, GuExn* err);
 foreign import ccall "pgf/pgf.h pgf_iter_functions"
   pgf_iter_functions :: Ptr PgfPGF -> Ptr GuMapItor -> Ptr GuExn -> IO ()
---TODO test this function
 
--- void pgf_iter_functions_by_cat(PgfPGF* pgf, PgfCId catname,
---                          GuMapItor* fn, GuExn* err);
 foreign import ccall "pgf/pgf.h pgf_iter_functions_by_cat"
   pgf_iter_functions_by_cat :: Ptr PgfPGF -> Ptr GuMapItor -> Ptr GuExn -> IO ()
---TODO test this function
 
--- PgfType* pgf_function_type(PgfPGF* pgf, PgfCId funname); 
 foreign import ccall "pgf/pgf.h pgf_function_type"
    pgf_function_type :: Ptr PgfPGF -> CString -> IO (Ptr PgfType)
 
--- GuString pgf_print_name(PgfConcr*, PgfCId id);
 foreign import ccall "pgf/pgf.h pgf_print_name"
   pgf_print_name :: Ptr PgfConcr -> CString -> IO CString
 
---void pgf_linearize(PgfConcr* concr, PgfExpr expr, GuOut* out, GuExn* err);
 foreign import ccall "pgf/pgf.h pgf_linearize"
   pgf_linearize :: Ptr PgfConcr -> PgfExpr -> Ptr GuOut -> Ptr GuExn -> IO ()
 
--- PgfExprEnum* pgf_parse(PgfConcr* concr, PgfCId cat, GuString sentence,
---                        GuExn* err, GuPool* pool, GuPool* out_pool);
 foreign import ccall "pgf/pgf.h pgf_parse"
-  pgf_parse :: Ptr PgfConcr -> CString -> CString -> Ptr GuExn -> Ptr GuPool -> Ptr GuPool -> IO (Ptr PgfExprEnum)
+  pgf_parse :: Ptr PgfConcr -> CString -> CString -> Ptr GuExn -> Ptr GuPool -> Ptr GuPool -> IO (Ptr GuEnum)
 
---void pgf_lookup_morpho(PgfConcr *concr, GuString sentence,
---                  PgfMorphoCallback* callback, GuExn* err);
 foreign import ccall "pgf/pgf.h pgf_lookup_morpho"
   pgf_lookup_morpho :: Ptr PgfConcr -> CString -> Ptr PgfMorphoCallback -> Ptr GuExn -> IO ()
 
-type Callback = Ptr PgfMorphoCallback -> CString -> CString -> Float -> Ptr GuExn -> IO ()
+type LookupMorphoCallback = Ptr PgfMorphoCallback -> CString -> CString -> Float -> Ptr GuExn -> IO ()
 
 foreign import ccall "wrapper"
-  wrapLookupMorpho :: Callback -> IO (FunPtr Callback)
+  wrapLookupMorphoCallback :: LookupMorphoCallback -> IO (FunPtr LookupMorphoCallback)
 
-type Languages = Ptr GuMapItor -> Ptr () -> Ptr () -> Ptr GuExn -> IO ()
+type MapItorCallback = Ptr GuMapItor -> Ptr () -> Ptr () -> Ptr GuExn -> IO ()
 
 foreign import ccall "wrapper"
-  wrapLanguages :: Languages -> IO (FunPtr Languages)
+  wrapMapItorCallback :: MapItorCallback -> IO (FunPtr MapItorCallback)
 
---GuEnum* pgf_fullform_lexicon(PgfConcr *concr, GuPool* pool);
 foreign import ccall "pgf/pgf.h pgf_fullform_lexicon"
   pgf_fullform_lexicon :: Ptr PgfConcr -> Ptr GuPool -> IO (Ptr GuEnum)
 
---GuString pgf_fullform_get_string(PgfFullFormEntry* entry);
 foreign import ccall "pgf/pgf.h pgf_fullform_get_string"
   pgf_fullform_get_string :: Ptr PgfFullFormEntry -> IO CString
 
--- void pgf_fullform_get_analyses(PgfFullFormEntry* entry,
---                                PgfMorphoCallback* callback, GuExn* err)
 foreign import ccall "pgf/pgf.h pgf_fullform_get_analyses"
   pgf_fullform_get_analyses :: Ptr PgfFullFormEntry -> Ptr PgfMorphoCallback -> Ptr GuExn -> IO ()
                     
-
---PgfApplication* pgf_expr_unapply(PgfExpr expr, GuPool* pool);
 foreign import ccall "pgf/pgf.h pgf_expr_unapply"
   pgf_expr_unapply :: PgfExpr -> Ptr GuPool -> IO (Ptr PgfApplication)
 
---int pgf_expr_arity(PgfExpr expr);
 foreign import ccall "pgf/expr.h pgf_expr_arity"
   pgf_expr_arity :: PgfExpr -> IO Int
---Not needed anymore, solved the problem with unapply using CInt instead of Int
 
-
---void pgf_print_expr(PgfExpr expr, PgfPrintContext* ctxt, int prec, 
---               GuOut* out, GuExn* err);
 foreign import ccall "pgf/expr.h pgf_print_expr"
   pgf_print_expr :: PgfExpr -> Ptr PgfPrintContext -> Int -> Ptr GuOut -> Ptr GuExn -> IO ()
---PgfExprEnum* pgf_generate_all(PgfPGF* pgf, PgfCId cat, GuPool* pool);
+
 foreign import ccall "pgf/pgf.h pgf_generate_all"
-  pgf_generate_all :: Ptr PgfPGF -> CString -> Ptr GuPool -> IO (Ptr PgfExprEnum)
+  pgf_generate_all :: Ptr PgfPGF -> CString -> Ptr GuPool -> IO (Ptr GuEnum)
 
--- void pgf_print(PgfPGF* pgf, GuOut* out, GuExn* err); 
 foreign import ccall "pgf/pgf.h pgf_print"
   pgf_print :: Ptr PgfPGF -> Ptr GuOut -> Ptr GuExn -> IO ()
 
---PgfExpr pgf_read_expr(GuIn* in, GuPool* pool, GuExn* err);
 foreign import ccall "pgf/expr.h pgf_read_expr"
   pgf_read_expr :: Ptr GuIn -> Ptr GuPool -> Ptr GuExn -> IO PgfExpr
-
---PgfExprEnum*
---pgf_parse_with_heuristics(PgfConcr* concr, PgfCId cat, PgfLexer *lexer, 
---                          double heuristics, 
---                          GuPool* pool, GuPool* out_pool);
--- Not needed
-
--- GuEnum* pgf_complete(PgfConcr* concr, PgfCId cat, PgfLexer *lexer, 
---                     GuString prefix, GuPool* pool);
--- TODO
-
--- bool pgf_parseval(PgfConcr* concr, PgfExpr expr, PgfCId cat, 
---                  double *precision, double *recall, double *exact);
--- Not needed
diff --git a/src/runtime/haskell-bind/examples/pgf-shell.hs b/src/runtime/haskell-bind/examples/pgf-shell.hs
index fbb4c4023..1159ea794 100644
--- a/src/runtime/haskell-bind/examples/pgf-shell.hs
+++ b/src/runtime/haskell-bind/examples/pgf-shell.hs
@@ -13,9 +13,9 @@ import qualified Data.Map as M
 import System.IO(hFlush,stdout)
 import System.IO.Error(catchIOError)
 import System.Environment
-import CRuntimeFFI
-import CId
+import PGF2
 import System.Mem(performGC)
+import qualified Data.Map as Map
 
 main = getPGF =<< getArgs
 
@@ -42,13 +42,13 @@ execute pgf cmd =
 
 getConcr' pgf lang =
     maybe (fail $ "Concrete syntax not found: "++show lang) return $
-    getConcr pgf lang
+    Map.lookup lang (languages pgf)
 
 printl xs = putl $ map show xs
 putl = putStr . unlines
 
 -- | Abstracy syntax of shell commands
-data Command = P CId String | L CId Tree | T CId CId String deriving Show
+data Command = P String String | L String Expr | T String String String deriving Show
 
 -- | Shell command parser
 instance Read Command where
diff --git a/src/runtime/haskell-bind/haskell-bind.cabal b/src/runtime/haskell-bind/pgf2-bind.cabal
index 863bd3da8..e2a9e2e7a 100644
--- a/src/runtime/haskell-bind/haskell-bind.cabal
+++ b/src/runtime/haskell-bind/pgf2-bind.cabal
@@ -1,7 +1,7 @@
 -- Initial haskell-bind.cabal generated by cabal init.  For further 
 -- documentation, see http://haskell.org/cabal/users-guide/
 
-name:                haskell-bind
+name:                pgf2-bind
 version:             0.1.0.0
 -- synopsis:            
 -- description:         
@@ -9,7 +9,7 @@ homepage:            http://www.grammaticalframework.org
 license:             LGPL-3
 --license-file:        LICENSE
 author:              Inari
--- maintainer:          
+maintainer:          Krasimir Angelov
 -- copyright:           
 category:            Language
 build-type:          Simple
@@ -17,10 +17,10 @@ extra-source-files:  README
 cabal-version:       >=1.10
 
 library
-  exposed-modules:     CId, CRuntimeFFI
-  other-modules:       Gu, PgfLow
+  exposed-modules:     PGF2
+  other-modules:       PGF2.FFI
   build-depends:       base >=4.5 && <4.7, bytestring >=0.9 && <0.11,
-                       pretty >=1.1 && <1.2, containers
+                       containers
   -- hs-source-dirs:      
   build-tools:         hsc2hs
   extra-libraries:     gu pgf