mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-09 04:59:31 -06:00
add functionsByCat in the Haskell binding
This commit is contained in:
@@ -28,7 +28,7 @@ module PGF2 (-- * CId
|
||||
-- * Morphology
|
||||
MorphoAnalysis, lookupMorpho, fullFormLexicon,
|
||||
-- * Generation
|
||||
functions, generateAll,
|
||||
functions, functionsByCat, generateAll,
|
||||
-- * Exceptions
|
||||
PGFError(..),
|
||||
-- * Grammar specific callbacks
|
||||
@@ -540,6 +540,27 @@ functions p =
|
||||
name <- peekUtf8CString (castPtr key)
|
||||
writeIORef ref $! (name : names)
|
||||
|
||||
functionsByCat :: PGF -> Cat -> [Fun]
|
||||
functionsByCat p cat =
|
||||
unsafePerformIO $
|
||||
withGuPool $ \tmpPl ->
|
||||
allocaBytes (#size GuMapItor) $ \itor -> do
|
||||
exn <- gu_new_exn tmpPl
|
||||
ref <- newIORef []
|
||||
fptr <- wrapMapItorCallback (getFunctions ref)
|
||||
(#poke GuMapItor, fn) itor fptr
|
||||
ccat <- newUtf8CString cat tmpPl
|
||||
pgf_iter_functions_by_cat (pgf p) ccat itor exn
|
||||
freeHaskellFunPtr fptr
|
||||
fs <- readIORef ref
|
||||
return (reverse fs)
|
||||
where
|
||||
getFunctions :: IORef [String] -> MapItorCallback
|
||||
getFunctions ref itor key value exn = do
|
||||
names <- readIORef ref
|
||||
name <- peekUtf8CString (castPtr key)
|
||||
writeIORef ref $! (name : names)
|
||||
|
||||
categories :: PGF -> [Cat]
|
||||
categories pgf = -- !!! quick hack
|
||||
nub [cat | f<-functions pgf, let DTyp _ cat _=functionType pgf f]
|
||||
|
||||
@@ -170,7 +170,7 @@ foreign import ccall "pgf/pgf.h pgf_iter_functions"
|
||||
pgf_iter_functions :: Ptr PgfPGF -> Ptr GuMapItor -> Ptr GuExn -> IO ()
|
||||
|
||||
foreign import ccall "pgf/pgf.h pgf_iter_functions_by_cat"
|
||||
pgf_iter_functions_by_cat :: Ptr PgfPGF -> Ptr GuMapItor -> Ptr GuExn -> IO ()
|
||||
pgf_iter_functions_by_cat :: Ptr PgfPGF -> CString -> Ptr GuMapItor -> Ptr GuExn -> IO ()
|
||||
|
||||
foreign import ccall "pgf/pgf.h pgf_function_type"
|
||||
pgf_function_type :: Ptr PgfPGF -> CString -> IO (Ptr PgfType)
|
||||
|
||||
Reference in New Issue
Block a user