diff --git a/src/runtime/haskell-bind/PGF2.hsc b/src/runtime/haskell-bind/PGF2.hsc index c5da14abf..b4aea30e4 100644 --- a/src/runtime/haskell-bind/PGF2.hsc +++ b/src/runtime/haskell-bind/PGF2.hsc @@ -30,7 +30,7 @@ module PGF2 (-- * PGF -- ** Functions Fun,functions, functionsByCat, functionType, hasLinearization, -- ** Expressions - Expr,showExpr,readExpr,mkApp,unApp,mkStr,mkInt,mkFloat, + Expr,showExpr,readExpr,mkApp,unApp,mkStr,unStr,mkInt,unInt,mkFloat,unFloat, -- ** Types Type(..), Hypo, BindType(..), showType, diff --git a/src/runtime/haskell-bind/PGF2/Expr.hsc b/src/runtime/haskell-bind/PGF2/Expr.hsc index 338d4fa18..e6f949a45 100644 --- a/src/runtime/haskell-bind/PGF2/Expr.hsc +++ b/src/runtime/haskell-bind/PGF2/Expr.hsc @@ -73,6 +73,16 @@ mkStr str = exprFPl <- newForeignPtr gu_pool_finalizer exprPl return (Expr c_expr exprFPl) +-- | Decomposes an expression into a string literal +unStr :: Expr -> Maybe String +unStr (Expr expr master) = + unsafePerformIO $ do + plit <- pgf_expr_unlit expr (#const PGF_LITERAL_STR) + if plit == nullPtr + then return Nothing + else do s <- peekUtf8CString (plit `plusPtr` (#offset PgfLiteralStr, val)) + return (Just s) + -- | Constructs an expression from an integer literal mkInt :: Int -> Expr mkInt val = @@ -82,6 +92,16 @@ mkInt val = exprFPl <- newForeignPtr gu_pool_finalizer exprPl return (Expr c_expr exprFPl) +-- | Decomposes an expression into an integer literal +unInt :: Expr -> Maybe Int +unInt (Expr expr master) = + unsafePerformIO $ do + plit <- pgf_expr_unlit expr (#const PGF_LITERAL_INT) + if plit == nullPtr + then return Nothing + else do n <- peek (plit `plusPtr` (#offset PgfLiteralInt, val)) + return (Just (fromIntegral (n :: CInt))) + -- | Constructs an expression from a real number mkFloat :: Double -> Expr mkFloat val = @@ -91,6 +111,16 @@ mkFloat val = exprFPl <- newForeignPtr gu_pool_finalizer exprPl return (Expr c_expr exprFPl) +-- | Decomposes an expression into a real number literal +unFloat :: Expr -> Maybe Double +unFloat (Expr expr master) = + unsafePerformIO $ do + plit <- pgf_expr_unlit expr (#const PGF_LITERAL_FLT) + if plit == nullPtr + then return Nothing + else do n <- peek (plit `plusPtr` (#offset PgfLiteralFlt, val)) + return (Just (realToFrac (n :: CDouble))) + -- | 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 5e7dfe260..9e51bb34b 100644 --- a/src/runtime/haskell-bind/PGF2/FFI.hs +++ b/src/runtime/haskell-bind/PGF2/FFI.hs @@ -266,6 +266,9 @@ foreign import ccall "pgf/pgf.h pgf_expr_int" foreign import ccall "pgf/pgf.h pgf_expr_float" pgf_expr_float :: CDouble -> Ptr GuPool -> IO PgfExpr +foreign import ccall "pgf/pgf.h pgf_expr_unlit" + pgf_expr_unlit :: PgfExpr -> CInt -> IO (Ptr a) + foreign import ccall "pgf/pgf.h pgf_expr_unapply" pgf_expr_unapply :: PgfExpr -> Ptr GuPool -> IO (Ptr PgfApplication)