From 4888b6588179ee44bb1a4b319108e70c8e8aafb9 Mon Sep 17 00:00:00 2001
From: krasimir <krasimir@chalmers.se>
Date: Thu, 19 Nov 2015 13:18:19 +0000
Subject: [PATCH] added mkInt and mkFloat in the Haskell binding to make it
 easy to create literal expressions

---
 src/runtime/c/pgf/expr.c               | 30 ++++++++++++++++++++++++++
 src/runtime/c/pgf/expr.h               |  6 ++++++
 src/runtime/haskell-bind/PGF2.hsc      |  2 +-
 src/runtime/haskell-bind/PGF2/Expr.hsc | 16 ++++++++++++++
 src/runtime/haskell-bind/PGF2/FFI.hs   |  6 ++++++
 5 files changed, 59 insertions(+), 1 deletion(-)

diff --git a/src/runtime/c/pgf/expr.c b/src/runtime/c/pgf/expr.c
index 3482e0b11..d579027aa 100644
--- a/src/runtime/c/pgf/expr.c
+++ b/src/runtime/c/pgf/expr.c
@@ -112,6 +112,36 @@ pgf_expr_string(GuString str, GuPool* pool)
 	                        lit);
 }
 
+PgfExpr
+pgf_expr_int(int val, GuPool* pool)
+{
+	PgfLiteral lit;
+	PgfLiteralInt* plit = 
+		gu_new_variant(PGF_LITERAL_INT,
+		               PgfLiteralInt,
+		               &lit, pool);
+	plit->val = val;
+	return gu_new_variant_i(pool,
+	                        PGF_EXPR_LIT,
+	                        PgfExprLit,
+	                        lit);
+}
+
+PgfExpr
+pgf_expr_float(double val, GuPool* pool)
+{
+	PgfLiteral lit;
+	PgfLiteralFlt* plit = 
+		gu_new_variant(PGF_LITERAL_FLT,
+		               PgfLiteralFlt,
+		               &lit, pool);
+	plit->val = val;
+	return gu_new_variant_i(pool,
+	                        PGF_EXPR_LIT,
+	                        PgfExprLit,
+	                        lit);
+}
+
 typedef struct PgfExprParser PgfExprParser;
 
 typedef enum {
diff --git a/src/runtime/c/pgf/expr.h b/src/runtime/c/pgf/expr.h
index 23aa971f0..2e76bf21d 100644
--- a/src/runtime/c/pgf/expr.h
+++ b/src/runtime/c/pgf/expr.h
@@ -149,6 +149,12 @@ pgf_expr_apply(PgfApplication*, GuPool* pool);
 PgfExpr
 pgf_expr_string(GuString, GuPool* pool);
 
+PgfExpr
+pgf_expr_int(int val, GuPool* pool);
+
+PgfExpr
+pgf_expr_float(double val, GuPool* pool);
+
 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 40002ff50..c7b24d680 100644
--- a/src/runtime/haskell-bind/PGF2.hsc
+++ b/src/runtime/haskell-bind/PGF2.hsc
@@ -22,7 +22,7 @@ module PGF2 (-- * CId
              -- * Types
              Type(..), Hypo, BindType(..), showType, functionType,
              -- * Trees
-             Expr,Fun,readExpr,showExpr,mkApp,unApp,mkStr,
+             Expr,Fun,readExpr,showExpr,mkApp,unApp,mkStr,mkInt,mkFloat,
              graphvizAbstractTree,graphvizParseTree,
              -- * Morphology
              MorphoAnalysis, lookupMorpho, fullFormLexicon,
diff --git a/src/runtime/haskell-bind/PGF2/Expr.hsc b/src/runtime/haskell-bind/PGF2/Expr.hsc
index d6cf8670a..5914500de 100644
--- a/src/runtime/haskell-bind/PGF2/Expr.hsc
+++ b/src/runtime/haskell-bind/PGF2/Expr.hsc
@@ -67,6 +67,22 @@ mkStr str =
       exprFPl <- newForeignPtr gu_pool_finalizer exprPl
       return (Expr c_expr exprFPl)
 
+mkInt :: Int -> Expr
+mkInt val =
+  unsafePerformIO $ do
+      exprPl <- gu_new_pool
+      c_expr <- pgf_expr_int (fromIntegral val) exprPl
+      exprFPl <- newForeignPtr gu_pool_finalizer exprPl
+      return (Expr c_expr exprFPl)
+
+mkFloat :: Double -> Expr
+mkFloat val =
+  unsafePerformIO $ do
+      exprPl <- gu_new_pool
+      c_expr <- pgf_expr_float (realToFrac val) exprPl
+      exprFPl <- newForeignPtr gu_pool_finalizer exprPl
+      return (Expr c_expr exprFPl)
+
 readExpr :: String -> Maybe Expr
 readExpr str =
   unsafePerformIO $
diff --git a/src/runtime/haskell-bind/PGF2/FFI.hs b/src/runtime/haskell-bind/PGF2/FFI.hs
index 15001c2c9..6321067c2 100644
--- a/src/runtime/haskell-bind/PGF2/FFI.hs
+++ b/src/runtime/haskell-bind/PGF2/FFI.hs
@@ -204,6 +204,12 @@ foreign import ccall "pgf/pgf.h pgf_expr_apply"
 foreign import ccall "pgf/pgf.h pgf_expr_string"
   pgf_expr_string :: CString -> Ptr GuPool -> IO PgfExpr
 
+foreign import ccall "pgf/pgf.h pgf_expr_int"
+  pgf_expr_int :: CInt -> Ptr GuPool -> IO PgfExpr
+
+foreign import ccall "pgf/pgf.h pgf_expr_float"
+  pgf_expr_float :: CDouble -> Ptr GuPool -> IO PgfExpr
+
 foreign import ccall "pgf/pgf.h pgf_expr_unapply"
   pgf_expr_unapply :: PgfExpr -> Ptr GuPool -> IO (Ptr PgfApplication)