added mkApp to the Haskell binding

src/runtime/c/pgf/expr.c

@@ -73,6 +73,29 @@ pgf_expr_unapply(PgfExpr expr, GuPool* pool)
 	return appl;
 }
 
+PgfExpr
+pgf_expr_apply(PgfApplication* app, GuPool* pool)
+{
+	PgfExpr expr;
+
+	size_t len = strlen(app->fun);
+	PgfExprFun *efun =
+		gu_new_flex_variant(PGF_EXPR_FUN,
+					        PgfExprFun,
+					        fun, len+1,
+					        &expr, pool);
+	strcpy(efun->fun, app->fun);
+
+	for (int i = 0; i < app->n_args; i++) {
+		expr = gu_new_variant_i(pool, 
+				                PGF_EXPR_APP, PgfExprApp,
+						        .fun = expr,
+						        .arg = app->args[i]);
+	}
+	
+	return expr;
+}
+
 typedef struct PgfExprParser PgfExprParser;
 
 typedef enum {

src/runtime/c/pgf/expr.h

@@ -143,6 +143,8 @@ struct PgfApplication {
 PgfApplication*
 pgf_expr_unapply(PgfExpr expr, GuPool* pool);
 
+PgfExpr
+pgf_expr_apply(PgfApplication*, GuPool* pool);
 
 PgfExpr
 pgf_read_expr(GuIn* in, GuPool* pool, GuExn* err);

src/runtime/haskell-bind/PGF2.hsc

@@ -17,7 +17,7 @@ module PGF2 (-- * PGF
              -- * Concrete syntax
              Concr,languages,parse,parseWithHeuristics,linearize,
              -- * Trees
-             Expr,readExpr,showExpr,unApp,
+             Expr,readExpr,showExpr,mkApp,unApp,
              -- * Morphology
              MorphoAnalysis, lookupMorpho, fullFormLexicon,
              -- * Exceptions
@@ -139,6 +139,21 @@ data Expr = forall a . Expr {expr :: PgfExpr, exprMaster :: a}
 instance Show Expr where
   show = showExpr
 
+mkApp :: String -> [Expr] -> Expr
+mkApp fun args =
+  unsafePerformIO $
+    withCString fun $ \cfun ->
+    allocaBytes ((#size PgfApplication) + len * sizeOf (undefined :: PgfExpr)) $ \papp -> do
+      (#poke PgfApplication, fun) papp cfun
+      (#poke PgfApplication, n_args) papp len
+      pokeArray (papp `plusPtr` (#offset PgfApplication, args)) (map expr args)
+      exprPl <- gu_new_pool
+      c_expr <- pgf_expr_apply papp exprPl
+      exprFPl <- newForeignPtr gu_pool_finalizer exprPl
+      return (Expr c_expr (exprFPl,args))
+  where
+    len = length args
+
 unApp :: Expr -> Maybe (String,[Expr])
 unApp (Expr expr master) =
   unsafePerformIO $

src/runtime/haskell-bind/PGF2/FFI.hs

@@ -178,7 +178,10 @@ foreign import ccall "pgf/pgf.h pgf_fullform_get_string"
 
 foreign import ccall "pgf/pgf.h pgf_fullform_get_analyses"
   pgf_fullform_get_analyses :: Ptr PgfFullFormEntry -> Ptr PgfMorphoCallback -> Ptr GuExn -> IO ()
-                    
+
+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)