forked from GitHub/gf-core
added mkMeta and unMeta in the Haskell binding
This commit is contained in:
@@ -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 {
|
||||
|
||||
@@ -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);
|
||||
|
||||
|
||||
@@ -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,
|
||||
|
||||
|
||||
@@ -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 =
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
Reference in New Issue
Block a user