added mkAbs and unAbs in the Haskell binding

2 files changed, 40 insertions, 3 deletions

diff --git a/src/runtime/haskell-bind/PGF2/Expr.hsc b/src/runtime/haskell-bind/PGF2/Expr.hsc
index e6f949a45..9fd0494bd 100644
--- a/src/runtime/haskell-bind/PGF2/Expr.hsc
+++ b/src/runtime/haskell-bind/PGF2/Expr.hsc
@@ -33,6 +33,37 @@ data Expr = forall a . Expr {expr :: PgfExpr, exprMaster :: a}
 instance Show Expr where
   show = showExpr []
 
+-- | Constructs an expression by lambda abstraction
+mkAbs :: BindType -> CId -> Expr -> Expr
+mkAbs bind_type var (Expr body master) =
+  unsafePerformIO $ do
+      exprPl <- gu_new_pool
+      cvar <- newUtf8CString var exprPl
+      c_expr <- pgf_expr_abs cbind_type cvar body exprPl
+      exprFPl <- newForeignPtr gu_pool_finalizer exprPl
+      return (Expr c_expr (exprFPl,body))
+  where
+    cbind_type = 
+      case bind_type of
+        Explicit -> (#const PGF_BIND_TYPE_EXPLICIT)
+        Implicit -> (#const PGF_BIND_TYPE_IMPLICIT)
+
+-- | Decomposes an expression into an abstraction and a body
+unAbs :: Expr -> Maybe (BindType, CId, Expr)
+unAbs (Expr expr master) =
+  unsafePerformIO $ do
+      c_abs <- pgf_expr_unabs expr
+      if c_abs == nullPtr
+        then return Nothing
+        else do bt  <- fmap toBindType ((#peek PgfExprAbs, bind_type) c_abs)
+                var <- (#peek PgfExprAbs, id) c_abs >>= peekUtf8CString
+                c_body <- (#peek PgfExprAbs, body) c_abs
+                return (Just (bt, var, Expr c_body master))
+  where
+    toBindType :: CInt -> BindType
+    toBindType (#const PGF_BIND_TYPE_EXPLICIT) = Explicit
+    toBindType (#const PGF_BIND_TYPE_IMPLICIT) = Implicit
+
 -- | Constructs an expression by applying a function to a list of expressions
 mkApp :: Fun -> [Expr] -> Expr
 mkApp fun args =
diff --git a/src/runtime/haskell-bind/PGF2/FFI.hs b/src/runtime/haskell-bind/PGF2/FFI.hs
index 9e51bb34b..0e5ba250c 100644
--- a/src/runtime/haskell-bind/PGF2/FFI.hs
+++ b/src/runtime/haskell-bind/PGF2/FFI.hs
@@ -257,6 +257,15 @@ foreign import ccall "pgf/pgf.h pgf_fullform_get_analyses"
 foreign import ccall "pgf/pgf.h pgf_expr_apply"
   pgf_expr_apply :: Ptr PgfApplication -> Ptr GuPool -> IO PgfExpr
 
+foreign import ccall "pgf/pgf.h pgf_expr_unapply"
+  pgf_expr_unapply :: PgfExpr -> Ptr GuPool -> IO (Ptr PgfApplication)
+
+foreign import ccall "pgf/pgf.h pgf_expr_abs"
+  pgf_expr_abs :: CInt -> CString -> PgfExpr -> Ptr GuPool -> IO PgfExpr
+
+foreign import ccall "pgf/pgf.h pgf_expr_unabs"
+  pgf_expr_unabs :: PgfExpr -> IO (Ptr a)
+
 foreign import ccall "pgf/pgf.h pgf_expr_string"
   pgf_expr_string :: CString -> Ptr GuPool -> IO PgfExpr
 
@@ -269,9 +278,6 @@ foreign import ccall "pgf/pgf.h pgf_expr_float"
 foreign import ccall "pgf/pgf.h pgf_expr_unlit"
   pgf_expr_unlit :: PgfExpr -> CInt -> IO (Ptr a)
 
-foreign import ccall "pgf/pgf.h pgf_expr_unapply"
-  pgf_expr_unapply :: PgfExpr -> Ptr GuPool -> IO (Ptr PgfApplication)
-
 foreign import ccall "pgf/expr.h pgf_expr_arity"
   pgf_expr_arity :: PgfExpr -> IO CInt