added mkMeta and unMeta in the Haskell binding

5 files changed, 102 insertions, 1 deletions

diff --git a/src/runtime/c/pgf/expr.c b/src/runtime/c/pgf/expr.c
index 3c37a4b72..a3c48f32a 100644
--- a/src/runtime/c/pgf/expr.c
+++ b/src/runtime/c/pgf/expr.c
@@ -98,6 +98,46 @@ pgf_expr_apply(PgfApplication* app, GuPool* pool)
 }
 
 PgfExpr
+pgf_expr_abs(PgfBindType bind_type, PgfCId id, PgfExpr body, GuPool* pool)
+{
+	return gu_new_variant_i(pool, 
+				            PGF_EXPR_ABS, PgfExprAbs,
+						    .bind_type = bind_type,
+						    .id = id,
+						    .body = body);
+}
+
+PgfExprAbs*
+pgf_expr_unabs(PgfExpr expr)
+{
+	GuVariantInfo i = gu_variant_open(expr);
+	if (i.tag == PGF_EXPR_ABS) {
+		return (PgfExprAbs*) i.data;
+	}
+
+	return NULL;
+}
+
+PgfExpr
+pgf_expr_meta(int id, GuPool* pool)
+{
+	return gu_new_variant_i(pool, 
+				            PGF_EXPR_META, PgfExprMeta,
+						    .id = id);
+}
+
+PgfExprMeta*
+pgf_expr_unmeta(PgfExpr expr)
+{
+	GuVariantInfo i = gu_variant_open(expr);
+	if (i.tag == PGF_EXPR_META) {
+		return (PgfExprMeta*) i.data;
+	}
+
+	return NULL;
+}
+
+PgfExpr
 pgf_expr_string(GuString str, GuPool* pool)
 {
 	PgfLiteral lit;
@@ -143,6 +183,22 @@ pgf_expr_float(double val, GuPool* pool)
 	                        lit);
 }
 
+void*
+pgf_expr_unlit(PgfExpr expr, int lit_tag)
+{
+	expr = pgf_expr_unwrap(expr);
+	GuVariantInfo i = gu_variant_open(expr);
+	if (i.tag == PGF_EXPR_LIT) {
+		PgfExprLit* elit = i.data;
+		GuVariantInfo i2 = gu_variant_open(elit->lit);
+		if (i2.tag == lit_tag) {
+			return i2.data;
+		}
+	}
+		
+	return NULL;
+}
+
 typedef struct PgfExprParser PgfExprParser;
 
 typedef enum {
diff --git a/src/runtime/c/pgf/expr.h b/src/runtime/c/pgf/expr.h
index 763d1ba4f..a2ce6dc42 100644
--- a/src/runtime/c/pgf/expr.h
+++ b/src/runtime/c/pgf/expr.h
@@ -147,6 +147,12 @@ PgfExpr
 pgf_expr_apply(PgfApplication*, GuPool* pool);
 
 PgfExpr
+pgf_expr_abs(PgfBindType bind_type, PgfCId id, PgfExpr body, GuPool* pool);
+
+PgfExprAbs*
+pgf_expr_unabs(PgfExpr expr);
+
+PgfExpr
 pgf_expr_string(GuString, GuPool* pool);
 
 PgfExpr
@@ -155,6 +161,15 @@ pgf_expr_int(int val, GuPool* pool);
 PgfExpr
 pgf_expr_float(double val, GuPool* pool);
 
+void*
+pgf_expr_unlit(PgfExpr expr, int lit_tag);
+
+PgfExpr
+pgf_expr_meta(int id, GuPool* pool);
+
+PgfExprMeta*
+pgf_expr_unmeta(PgfExpr expr);
+
 PgfExpr
 pgf_read_expr(GuIn* in, GuPool* pool, GuExn* err);
 
diff --git a/src/runtime/haskell-bind/PGF2.hsc b/src/runtime/haskell-bind/PGF2.hsc
index cdafb6eb9..1f8d07c12 100644
--- a/src/runtime/haskell-bind/PGF2.hsc
+++ b/src/runtime/haskell-bind/PGF2.hsc
@@ -31,7 +31,12 @@ module PGF2 (-- * PGF
              Fun,functions, functionsByCat, functionType, hasLinearization,
              -- ** Expressions
              Expr,showExpr,readExpr,
-             mkAbs,unAbs,mkApp,unApp,mkStr,unStr,mkInt,unInt,mkFloat,unFloat,
+             mkAbs,unAbs,
+             mkApp,unApp,
+             mkStr,unStr,
+             mkInt,unInt,
+             mkFloat,unFloat,
+             mkMeta,unMeta,
              -- ** Types
              Type(..), Hypo, BindType(..), startCat, showType,
 
diff --git a/src/runtime/haskell-bind/PGF2/Expr.hsc b/src/runtime/haskell-bind/PGF2/Expr.hsc
index 9fd0494bd..c18e97a13 100644
--- a/src/runtime/haskell-bind/PGF2/Expr.hsc
+++ b/src/runtime/haskell-bind/PGF2/Expr.hsc
@@ -152,6 +152,25 @@ unFloat (Expr expr master) =
       else do n <- peek (plit `plusPtr` (#offset PgfLiteralFlt, val))
               return (Just (realToFrac (n :: CDouble)))
 
+-- | Constructs a meta variable as an expression
+mkMeta :: Int -> Expr
+mkMeta id =
+  unsafePerformIO $ do
+      exprPl <- gu_new_pool
+      c_expr <- pgf_expr_meta (fromIntegral id) exprPl
+      exprFPl <- newForeignPtr gu_pool_finalizer exprPl
+      return (Expr c_expr exprFPl)
+
+-- | Decomposes an expression into a meta variable
+unMeta :: Expr -> Maybe Int
+unMeta (Expr expr master) =
+  unsafePerformIO $ do
+      c_meta <- pgf_expr_unmeta expr
+      if c_meta == nullPtr
+        then return Nothing
+        else do id <- (#peek PgfExprMeta, id) c_meta
+                return (Just (fromIntegral (id :: CInt)))
+
 -- | parses a 'String' as an expression
 readExpr :: String -> Maybe Expr
 readExpr str =
diff --git a/src/runtime/haskell-bind/PGF2/FFI.hs b/src/runtime/haskell-bind/PGF2/FFI.hs
index 0e5ba250c..9051b1465 100644
--- a/src/runtime/haskell-bind/PGF2/FFI.hs
+++ b/src/runtime/haskell-bind/PGF2/FFI.hs
@@ -266,6 +266,12 @@ foreign import ccall "pgf/pgf.h pgf_expr_abs"
 foreign import ccall "pgf/pgf.h pgf_expr_unabs"
   pgf_expr_unabs :: PgfExpr -> IO (Ptr a)
 
+foreign import ccall "pgf/pgf.h pgf_expr_meta"
+  pgf_expr_meta :: CInt -> Ptr GuPool -> IO PgfExpr
+
+foreign import ccall "pgf/pgf.h pgf_expr_unmeta"
+  pgf_expr_unmeta :: PgfExpr -> IO (Ptr a)
+
 foreign import ccall "pgf/pgf.h pgf_expr_string"
   pgf_expr_string :: CString -> Ptr GuPool -> IO PgfExpr