diff --git a/src/runtime/c/pgf/expr.c b/src/runtime/c/pgf/expr.c index 3c37a4b72..a3c48f32a 100644 --- a/src/runtime/c/pgf/expr.c +++ b/src/runtime/c/pgf/expr.c @@ -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 { diff --git a/src/runtime/c/pgf/expr.h b/src/runtime/c/pgf/expr.h index 763d1ba4f..a2ce6dc42 100644 --- a/src/runtime/c/pgf/expr.h +++ b/src/runtime/c/pgf/expr.h @@ -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); diff --git a/src/runtime/haskell-bind/PGF2.hsc b/src/runtime/haskell-bind/PGF2.hsc index cdafb6eb9..1f8d07c12 100644 --- a/src/runtime/haskell-bind/PGF2.hsc +++ b/src/runtime/haskell-bind/PGF2.hsc @@ -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, diff --git a/src/runtime/haskell-bind/PGF2/Expr.hsc b/src/runtime/haskell-bind/PGF2/Expr.hsc index 9fd0494bd..c18e97a13 100644 --- a/src/runtime/haskell-bind/PGF2/Expr.hsc +++ b/src/runtime/haskell-bind/PGF2/Expr.hsc @@ -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 = diff --git a/src/runtime/haskell-bind/PGF2/FFI.hs b/src/runtime/haskell-bind/PGF2/FFI.hs index 0e5ba250c..9051b1465 100644 --- a/src/runtime/haskell-bind/PGF2/FFI.hs +++ b/src/runtime/haskell-bind/PGF2/FFI.hs @@ -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