From f22bd70585c3f1fc23cf205c8dc2280cd9975832 Mon Sep 17 00:00:00 2001 From: krangelov Date: Thu, 5 Mar 2020 11:58:21 +0100 Subject: The APIs for callbacks and the bracketed strings now use a string for the analysis intead of an integer. This is now consistent with lookupMorpho and friends --- src/runtime/haskell-bind/PGF2.hsc | 29 ++++++++++++++--------------- src/runtime/haskell-bind/PGF2/FFI.hsc | 6 +++--- src/runtime/haskell-bind/PGF2/Internal.hsc | 3 ++- src/runtime/haskell-bind/utils.c | 6 +++--- 4 files changed, 22 insertions(+), 22 deletions(-) (limited to 'src/runtime/haskell-bind') diff --git a/src/runtime/haskell-bind/PGF2.hsc b/src/runtime/haskell-bind/PGF2.hsc index 9ef325343..fd7580c3b 100644 --- a/src/runtime/haskell-bind/PGF2.hsc +++ b/src/runtime/haskell-bind/PGF2.hsc @@ -60,7 +60,7 @@ module PGF2 (-- * PGF -- ** Linearization linearize,linearizeAll,tabularLinearize,tabularLinearizeAll,bracketedLinearize,bracketedLinearizeAll, - FId, LIndex, BracketedString(..), showBracketedString, flattenBracketedString, + FId, BracketedString(..), showBracketedString, flattenBracketedString, printName, alignWords, @@ -589,7 +589,7 @@ parseWithHeuristics :: Concr -- ^ the language with which we parse -- A negative value tells the parser -- to lookup up the default from -- the grammar flags - -> [(Cat, Int -> Int -> Maybe (Expr,Float,Int))] + -> [(Cat, String -> Int -> Maybe (Expr,Float,Int))] -- ^ a list of callbacks for literal categories. -- The arguments of the callback are: -- the index of the constituent for the literal category; @@ -645,7 +645,7 @@ parseToChart :: Concr -- ^ the language with which we parse -- A negative value tells the parser -- to lookup up the default from -- the grammar flags - -> [(Cat, Int -> Int -> Maybe (Expr,Float,Int))] + -> [(Cat, String -> Int -> Maybe (Expr,Float,Int))] -- ^ a list of callbacks for literal categories. -- The arguments of the callback are: -- the index of the constituent for the literal category; @@ -761,7 +761,7 @@ parseToChart lang (Type ctype touchType) sent heuristic callbacks roots = f <- (#peek PgfParseRange, field) ptr >>= peekCString return ((fromIntegral :: CSizeT -> Int) s, (fromIntegral :: CSizeT -> Int) e, f) -mkCallbacksMap :: Ptr PgfConcr -> [(String, Int -> Int -> Maybe (Expr,Float,Int))] -> Ptr GuPool -> IO (Ptr PgfCallbacksMap) +mkCallbacksMap :: Ptr PgfConcr -> [(String, String -> Int -> Maybe (Expr,Float,Int))] -> Ptr GuPool -> IO (Ptr PgfCallbacksMap) mkCallbacksMap concr callbacks pool = do callbacks_map <- pgf_new_callbacks_map concr pool forM_ callbacks $ \(cat,match) -> do @@ -771,9 +771,10 @@ mkCallbacksMap concr callbacks pool = do hspgf_callbacks_map_add_literal concr callbacks_map ccat match predict pool return callbacks_map where - match_callback match clin_idx poffset out_pool = do + match_callback match c_ann poffset out_pool = do coffset <- peek poffset - case match (fromIntegral clin_idx) (fromIntegral coffset) of + ann <- peekUtf8CString c_ann + case match ann (fromIntegral coffset) of Nothing -> return nullPtr Just (e,prob,offset') -> do poke poffset (fromIntegral offset') @@ -1032,15 +1033,13 @@ tabularLinearizeAll lang e = unsafePerformIO $ throwIO (PGFError msg) else do throwIO (PGFError "The abstract tree cannot be linearized") -type LIndex = Int - -- | BracketedString represents a sentence that is linearized -- as usual but we also want to retain the ''brackets'' that -- mark the beginning and the end of each constituent. data BracketedString = Leaf String -- ^ this is the leaf i.e. a single token | BIND -- ^ the surrounding tokens must be bound together - | Bracket CId {-# UNPACK #-} !FId {-# UNPACK #-} !LIndex CId [BracketedString] + | Bracket CId {-# UNPACK #-} !FId {-# UNPACK #-} String CId [BracketedString] -- ^ this is a bracket. The 'CId' is the category of -- the phrase. The 'FId' is an unique identifier for -- every phrase in the sentence. For context-free grammars @@ -1049,7 +1048,7 @@ data BracketedString -- phrases then the identifiers are unique for every phrase but -- not for every bracket since the bracket represents a constituent. -- The different constituents could still be distinguished by using - -- the constituent index i.e. 'LIndex'. If the grammar is reduplicating + -- the analysis string. If the grammar is reduplicating -- then the constituent indices will be the same for all brackets -- that represents the same constituent. -- The second 'CId' is the name of the abstract function that generated @@ -1063,7 +1062,7 @@ showBracketedString = render . ppBracketedString ppBracketedString (Leaf t) = text t ppBracketedString BIND = text "&+" -ppBracketedString (Bracket cat fid index _ bss) = parens (text cat <> colon <> int fid <+> hsep (map ppBracketedString bss)) +ppBracketedString (Bracket cat fid _ _ bss) = parens (text cat <> colon <> int fid <+> hsep (map ppBracketedString bss)) -- | Extracts the sequence of tokens from the bracketed string flattenBracketedString :: BracketedString -> [String] @@ -1161,19 +1160,19 @@ withBracketLinFuncs ref exn f = token <- peekUtf8CString c_token writeIORef ref (stack,Leaf token : bs) - begin_phrase ref _ c_cat c_fid c_lindex c_fun = do + begin_phrase ref _ c_cat c_fid c_ann c_fun = do (stack,bs) <- readIORef ref writeIORef ref (bs:stack,[]) - end_phrase ref _ c_cat c_fid c_lindex c_fun = do + end_phrase ref _ c_cat c_fid c_ann c_fun = do (bs':stack,bs) <- readIORef ref if null bs then writeIORef ref (stack, bs') else do cat <- peekUtf8CString c_cat let fid = fromIntegral c_fid - let lindex = fromIntegral c_lindex + ann <- peekUtf8CString c_ann fun <- peekUtf8CString c_fun - writeIORef ref (stack, Bracket cat fid lindex fun (reverse bs) : bs') + writeIORef ref (stack, Bracket cat fid ann fun (reverse bs) : bs') symbol_ne exn _ = do gu_exn_raise exn gu_exn_type_PgfLinNonExist diff --git a/src/runtime/haskell-bind/PGF2/FFI.hsc b/src/runtime/haskell-bind/PGF2/FFI.hsc index 673c5c877..2db9577a0 100644 --- a/src/runtime/haskell-bind/PGF2/FFI.hsc +++ b/src/runtime/haskell-bind/PGF2/FFI.hsc @@ -350,7 +350,7 @@ foreign import ccall "pgf/pgf.h pgf_lzr_get_table" pgf_lzr_get_table :: Ptr PgfConcr -> Ptr PgfCncTree -> Ptr CSizeT -> Ptr (Ptr CString) -> IO () type SymbolTokenCallback = Ptr (Ptr PgfLinFuncs) -> CString -> IO () -type PhraseCallback = Ptr (Ptr PgfLinFuncs) -> CString -> CInt -> CSizeT -> CString -> IO () +type PhraseCallback = Ptr (Ptr PgfLinFuncs) -> CString -> CInt -> CString -> CString -> IO () type NonExistCallback = Ptr (Ptr PgfLinFuncs) -> IO () type BindCallback = Ptr (Ptr PgfLinFuncs) -> IO () type MetaCallback = Ptr (Ptr PgfLinFuncs) -> CInt -> IO () @@ -388,12 +388,12 @@ foreign import ccall "pgf/pgf.h pgf_parse_with_heuristics" foreign import ccall "pgf/pgf.h pgf_lookup_sentence" pgf_lookup_sentence :: Ptr PgfConcr -> PgfType -> CString -> Ptr GuPool -> Ptr GuPool -> IO (Ptr GuEnum) -type LiteralMatchCallback = CSizeT -> Ptr CSizeT -> Ptr GuPool -> IO (Ptr PgfExprProb) +type LiteralMatchCallback = CString -> Ptr CSizeT -> Ptr GuPool -> IO (Ptr PgfExprProb) foreign import ccall "wrapper" wrapLiteralMatchCallback :: LiteralMatchCallback -> IO (FunPtr LiteralMatchCallback) -type LiteralPredictCallback = CSizeT -> CString -> Ptr GuPool -> IO (Ptr PgfExprProb) +type LiteralPredictCallback = CString -> CString -> Ptr GuPool -> IO (Ptr PgfExprProb) foreign import ccall "wrapper" wrapLiteralPredictCallback :: LiteralPredictCallback -> IO (FunPtr LiteralPredictCallback) diff --git a/src/runtime/haskell-bind/PGF2/Internal.hsc b/src/runtime/haskell-bind/PGF2/Internal.hsc index ed894a361..7230c7d92 100644 --- a/src/runtime/haskell-bind/PGF2/Internal.hsc +++ b/src/runtime/haskell-bind/PGF2/Internal.hsc @@ -35,7 +35,8 @@ import Control.Exception(Exception,throwIO) import Control.Monad(foldM) import qualified Data.Map as Map -type Token = String +type Token = String +type LIndex = Int data Symbol = SymCat {-# UNPACK #-} !Int {-# UNPACK #-} !LIndex | SymLit {-# UNPACK #-} !Int {-# UNPACK #-} !LIndex diff --git a/src/runtime/haskell-bind/utils.c b/src/runtime/haskell-bind/utils.c index 91d62ea56..bee94083e 100644 --- a/src/runtime/haskell-bind/utils.c +++ b/src/runtime/haskell-bind/utils.c @@ -4,7 +4,7 @@ typedef struct { PgfLiteralCallback callback; - PgfExprProb* (*match)(size_t lin_idx, size_t* poffset, + PgfExprProb* (*match)(GuString ann, size_t* poffset, GuPool *out_pool); GuFinalizer fin; } HSPgfLiteralCallback; @@ -37,7 +37,7 @@ hspgf_hs2offset(GuString sentence, size_t hs_offset) static PgfExprProb* hspgf_match_callback(PgfLiteralCallback* self, PgfConcr* concr, - size_t lin_idx, + GuString ann, GuString sentence, size_t* poffset, GuPool *out_pool) { @@ -46,7 +46,7 @@ hspgf_match_callback(PgfLiteralCallback* self, PgfConcr* concr, size_t hs_offset = hspgf_offset2hs(sentence, *poffset); PgfExprProb* ep = - callback->match(lin_idx, &hs_offset, out_pool); + callback->match(ann, &hs_offset, out_pool); *poffset = hspgf_hs2offset(sentence, hs_offset); return ep; -- cgit v1.2.3