diff options
| -rw-r--r-- | src/runtime/c/pgf/expr.c | 23 | ||||
| -rw-r--r-- | src/runtime/c/pgf/expr.h | 2 | ||||
| -rw-r--r-- | src/runtime/haskell-bind/PGF2.hsc | 17 | ||||
| -rw-r--r-- | src/runtime/haskell-bind/PGF2/FFI.hs | 5 |
4 files changed, 45 insertions, 2 deletions
diff --git a/src/runtime/c/pgf/expr.c b/src/runtime/c/pgf/expr.c index 551d2fb09..0192ba816 100644 --- a/src/runtime/c/pgf/expr.c +++ b/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 { diff --git a/src/runtime/c/pgf/expr.h b/src/runtime/c/pgf/expr.h index a613c9666..07933556b 100644 --- a/src/runtime/c/pgf/expr.h +++ b/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); diff --git a/src/runtime/haskell-bind/PGF2.hsc b/src/runtime/haskell-bind/PGF2.hsc index ca38dedfb..f8a68bf42 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,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 $ diff --git a/src/runtime/haskell-bind/PGF2/FFI.hs b/src/runtime/haskell-bind/PGF2/FFI.hs index 863431bca..528b80ea8 100644 --- a/src/runtime/haskell-bind/PGF2/FFI.hs +++ b/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) |