From 82a06341036e28359c543c110d1a73644d41eff5 Mon Sep 17 00:00:00 2001 From: krasimir Date: Tue, 10 May 2016 19:41:44 +0000 Subject: [PATCH] fix the offset for oracles in Haskell --- src/runtime/haskell-bind/PGF2.hsc | 6 +- src/runtime/haskell-bind/PGF2/FFI.hs | 6 +- src/runtime/haskell-bind/utils.c | 111 +++++++++++++++++++++------ 3 files changed, 93 insertions(+), 30 deletions(-) diff --git a/src/runtime/haskell-bind/PGF2.hsc b/src/runtime/haskell-bind/PGF2.hsc index 80abc3775..96677d3bd 100644 --- a/src/runtime/haskell-bind/PGF2.hsc +++ b/src/runtime/haskell-bind/PGF2.hsc @@ -366,7 +366,7 @@ parseWithOracle lang cat sent (predict,complete,literal) = predictPtr <- maybe (return nullFunPtr) (wrapOracleCallback . oracleWrapper) predict completePtr <- maybe (return nullFunPtr) (wrapOracleCallback . oracleWrapper) complete literalPtr <- maybe (return nullFunPtr) (wrapOracleLiteralCallback . oracleLiteralWrapper) literal - cback <- hspgf_new_oracle_callback predictPtr completePtr literalPtr parsePl + cback <- hspgf_new_oracle_callback sent predictPtr completePtr literalPtr parsePl pgf_parse_with_oracle (concr lang) cat sent cback exn parsePl exprPl failed <- gu_exn_is_raised exn if failed @@ -392,12 +392,12 @@ parseWithOracle lang cat sent (predict,complete,literal) = exprs <- fromPgfExprEnum enum parseFPl (lang,exprFPl) return (Right exprs) where - oracleWrapper oracle _ catPtr lblPtr offset = do + oracleWrapper oracle catPtr lblPtr offset = do cat <- peekCString catPtr lbl <- peekCString lblPtr return (oracle cat lbl (fromIntegral offset)) - oracleLiteralWrapper oracle _ catPtr lblPtr poffset out_pool = do + oracleLiteralWrapper oracle catPtr lblPtr poffset out_pool = do cat <- peekCString catPtr lbl <- peekCString lblPtr offset <- peek poffset diff --git a/src/runtime/haskell-bind/PGF2/FFI.hs b/src/runtime/haskell-bind/PGF2/FFI.hs index 67830e890..3ba5858bc 100644 --- a/src/runtime/haskell-bind/PGF2/FFI.hs +++ b/src/runtime/haskell-bind/PGF2/FFI.hs @@ -180,8 +180,8 @@ foreign import ccall "pgf/pgf.h pgf_new_callbacks_map" foreign import ccall hspgf_callbacks_map_add_literal :: Ptr PgfConcr -> Ptr PgfCallbacksMap -> CString -> FunPtr LiteralMatchCallback -> FunPtr LiteralPredictCallback -> Ptr GuPool -> IO () -type OracleCallback = Ptr PgfOracleCallback -> CString -> CString -> CInt -> IO Bool -type OracleLiteralCallback = Ptr PgfOracleCallback -> CString -> CString -> Ptr CInt -> Ptr GuPool -> IO (Ptr PgfExprProb) +type OracleCallback = CString -> CString -> CInt -> IO Bool +type OracleLiteralCallback = CString -> CString -> Ptr CInt -> Ptr GuPool -> IO (Ptr PgfExprProb) foreign import ccall "wrapper" wrapOracleCallback :: OracleCallback -> IO (FunPtr OracleCallback) @@ -190,7 +190,7 @@ foreign import ccall "wrapper" wrapOracleLiteralCallback :: OracleLiteralCallback -> IO (FunPtr OracleLiteralCallback) foreign import ccall - hspgf_new_oracle_callback :: FunPtr OracleCallback -> FunPtr OracleCallback -> FunPtr OracleLiteralCallback -> Ptr GuPool -> IO (Ptr PgfOracleCallback) + hspgf_new_oracle_callback :: CString -> FunPtr OracleCallback -> FunPtr OracleCallback -> FunPtr OracleLiteralCallback -> Ptr GuPool -> IO (Ptr PgfOracleCallback) foreign import ccall "pgf/pgf.h pgf_parse_with_oracle" pgf_parse_with_oracle :: Ptr PgfConcr -> CString -> CString -> Ptr PgfOracleCallback -> Ptr GuExn -> Ptr GuPool -> Ptr GuPool -> IO (Ptr GuEnum) diff --git a/src/runtime/haskell-bind/utils.c b/src/runtime/haskell-bind/utils.c index 0dd9ae03b..ee1c32ea1 100644 --- a/src/runtime/haskell-bind/utils.c +++ b/src/runtime/haskell-bind/utils.c @@ -11,15 +11,9 @@ typedef struct { GuFinalizer fin; } HSPgfLiteralCallback; -static PgfExprProb* -hspgf_match_callback(PgfLiteralCallback* self, PgfConcr* concr, - size_t lin_idx, - GuString sentence, size_t* poffset, - GuPool *out_pool) +static size_t +hspgf_offset2hs(GuString sentence, size_t offset) { - HSPgfLiteralCallback* callback = (HSPgfLiteralCallback*) self; - size_t offset = *poffset; - const uint8_t *start = sentence; const uint8_t *end = sentence + offset; size_t hs_offset = 0; @@ -27,18 +21,35 @@ hspgf_match_callback(PgfLiteralCallback* self, PgfConcr* concr, gu_utf8_decode(&start); hs_offset++; } + return hs_offset; +} - PgfExprProb* ep = - callback->match(self, lin_idx, sentence, &hs_offset, out_pool); - - start = sentence; - end = start; +static size_t +hspgf_hs2offset(GuString sentence, size_t hs_offset) +{ + const uint8_t *start = sentence; + const uint8_t *end = start; while (hs_offset > 0) { gu_utf8_decode(&end); hs_offset--; } + + return (end - start); +} - *poffset = (end - start); +static PgfExprProb* +hspgf_match_callback(PgfLiteralCallback* self, PgfConcr* concr, + size_t lin_idx, + GuString sentence, size_t* poffset, + GuPool *out_pool) +{ + HSPgfLiteralCallback* callback = (HSPgfLiteralCallback*) self; + + size_t hs_offset = + hspgf_offset2hs(sentence, *poffset); + PgfExprProb* ep = + callback->match(self, lin_idx, sentence, &hs_offset, out_pool); + *poffset = hspgf_hs2offset(sentence, hs_offset); return ep; } @@ -70,29 +81,81 @@ hspgf_callbacks_map_add_literal(PgfConcr* concr, PgfCallbacksMap* callbacks, typedef struct { PgfOracleCallback oracle; + GuString sentence; + bool (*predict) (PgfCId cat, + GuString label, + size_t offset); + bool (*complete)(PgfCId cat, + GuString label, + size_t offset); + PgfExprProb* (*literal)(PgfCId cat, + GuString label, + size_t* poffset, + GuPool *out_pool); GuFinalizer fin; } HSPgfOracleCallback; +static bool +hspgf_predict_callback(PgfOracleCallback* self, + PgfCId cat, + GuString label, + size_t offset) +{ + HSPgfOracleCallback* oracle = gu_container(self, HSPgfOracleCallback, oracle); + oracle->predict(cat,label,hspgf_offset2hs(oracle->sentence, offset)); +} + +static bool +hspgf_complete_callback(PgfOracleCallback* self, + PgfCId cat, + GuString label, + size_t offset) +{ + HSPgfOracleCallback* oracle = gu_container(self, HSPgfOracleCallback, oracle); + oracle->complete(cat,label,hspgf_offset2hs(oracle->sentence, offset)); +} + +static PgfExprProb* +hspgf_literal_callback(PgfOracleCallback* self, + PgfCId cat, + GuString label, + size_t* poffset, + GuPool *out_pool) +{ + HSPgfOracleCallback* oracle = gu_container(self, HSPgfOracleCallback, oracle); + size_t hs_offset = hspgf_offset2hs(oracle->sentence, *poffset); + PgfExprProb* ep = + oracle->literal(cat,label,&hs_offset,out_pool); + *poffset = hspgf_hs2offset(oracle->sentence, hs_offset); + return ep; +} + static void hspgf_oracle_callback_fin(GuFinalizer* self) { HSPgfOracleCallback* oracle = gu_container(self, HSPgfOracleCallback, fin); - if (oracle->oracle.predict != NULL) - hs_free_fun_ptr((HsFunPtr) oracle->oracle.predict); - if (oracle->oracle.complete != NULL) - hs_free_fun_ptr((HsFunPtr) oracle->oracle.complete); - if (oracle->oracle.literal != NULL) - hs_free_fun_ptr((HsFunPtr) oracle->oracle.literal); + if (oracle->predict != NULL) + hs_free_fun_ptr((HsFunPtr) oracle->predict); + if (oracle->complete != NULL) + hs_free_fun_ptr((HsFunPtr) oracle->complete); + if (oracle->literal != NULL) + hs_free_fun_ptr((HsFunPtr) oracle->literal); } PgfOracleCallback* -hspgf_new_oracle_callback(HsFunPtr predict, HsFunPtr complete, HsFunPtr literal, GuPool* pool) +hspgf_new_oracle_callback(GuString sentence, + HsFunPtr predict, HsFunPtr complete, HsFunPtr literal, + GuPool* pool) { HSPgfOracleCallback* oracle = gu_new(HSPgfOracleCallback, pool); - oracle->oracle.predict = (void*) predict; - oracle->oracle.complete = (void*) complete; - oracle->oracle.literal = (void*) literal; + oracle->oracle.predict = predict ? hspgf_predict_callback : NULL; + oracle->oracle.complete = complete ? hspgf_complete_callback : NULL; + oracle->oracle.literal = literal ? hspgf_literal_callback : NULL; + oracle->sentence = sentence; + oracle->predict = (void*) predict; + oracle->complete = (void*) complete; + oracle->literal = (void*) literal; oracle->fin.fn = hspgf_oracle_callback_fin; gu_pool_finally(pool, &oracle->fin); return &oracle->oracle;