diff --git a/src/runtime/c/pgf/pgf.cxx b/src/runtime/c/pgf/pgf.cxx index 0360753ba..10246eb32 100644 --- a/src/runtime/c/pgf/pgf.cxx +++ b/src/runtime/c/pgf/pgf.cxx @@ -2047,6 +2047,38 @@ int pgf_has_linearization(PgfDB *db, PgfConcrRevision revision, return 0; } +PGF_API +PgfText **pgf_category_fields(PgfDB *db, PgfConcrRevision revision, + PgfText *name, size_t *p_n_fields, + PgfExn *err) +{ + PGF_API_BEGIN { + DB_scope scope(db, READER_SCOPE); + + ref concr = PgfDB::revision2concr(revision); + + ref lincat = + namespace_lookup(concr->lincats, name); + + if (lincat == 0) { + *p_n_fields = 0; + return NULL; + } else { + size_t n_fields = lincat->fields->len; + PgfText **fields = (PgfText **) malloc(sizeof(PgfText*)*n_fields); + if (fields == 0) + throw pgf_systemerror(ENOMEM); + for (size_t i = 0; i < n_fields; i++) { + fields[i] = textdup(lincat->fields->data[i]); + } + *p_n_fields = n_fields; + return fields; + } + } PGF_API_END + + return NULL; +} + PGF_API PgfText *pgf_linearize(PgfDB *db, PgfConcrRevision revision, PgfExpr expr, PgfPrintContext *ctxt, diff --git a/src/runtime/c/pgf/pgf.h b/src/runtime/c/pgf/pgf.h index b43439527..b77c325e8 100644 --- a/src/runtime/c/pgf/pgf.h +++ b/src/runtime/c/pgf/pgf.h @@ -590,6 +590,11 @@ PGF_API_DECL int pgf_has_linearization(PgfDB *db, PgfConcrRevision revision, PgfText *name, PgfExn *err); +PGF_API +PgfText **pgf_category_fields(PgfDB *db, PgfConcrRevision revision, + PgfText *name, size_t *p_n_fields, + PgfExn *err); + #ifdef __cplusplus struct PgfLinearizationOutputIface { diff --git a/src/runtime/haskell/PGF2.hsc b/src/runtime/haskell/PGF2.hsc index a25c23eb4..c2a539145 100644 --- a/src/runtime/haskell/PGF2.hsc +++ b/src/runtime/haskell/PGF2.hsc @@ -74,7 +74,7 @@ module PGF2 (-- * PGF linearize, linearizeAll, tabularLinearize, tabularLinearizeAll, FId, BracketedString(..), showBracketedString, flattenBracketedString, bracketedLinearize, bracketedLinearizeAll, - hasLinearization, + hasLinearization, categoryFields, printName, alignWords, gizaAlignment, -- ** Parsing @@ -613,6 +613,27 @@ hasLinearization c name = c_res <- withPgfExn "hasLinearization" (pgf_has_linearization (c_db c) c_revision c_name) return (c_res /= 0) +categoryFields :: Concr -> Cat -> Maybe [String] +categoryFields c cat = + unsafePerformIO $ + withForeignPtr (c_revision c) $ \c_revision -> + withText cat $ \c_cat -> + alloca $ \p_n_fields -> + bracket (withPgfExn "categoryFields" (pgf_category_fields (c_db c) c_revision c_cat p_n_fields)) free $ \c_fields -> + if c_fields == nullPtr + then return Nothing + else do n_fields <- peek p_n_fields + fs <- peekFields n_fields c_fields + return (Just fs) + where + peekFields n_fields c_fields + | n_fields == 0 = return [] + | otherwise = do c_text <- peek c_fields + f <- peekText c_text + free c_text + fs <- peekFields (n_fields-1) (c_fields `plusPtr` (#size PgfText*)) + return (f:fs) + -- | Linearizes an expression as a string in the language linearize :: Concr -> Expr -> String linearize c e = diff --git a/src/runtime/haskell/PGF2/FFI.hsc b/src/runtime/haskell/PGF2/FFI.hsc index b6a563754..be3149cbf 100644 --- a/src/runtime/haskell/PGF2/FFI.hsc +++ b/src/runtime/haskell/PGF2/FFI.hsc @@ -210,6 +210,8 @@ foreign import ccall pgf_drop_lin :: Ptr PgfDB -> Ptr Concr -> Ptr PgfText -> Pt foreign import ccall pgf_has_linearization :: Ptr PgfDB -> Ptr Concr -> Ptr PgfText -> Ptr PgfExn -> IO CInt +foreign import ccall pgf_category_fields :: Ptr PgfDB -> Ptr Concr -> Ptr PgfText -> Ptr CSize -> Ptr PgfExn -> IO (Ptr (Ptr PgfText)) + foreign import ccall pgf_linearize :: Ptr PgfDB -> Ptr Concr -> StablePtr Expr -> Ptr PgfPrintContext -> Ptr PgfMarshaller -> Ptr PgfExn -> IO (Ptr PgfText) foreign import ccall pgf_linearize_all :: Ptr PgfDB -> Ptr Concr -> StablePtr Expr -> Ptr PgfPrintContext -> Ptr PgfMarshaller -> Ptr CSize -> Ptr PgfExn -> IO (Ptr (Ptr PgfText)) diff --git a/src/runtime/haskell/tests/linearization.hs b/src/runtime/haskell/tests/linearization.hs index 3f1c5f345..672177374 100644 --- a/src/runtime/haskell/tests/linearization.hs +++ b/src/runtime/haskell/tests/linearization.hs @@ -19,6 +19,8 @@ main = do ,TestCase (assertEqual "floatLit" "3.14" (linearize cnc (mkApp "floatLit" [mkFloat 3.14]))) ,TestCase (assertEqual "stringLit" "abcd" (linearize cnc (mkApp "stringLit" [mkStr "abcd"]))) ,TestCase (assertEqual "parse tree 2" graphviz_parse2 (graphvizParseTree cnc graphvizDefaults (mkApp "stringLit" [mkStr "abcd"]))) + ,TestCase (assertEqual "categoryFields 1" (Just ["s"]) (categoryFields cnc "N")) + ,TestCase (assertEqual "categoryFields 2" Nothing (categoryFields cnc "NonExistingCat")) ] graphviz_parse1="graph {\n node[shape=plaintext]\n\n subgraph {\n rank=same;\n n1[label=\"c : S\"]\n }\n\n subgraph {\n rank=same;\n n2[label=\"s : N\"]\n }\n n1 -- n2\n\n subgraph {\n rank=same;\n n3[label=\"_ : N\"]\n }\n n2 -- n3\n\n subgraph {\n rank=same;\n edge[style=invis]\n n100000[label=\"?1\"]\n n100001[label=\"+\"]\n n100002[label=\"1\"]\n n100000 -- n100001 -- n100002\n }\n n3 -- n100000\n n2 -- n100001\n n2 -- n100002\n}"