diff --git a/src/runtime/c/pgf/pgf.cxx b/src/runtime/c/pgf/pgf.cxx index 278141f98..b176b1cee 100644 --- a/src/runtime/c/pgf/pgf.cxx +++ b/src/runtime/c/pgf/pgf.cxx @@ -1003,6 +1003,31 @@ PgfText *pgf_print_sequence_internal(size_t seq_id, object o) return printer.get_text(); } +PGF_API +PgfText *pgf_sequence_get_text_internal(object o) +{ + ref seq = o; + + PgfPrinter printer(NULL,0,NULL); + for (size_t i = 0; i < seq->syms.len; i++) { + if (i > 0) + printer.puts(" "); + + PgfSymbol sym = *vector_elem(&seq->syms, i); + switch (ref::get_tag(sym)) { + case PgfSymbolKS::tag: { + auto sym_ks = ref::untagged(sym); + printer.puts(&sym_ks->token); + break; + } + default: + return NULL; + } + } + + return printer.get_text(); +} + PGF_API_DECL void pgf_release_phrasetable_ids(PgfPhrasetableIds *seq_ids) { diff --git a/src/runtime/c/pgf/pgf.h b/src/runtime/c/pgf/pgf.h index 098600dd2..850f858a9 100644 --- a/src/runtime/c/pgf/pgf.h +++ b/src/runtime/c/pgf/pgf.h @@ -428,6 +428,9 @@ PgfText *pgf_print_lin_internal(PgfPhrasetableIds *seq_ids, object o, size_t i); PGF_API_DECL PgfText *pgf_print_sequence_internal(size_t seq_id, object o); +PGF_API_DECL +PgfText *pgf_sequence_get_text_internal(object o); + PGF_API_DECL void pgf_release_phrasetable_ids(PgfPhrasetableIds *seq_ids); diff --git a/src/runtime/c/pgf/printer.h b/src/runtime/c/pgf/printer.h index 0d9ca0695..e41df556a 100644 --- a/src/runtime/c/pgf/printer.h +++ b/src/runtime/c/pgf/printer.h @@ -33,6 +33,8 @@ public: PgfPrinter(PgfPrintContext *context, int priority, PgfMarshaller *marshaller); + PgfPrinter() { free(res); } + // Push a new variable in the printing context. If the name // collides with an existing variable, the variable is renamed // by adding a number. diff --git a/src/runtime/haskell/PGF2.hsc b/src/runtime/haskell/PGF2.hsc index 48d750b38..623167297 100644 --- a/src/runtime/haskell/PGF2.hsc +++ b/src/runtime/haskell/PGF2.hsc @@ -568,7 +568,23 @@ unk w [] | any (not . isPunctuation) w = True unk _ _ = False fullFormLexicon :: Concr -> [(String, [MorphoAnalysis])] -fullFormLexicon lang = error "TODO: fullFormLexicon" +fullFormLexicon c = unsafePerformIO $ do + ref <- newIORef [] + (allocaBytes (#size PgfSequenceItor) $ \itor -> + bracket (wrapSequenceItorCallback (getSequences ref)) freeHaskellFunPtr $ \fptr -> + withForeignPtr (c_revision c) $ \c_revision -> do + (#poke PgfSequenceItor, fn) itor fptr + seq_ids <- withPgfExn "fullFormLexicon" (pgf_iter_sequences (c_db c) c_revision itor) + pgf_release_phrasetable_ids seq_ids) + fmap reverse (readIORef ref) + where + getSequences ref itor seq_id val exn = do + bracket (pgf_sequence_get_text_internal val) free $ \c_text -> + if c_text == nullPtr + then return () + else do lemma <- peekText c_text + modifyIORef ref $ (\lexicon -> (lemma, []) : lexicon) + -- | This data type encodes the different outcomes which you could get from the parser. data ParseOutput a diff --git a/src/runtime/haskell/PGF2/FFI.hsc b/src/runtime/haskell/PGF2/FFI.hsc index 502078095..b4530456f 100644 --- a/src/runtime/haskell/PGF2/FFI.hsc +++ b/src/runtime/haskell/PGF2/FFI.hsc @@ -132,6 +132,8 @@ foreign import ccall pgf_print_lin_internal :: Ptr PgfPhrasetableIds -> Ptr () - foreign import ccall pgf_print_sequence_internal :: CSize -> Ptr () -> IO (Ptr PgfText) +foreign import ccall pgf_sequence_get_text_internal :: Ptr () -> IO (Ptr PgfText) + foreign import ccall pgf_release_phrasetable_ids :: Ptr PgfPhrasetableIds -> IO () type ItorCallback = Ptr PgfItor -> Ptr PgfText -> Ptr () -> Ptr PgfExn -> IO ()