1
0
forked from GitHub/gf-core

added mkMeta and unMeta in the Haskell binding

This commit is contained in:
krasimir
2017-01-26 10:17:02 +00:00
parent 47a4363d07
commit 06450249e3
5 changed files with 102 additions and 1 deletions

View File

@@ -97,6 +97,46 @@ pgf_expr_apply(PgfApplication* app, GuPool* pool)
return expr;
}
PgfExpr
pgf_expr_abs(PgfBindType bind_type, PgfCId id, PgfExpr body, GuPool* pool)
{
return gu_new_variant_i(pool,
PGF_EXPR_ABS, PgfExprAbs,
.bind_type = bind_type,
.id = id,
.body = body);
}
PgfExprAbs*
pgf_expr_unabs(PgfExpr expr)
{
GuVariantInfo i = gu_variant_open(expr);
if (i.tag == PGF_EXPR_ABS) {
return (PgfExprAbs*) i.data;
}
return NULL;
}
PgfExpr
pgf_expr_meta(int id, GuPool* pool)
{
return gu_new_variant_i(pool,
PGF_EXPR_META, PgfExprMeta,
.id = id);
}
PgfExprMeta*
pgf_expr_unmeta(PgfExpr expr)
{
GuVariantInfo i = gu_variant_open(expr);
if (i.tag == PGF_EXPR_META) {
return (PgfExprMeta*) i.data;
}
return NULL;
}
PgfExpr
pgf_expr_string(GuString str, GuPool* pool)
{
@@ -143,6 +183,22 @@ pgf_expr_float(double val, GuPool* pool)
lit);
}
void*
pgf_expr_unlit(PgfExpr expr, int lit_tag)
{
expr = pgf_expr_unwrap(expr);
GuVariantInfo i = gu_variant_open(expr);
if (i.tag == PGF_EXPR_LIT) {
PgfExprLit* elit = i.data;
GuVariantInfo i2 = gu_variant_open(elit->lit);
if (i2.tag == lit_tag) {
return i2.data;
}
}
return NULL;
}
typedef struct PgfExprParser PgfExprParser;
typedef enum {

View File

@@ -146,6 +146,12 @@ pgf_expr_unapply(PgfExpr expr, GuPool* pool);
PgfExpr
pgf_expr_apply(PgfApplication*, GuPool* pool);
PgfExpr
pgf_expr_abs(PgfBindType bind_type, PgfCId id, PgfExpr body, GuPool* pool);
PgfExprAbs*
pgf_expr_unabs(PgfExpr expr);
PgfExpr
pgf_expr_string(GuString, GuPool* pool);
@@ -155,6 +161,15 @@ pgf_expr_int(int val, GuPool* pool);
PgfExpr
pgf_expr_float(double val, GuPool* pool);
void*
pgf_expr_unlit(PgfExpr expr, int lit_tag);
PgfExpr
pgf_expr_meta(int id, GuPool* pool);
PgfExprMeta*
pgf_expr_unmeta(PgfExpr expr);
PgfExpr
pgf_read_expr(GuIn* in, GuPool* pool, GuExn* err);

View File

@@ -31,7 +31,12 @@ module PGF2 (-- * PGF
Fun,functions, functionsByCat, functionType, hasLinearization,
-- ** Expressions
Expr,showExpr,readExpr,
mkAbs,unAbs,mkApp,unApp,mkStr,unStr,mkInt,unInt,mkFloat,unFloat,
mkAbs,unAbs,
mkApp,unApp,
mkStr,unStr,
mkInt,unInt,
mkFloat,unFloat,
mkMeta,unMeta,
-- ** Types
Type(..), Hypo, BindType(..), startCat, showType,

View File

@@ -152,6 +152,25 @@ unFloat (Expr expr master) =
else do n <- peek (plit `plusPtr` (#offset PgfLiteralFlt, val))
return (Just (realToFrac (n :: CDouble)))
-- | Constructs a meta variable as an expression
mkMeta :: Int -> Expr
mkMeta id =
unsafePerformIO $ do
exprPl <- gu_new_pool
c_expr <- pgf_expr_meta (fromIntegral id) exprPl
exprFPl <- newForeignPtr gu_pool_finalizer exprPl
return (Expr c_expr exprFPl)
-- | Decomposes an expression into a meta variable
unMeta :: Expr -> Maybe Int
unMeta (Expr expr master) =
unsafePerformIO $ do
c_meta <- pgf_expr_unmeta expr
if c_meta == nullPtr
then return Nothing
else do id <- (#peek PgfExprMeta, id) c_meta
return (Just (fromIntegral (id :: CInt)))
-- | parses a 'String' as an expression
readExpr :: String -> Maybe Expr
readExpr str =

View File

@@ -266,6 +266,12 @@ foreign import ccall "pgf/pgf.h pgf_expr_abs"
foreign import ccall "pgf/pgf.h pgf_expr_unabs"
pgf_expr_unabs :: PgfExpr -> IO (Ptr a)
foreign import ccall "pgf/pgf.h pgf_expr_meta"
pgf_expr_meta :: CInt -> Ptr GuPool -> IO PgfExpr
foreign import ccall "pgf/pgf.h pgf_expr_unmeta"
pgf_expr_unmeta :: PgfExpr -> IO (Ptr a)
foreign import ccall "pgf/pgf.h pgf_expr_string"
pgf_expr_string :: CString -> Ptr GuPool -> IO PgfExpr