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 @@ -146,6 +146,9 @@ pgf_expr_unapply(PgfExpr expr, GuPool* pool); PgfExpr pgf_expr_apply(PgfApplication*, GuPool* pool); +PgfExpr +pgf_expr_string(GuString, 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 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)