FM-SBLEX-3.0: src/lib/CTrie.hs
----------------------------------------------------------------------
-- |
-- Module : Dictionary
-- Maintainer : Markus Forsberg
-- Stability : (stability)
-- Portability : (portability)
--
-- > CVS $Date: 2006/10/15 15:54:16 $
-- > CVS $Author: markus $
-- > CVS $Revision: 1.19 $
--
-- A Trie ADT for Functional Morphology
-----------------------------------------------------------------------------
module CTrie (
buildTrie,
buildTrieDict,
buildTrieDictSynt,
buildTrieWordlist,
trie_lookup,
isInTrie,
decompose
) where
import System.IO
import System.IO.Unsafe
import List
import Foreign.C
import Compound
import qualified Data.Set as Set
import Data.Char (isDigit)
import Monad(when)
import Dictionary(dict2fullform,dict2idlex,Dictionary,FullFormLex)
foreign import ccall "trie_lib.h build" build :: CString -> IO()
foreign import ccall "trie_lib.h lookup_t" lookup_t :: CString -> IO()
foreign import ccall "trie_lib.h start" start :: IO()
foreign import ccall "trie_lib.h stop" stop :: IO()
foreign import ccall "trie_lib.h next" next :: IO CString
foreign import ccall "trie_lib.h more" more :: IO CInt
foreign import ccall "trie_lib.h getNumber" getNumber :: CString -> CInt
foreign import ccall "trie_lib.h in_t" in_t :: CString -> CInt
foreign import ccall "trie_lib.h empty" empty :: IO()
foreign import ccall "trie_lib.h insert_t" insert_t :: CString -> CString -> IO()
foreign import ccall "trie_lib.h reversed" reversed :: IO()
foreign import ccall "trie_lib.h no_count" no_count :: IO()
type Attr = Int
-----------------------------------------------------------------------
{- | Constructs a C-trie from a file containing a fullform lexicon. -}
buildTrie :: FilePath -> Bool -> Bool -> IO ()
buildTrie f cb b = do fc <- newCString f
when b reversed
build fc
{- | Constructs a C-trie from a Dictionary ADT. Note that the trie
is not handled in Haskell. It is instead a global object in C. -}
buildTrieDict :: Bool -> Dictionary -> Bool -> IO ()
buildTrieDict cb d b =
do empty
when b reversed
start
build_it $ prLex cb $ dict2fullform d
stop
buildTrieDictSynt :: Dictionary -> Bool -> IO ()
buildTrieDictSynt d b =
do empty
when b reversed
start
build_it $ prLex False $ (dict2fullform d)
no_count
build_it $ prLex False $ (dict2idlex d)
stop
prLex :: Bool -> FullFormLex -> [(String,String)]
prLex b = concat . map prOne where
prOne (s,ps) = [(s,a) | a <- map prAttr ps]
prAttr (a,ss) = ss -- ++ prCompAttr a
-- prCompAttr a = if b then " [" ++ show a ++ "] " else ""
{- | Inserts the wordform-analysis pairs into the C-trie. -}
build_it :: [(String,String)] -> IO()
build_it [] = return ()
build_it ((w1,w2):xs) = do c1 <- newCString w1
c2 <- newCString w2
insert_t c1 c2
build_it xs
{- |Build an undecorated trie (a simple trie). -}
buildTrieWordlist :: [String] -> Bool -> IO ()
buildTrieWordlist xs b = do empty
when b reversed
start
build_it (zip xs (repeat []))
stop
{-# INLINE trie_lookup #-}
trie_lookup :: Bool -> String -> [(Attr,String)]
trie_lookup cb = cstring2string . lookup_trie cb
lookup_trie :: Bool -> String -> [(Attr,CString)]
lookup_trie cb s =
unsafePerformIO $
do withCString s lookup_t
process
where process = do i <- more
case i == 1 of
False -> return []
_ -> do cs <- next
xs <- process
let n = if cb then toInt (getNumber cs) else 0
return ((n,cs):xs)
toInt = fromInteger . toInteger
{- |Is the string a member in the trie? -}
isInTrie :: String -> Bool
isInTrie s = unsafePerformIO $
do sc <- newCString s
return $ in_t sc == 1
{- |Compound analysis -}
decompose :: Maybe CompDesc -> ((String,String) -> [(String,String)]) -> String -> [[(Attr,String)]]
decompose _ _ [] = []
decompose (Just f) sandhi sentence =
map cstring2string $ deconstruct sentence f sandhi
decompose Nothing _ sentence = [[x] | x <- trie_lookup False sentence]
{- |Translates the CString:s to String:s.-}
cstring2string :: [(Attr,CString)] -> [(Attr,String)]
cstring2string = map f
where f (a,cs) = (a,unsafePerformIO $ peekCString cs)
deconstruct :: String -> CompDesc -> ((String,String) -> [(String,String)]) -> [[(Attr,CString)]]
deconstruct [] comp _ = if done comp then [[]] else []
deconstruct s comp sandhi =
[p1:rs | (p'@(_:_),r') <- zip (inits s) (tails s),
(p,r) <- sandhi (p',r'),
(p1,Just ncomp) <- [((a,str),step comp a) | (a,str) <- lookup_trie True p],
rs <- deconstruct r ncomp sandhi]