diff --git a/src/runtime/haskell-bind/PGF2.hsc b/src/runtime/haskell-bind/PGF2.hsc index aa752d4b0..44f9d2b1c 100644 --- a/src/runtime/haskell-bind/PGF2.hsc +++ b/src/runtime/haskell-bind/PGF2.hsc @@ -318,11 +318,8 @@ mkCallbacksMap concr callbacks pool = do where match_callback match _ clin_idx csentence poffset out_pool = do sentence <- peekCString csentence - coffset <- peek poffset - offset <- alloca $ \pcsentence -> do - poke pcsentence csentence - gu2hs_string_offset pcsentence (plusPtr csentence (fromIntegral coffset)) 0 - case match (fromIntegral clin_idx) sentence offset of + coffset <- peek poffset + case match (fromIntegral clin_idx) sentence (fromIntegral coffset) of Nothing -> return nullPtr Just (e,prob,offset') -> do poke poffset (fromIntegral offset') @@ -345,13 +342,6 @@ mkCallbacksMap concr callbacks pool = do predict_callback _ _ _ _ = return nullPtr - gu2hs_string_offset pcstart cend offset = do - cstart <- peek pcstart - if cstart < cend - then do gu_utf8_decode pcstart - gu2hs_string_offset pcstart cend (offset+1) - else return offset - linearize :: Concr -> Expr -> String linearize lang e = unsafePerformIO $ withGuPool $ \pl -> diff --git a/src/runtime/haskell-bind/PGF2/FFI.hs b/src/runtime/haskell-bind/PGF2/FFI.hs index 8ddc536b9..b96c93e17 100644 --- a/src/runtime/haskell-bind/PGF2/FFI.hs +++ b/src/runtime/haskell-bind/PGF2/FFI.hs @@ -72,9 +72,6 @@ foreign import ccall "gu/enum.h gu_enum_next" foreign import ccall "gu/string.h gu_string_buf_freeze" gu_string_buf_freeze :: Ptr GuStringBuf -> Ptr GuPool -> IO CString -foreign import ccall "gu/utf8.h gu_utf8_decode" - gu_utf8_decode :: Ptr (Ptr CChar) -> IO () - withGuPool :: (Ptr GuPool -> IO a) -> IO a withGuPool f = bracket gu_new_pool gu_pool_free f diff --git a/src/runtime/haskell-bind/utils.c b/src/runtime/haskell-bind/utils.c index 8bdb99038..0724cde21 100644 --- a/src/runtime/haskell-bind/utils.c +++ b/src/runtime/haskell-bind/utils.c @@ -1,18 +1,55 @@ #include #include +#include typedef struct { PgfLiteralCallback callback; + PgfExprProb* (*match)(PgfLiteralCallback* self, + size_t lin_idx, + GuString sentence, size_t* poffset, + GuPool *out_pool); GuFinalizer fin; } HSPgfLiteralCallback; -static void +static PgfExprProb* +hspgf_match_callback(PgfLiteralCallback* self, + size_t lin_idx, + GuString sentence, size_t* poffset, + GuPool *out_pool) +{ + HSPgfLiteralCallback* callback = (HSPgfLiteralCallback*) self; + size_t offset = *poffset; + + const uint8_t *start = sentence; + const uint8_t *end = sentence + offset; + size_t hs_offset = 0; + while (start < end) { + gu_utf8_decode(&start); + hs_offset++; + } + + PgfExprProb* ep = + callback->match(self, lin_idx, sentence, &hs_offset, out_pool); + + start = sentence; + end = start; + while (hs_offset > 0) { + gu_utf8_decode(&end); + hs_offset--; + } + + *poffset = (end - start); + + return ep; +} + +static void hspgf_literal_callback_fin(GuFinalizer* self) { HSPgfLiteralCallback* callback = gu_container(self, HSPgfLiteralCallback, fin); if (callback->callback.match != NULL) - hs_free_fun_ptr((HsFunPtr) callback->callback.match); + hs_free_fun_ptr((HsFunPtr) callback->match); if (callback->callback.predict != NULL) hs_free_fun_ptr((HsFunPtr) callback->callback.predict); } @@ -23,8 +60,9 @@ hspgf_callbacks_map_add_literal(PgfConcr* concr, PgfCallbacksMap* callbacks, GuPool* pool) { HSPgfLiteralCallback* callback = gu_new(HSPgfLiteralCallback, pool); - callback->callback.match = (void*) match; + callback->callback.match = hspgf_match_callback; callback->callback.predict = (void*) predict; + callback->match = (void*) match; callback->fin.fn = hspgf_literal_callback_fin; gu_pool_finally(pool, &callback->fin); pgf_callbacks_map_add_literal(concr, callbacks, cat, &callback->callback);