forked from GitHub/gf-core
added mkAbs and unAbs in the Haskell binding
This commit is contained in:
@@ -30,7 +30,8 @@ module PGF2 (-- * PGF
|
||||
-- ** Functions
|
||||
Fun,functions, functionsByCat, functionType, hasLinearization,
|
||||
-- ** Expressions
|
||||
Expr,showExpr,readExpr,mkApp,unApp,mkStr,unStr,mkInt,unInt,mkFloat,unFloat,
|
||||
Expr,showExpr,readExpr,
|
||||
mkAbs,unAbs,mkApp,unApp,mkStr,unStr,mkInt,unInt,mkFloat,unFloat,
|
||||
-- ** Types
|
||||
Type(..), Hypo, BindType(..), startCat, showType,
|
||||
|
||||
|
||||
@@ -33,6 +33,37 @@ data Expr = forall a . Expr {expr :: PgfExpr, exprMaster :: a}
|
||||
instance Show Expr where
|
||||
show = showExpr []
|
||||
|
||||
-- | Constructs an expression by lambda abstraction
|
||||
mkAbs :: BindType -> CId -> Expr -> Expr
|
||||
mkAbs bind_type var (Expr body master) =
|
||||
unsafePerformIO $ do
|
||||
exprPl <- gu_new_pool
|
||||
cvar <- newUtf8CString var exprPl
|
||||
c_expr <- pgf_expr_abs cbind_type cvar body exprPl
|
||||
exprFPl <- newForeignPtr gu_pool_finalizer exprPl
|
||||
return (Expr c_expr (exprFPl,body))
|
||||
where
|
||||
cbind_type =
|
||||
case bind_type of
|
||||
Explicit -> (#const PGF_BIND_TYPE_EXPLICIT)
|
||||
Implicit -> (#const PGF_BIND_TYPE_IMPLICIT)
|
||||
|
||||
-- | Decomposes an expression into an abstraction and a body
|
||||
unAbs :: Expr -> Maybe (BindType, CId, Expr)
|
||||
unAbs (Expr expr master) =
|
||||
unsafePerformIO $ do
|
||||
c_abs <- pgf_expr_unabs expr
|
||||
if c_abs == nullPtr
|
||||
then return Nothing
|
||||
else do bt <- fmap toBindType ((#peek PgfExprAbs, bind_type) c_abs)
|
||||
var <- (#peek PgfExprAbs, id) c_abs >>= peekUtf8CString
|
||||
c_body <- (#peek PgfExprAbs, body) c_abs
|
||||
return (Just (bt, var, Expr c_body master))
|
||||
where
|
||||
toBindType :: CInt -> BindType
|
||||
toBindType (#const PGF_BIND_TYPE_EXPLICIT) = Explicit
|
||||
toBindType (#const PGF_BIND_TYPE_IMPLICIT) = Implicit
|
||||
|
||||
-- | Constructs an expression by applying a function to a list of expressions
|
||||
mkApp :: Fun -> [Expr] -> Expr
|
||||
mkApp fun args =
|
||||
|
||||
@@ -257,6 +257,15 @@ 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_unapply"
|
||||
pgf_expr_unapply :: PgfExpr -> Ptr GuPool -> IO (Ptr PgfApplication)
|
||||
|
||||
foreign import ccall "pgf/pgf.h pgf_expr_abs"
|
||||
pgf_expr_abs :: CInt -> CString -> PgfExpr -> Ptr GuPool -> IO PgfExpr
|
||||
|
||||
foreign import ccall "pgf/pgf.h pgf_expr_unabs"
|
||||
pgf_expr_unabs :: PgfExpr -> IO (Ptr a)
|
||||
|
||||
foreign import ccall "pgf/pgf.h pgf_expr_string"
|
||||
pgf_expr_string :: CString -> Ptr GuPool -> IO PgfExpr
|
||||
|
||||
@@ -269,9 +278,6 @@ foreign import ccall "pgf/pgf.h pgf_expr_float"
|
||||
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)
|
||||
|
||||
foreign import ccall "pgf/expr.h pgf_expr_arity"
|
||||
pgf_expr_arity :: PgfExpr -> IO CInt
|
||||
|
||||
|
||||
Reference in New Issue
Block a user