added mkStr to the Haskell binding

4 files changed, 33 insertions, 12 deletions

diff --git a/src/runtime/c/pgf/expr.c b/src/runtime/c/pgf/expr.c
index 0192ba816..7f0bb9eef 100644
--- a/src/runtime/c/pgf/expr.c
+++ b/src/runtime/c/pgf/expr.c
@@ -96,6 +96,22 @@ pgf_expr_apply(PgfApplication* app, GuPool* pool)
 	return expr;
 }
 
+PgfExpr
+pgf_expr_string(GuString str, GuPool* pool)
+{
+	PgfLiteral lit;
+	PgfLiteralStr* plit = 
+		gu_new_flex_variant(PGF_LITERAL_STR,
+		                    PgfLiteralStr,
+		                    val, strlen(str)+1,
+		                    &lit, pool);
+	strcpy(plit->val, str);
+	return gu_new_variant_i(pool,
+	                        PGF_EXPR_LIT,
+	                        PgfExprLit,
+	                        lit);
+}
+
 typedef struct PgfExprParser PgfExprParser;
 
 typedef enum {
@@ -411,17 +427,7 @@ pgf_expr_parser_term(PgfExprParser* parser)
 		char* str =
 			gu_buf_data(parser->token_value);
 		pgf_expr_parser_token(parser);
-		PgfLiteral lit;
-		PgfLiteralStr* plit = 
-			gu_new_flex_variant(PGF_LITERAL_STR,
-			                    PgfLiteralStr,
-			                    val, strlen(str)+1,
-			                    &lit, parser->expr_pool);
-		strcpy(plit->val, str);
-		return gu_new_variant_i(parser->expr_pool,
-		                        PGF_EXPR_LIT,
-		                        PgfExprLit,
-		                        lit);
+		return pgf_expr_string(str, parser->expr_pool);
 	}
 	case PGF_TOKEN_FLT: {
 		char* str = 
diff --git a/src/runtime/c/pgf/expr.h b/src/runtime/c/pgf/expr.h
index 07933556b..f197fbc6c 100644
--- a/src/runtime/c/pgf/expr.h
+++ b/src/runtime/c/pgf/expr.h
@@ -147,6 +147,9 @@ PgfExpr
 pgf_expr_apply(PgfApplication*, GuPool* pool);
 
 PgfExpr
+pgf_expr_string(GuString, GuPool* pool);
+
+PgfExpr
 pgf_read_expr(GuIn* in, GuPool* pool, GuExn* err);
 
 PgfType*
diff --git a/src/runtime/haskell-bind/PGF2.hsc b/src/runtime/haskell-bind/PGF2.hsc
index f8a68bf42..7b44b6cb8 100644
--- a/src/runtime/haskell-bind/PGF2.hsc
+++ b/src/runtime/haskell-bind/PGF2.hsc
@@ -17,7 +17,7 @@ module PGF2 (-- * PGF
              -- * Concrete syntax
              Concr,languages,parse,parseWithHeuristics,linearize,
              -- * Trees
-             Expr,readExpr,showExpr,mkApp,unApp,
+             Expr,readExpr,showExpr,mkApp,unApp,mkStr,
              -- * Morphology
              MorphoAnalysis, lookupMorpho, fullFormLexicon,
              -- * Exceptions
@@ -167,6 +167,15 @@ unApp (Expr expr master) =
            c_args <- peekArray (fromIntegral arity) (appl `plusPtr` (#offset PgfApplication, args))
            return $ Just (fun, [Expr c_arg master | c_arg <- c_args])
 
+mkStr :: String -> Expr
+mkStr str =
+  unsafePerformIO $
+    withCString str $ \cstr -> do
+      exprPl <- gu_new_pool
+      c_expr <- pgf_expr_string cstr 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 528b80ea8..8ddc536b9 100644
--- a/src/runtime/haskell-bind/PGF2/FFI.hs
+++ b/src/runtime/haskell-bind/PGF2/FFI.hs
@@ -182,6 +182,9 @@ 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_string"
+  pgf_expr_string :: CString -> Ptr GuPool -> IO PgfExpr
+
 foreign import ccall "pgf/pgf.h pgf_expr_unapply"
   pgf_expr_unapply :: PgfExpr -> Ptr GuPool -> IO (Ptr PgfApplication)