From eaf9f0c3ac2ce1c34a0e08de9073d8fca66a3680 Mon Sep 17 00:00:00 2001 From: Krasimir Angelov Date: Thu, 31 Aug 2017 10:58:49 +0200 Subject: the C runtime now supports the same customizations for GraphViz as the Haskell runtime --- src/runtime/c/pgf/graphviz.c | 114 ++++++++++++++++++++++++++++------- src/runtime/c/pgf/graphviz.h | 19 +++++- src/runtime/haskell-bind/PGF2.hsc | 46 +++++++++++--- src/runtime/haskell-bind/PGF2/FFI.hs | 5 +- src/runtime/java/jpgf.c | 2 + src/runtime/python/pypgf.c | 4 +- 6 files changed, 156 insertions(+), 34 deletions(-) (limited to 'src/runtime') diff --git a/src/runtime/c/pgf/graphviz.c b/src/runtime/c/pgf/graphviz.c index 0936a2d63..1498035eb 100644 --- a/src/runtime/c/pgf/graphviz.c +++ b/src/runtime/c/pgf/graphviz.c @@ -2,8 +2,12 @@ #include "graphviz.h" #include "linearizer.h" +PgfGraphvizOptions pgf_default_graphviz_options[1] = + { {0, 0, 0, 1, NULL, NULL, NULL, NULL, NULL, NULL} } ; + static int -pgf_graphviz_abstract_tree_(PgfExpr expr, int *pid, +pgf_graphviz_abstract_tree_(PgfPGF* pgf, PgfExpr expr, int *pid, + PgfGraphvizOptions* opts, GuOut* out, GuExn* err) { int id = -1; @@ -15,9 +19,16 @@ pgf_graphviz_abstract_tree_(PgfExpr expr, int *pid, break; case PGF_EXPR_APP: { PgfExprApp* app = ei.data; - id = pgf_graphviz_abstract_tree_(app->fun, pid, out, err); - int arg_id = pgf_graphviz_abstract_tree_(app->arg, pid, out, err); - gu_printf(out, err, "n%d -- n%d [style = \"solid\"]\n", id, arg_id); + id = pgf_graphviz_abstract_tree_(pgf, app->fun, pid, opts, out, err); + int arg_id = pgf_graphviz_abstract_tree_(pgf, app->arg, pid, opts, out, err); + gu_printf(out, err, "n%d -- n%d", id, arg_id); + if (opts->nodeEdgeStyle != NULL && *opts->nodeEdgeStyle && opts->nodeColor != NULL && *opts->nodeColor) + gu_printf(out, err, " [style = \"%s\", color = \"%s\"]", opts->nodeEdgeStyle, opts->nodeColor); + else if (opts->nodeEdgeStyle != NULL && *opts->nodeEdgeStyle) + gu_printf(out, err, " [style = \"%s\"]", opts->nodeEdgeStyle); + else if (opts->nodeColor != NULL && *opts->nodeColor) + gu_printf(out, err, " [color = \"%s\"]", opts->nodeColor); + gu_printf(out, err, "\n", id, arg_id); break; } case PGF_EXPR_LIT: { @@ -58,9 +69,24 @@ pgf_graphviz_abstract_tree_(PgfExpr expr, int *pid, case PGF_EXPR_FUN: { PgfExprFun* fun = ei.data; id = (*pid)++; - gu_printf(out, err, "n%d[label = \"", id); - gu_string_write(fun->fun, out, err); - gu_puts("\", style = \"solid\", shape = \"plaintext\"]\n", out, err); + if (opts->noFun && opts->noCat) { + gu_printf(out, err, "n%d[shape = \"point\"]\n", id); + } else { + gu_printf(out, err, "n%d[label = \"", id); + PgfType* ty = (opts->noCat) ? NULL : pgf_function_type(pgf, fun->fun); + if (!opts->noFun) + gu_string_write(fun->fun, out, err); + if (!opts->noFun && ty != NULL) + gu_puts(" : ", out,err); + if (ty != NULL) + gu_string_write(ty->cid, out, err); + gu_puts("\", shape = \"plaintext\", style = \"solid\"", out, err); + if (opts->nodeColor != NULL && *opts->nodeColor) + gu_printf(out, err, ", fontcolor = \"%s\"", opts->nodeColor); + if (opts->nodeFont != NULL && *opts->nodeFont) + gu_printf(out, err, ", fontname = \"%s\"", opts->nodeFont); + gu_puts("]\n", out, err); + } break; } case PGF_EXPR_VAR: @@ -68,12 +94,12 @@ pgf_graphviz_abstract_tree_(PgfExpr expr, int *pid, break; case PGF_EXPR_TYPED: { PgfExprTyped* typed = ei.data; - id = pgf_graphviz_abstract_tree_(typed->expr, pid, out, err); + id = pgf_graphviz_abstract_tree_(pgf, typed->expr, pid, opts, out, err); break; } case PGF_EXPR_IMPL_ARG: { PgfExprImplArg* implarg = ei.data; - id = pgf_graphviz_abstract_tree_(implarg->expr, pid, out, err); + id = pgf_graphviz_abstract_tree_(pgf, implarg->expr, pid, opts, out, err); break; } default: @@ -84,12 +110,12 @@ pgf_graphviz_abstract_tree_(PgfExpr expr, int *pid, } PGF_API void -pgf_graphviz_abstract_tree(PgfPGF* pgf, PgfExpr expr, GuOut* out, GuExn* err) +pgf_graphviz_abstract_tree(PgfPGF* pgf, PgfExpr expr, PgfGraphvizOptions* opts, GuOut* out, GuExn* err) { int id = 0; gu_puts("graph {\n", out, err); - pgf_graphviz_abstract_tree_(expr, &id, out, err); + pgf_graphviz_abstract_tree_(pgf, expr, &id, opts, out, err); gu_puts("}", out, err); } @@ -98,6 +124,7 @@ typedef struct PgfParseNode PgfParseNode; struct PgfParseNode { int id; PgfParseNode* parent; + GuString fun; GuString label; }; @@ -107,7 +134,7 @@ typedef struct { GuPool* pool; GuOut* out; GuExn* err; - + PgfParseNode* parent; size_t level; GuBuf* internals; @@ -122,6 +149,7 @@ pgf_bracket_lzn_symbol_token(PgfLinFuncs** funcs, PgfToken tok) PgfParseNode* node = gu_new(PgfParseNode, state->pool); node->id = 100000 + gu_buf_length(state->leaves); node->parent = state->parent; + node->fun = NULL; node->label = tok; gu_buf_push(state->leaves, PgfParseNode*, node); } @@ -156,6 +184,7 @@ pgf_bracket_lzn_begin_phrase(PgfLinFuncs** funcs, PgfCId cat, int fid, int linde PgfParseNode* node = gu_new(PgfParseNode, state->pool); node->id = fid; node->parent = state->parent; + node->fun = fun; node->label = cat; gu_buf_push(level, PgfParseNode*, node); @@ -182,6 +211,7 @@ pgf_bracket_lzn_symbol_meta(PgfLinFuncs** funcs, PgfMetaId meta_id) PgfParseNode* node = gu_new(PgfParseNode, state->pool); node->id = 100000 + gu_buf_length(state->leaves); node->parent = state->parent; + node->fun = NULL; node->label = "?"; gu_buf_push(state->leaves, PgfParseNode*, node); } @@ -197,7 +227,7 @@ static PgfLinFuncs pgf_bracket_lin_funcs = { }; static void -pgf_graphviz_parse_level(GuBuf* level, GuOut* out, GuExn* err) +pgf_graphviz_parse_level(GuBuf* level, PgfGraphvizOptions* opts, GuOut* out, GuExn* err) { gu_puts("\n subgraph {rank=same;\n", out, err); @@ -208,9 +238,32 @@ pgf_graphviz_parse_level(GuBuf* level, GuOut* out, GuExn* err) for (size_t i = 0; i < len; i++) { PgfParseNode* node = gu_buf_get(level, PgfParseNode*, i); - gu_printf(out, err, " n%d[label=\"", node->id); - gu_string_write(node->label, out, err); - gu_puts("\"]\n", out, err); + if (node->fun != NULL) { + gu_printf(out, err, " n%d[label=\"", node->id); + if (!opts->noFun) + gu_string_write(node->fun, out, err); + if (!opts->noFun && !opts->noCat) + gu_puts(" : ", out, err); + if (!opts->noCat) + gu_string_write(node->label, out, err); + gu_puts("\"", out, err); + if (opts->nodeColor != NULL && *opts->nodeColor) + gu_printf(out, err, ", fontcolor = \"%s\"", opts->nodeColor); + if (opts->nodeFont != NULL && *opts->nodeFont) + gu_printf(out, err, ", fontname = \"%s\"", opts->nodeFont); + gu_puts("]\n", out, err); + } else { + if (opts->noLeaves) + gu_printf(out, err, " n%d[label=\"\"]\n", node->id); + else { + gu_printf(out, err, " n%d[label=\"%s\"", node->id, node->label); + if (opts->leafColor != NULL && *opts->leafColor) + gu_printf(out, err, ", fontcolor = \"%s\"", opts->leafColor); + if (opts->leafFont != NULL && *opts->leafFont) + gu_printf(out, err, ", fontname = \"%s\"", opts->leafFont); + gu_puts("]\n", out, err); + } + } } if (len > 1) { @@ -227,13 +280,32 @@ pgf_graphviz_parse_level(GuBuf* level, GuOut* out, GuExn* err) for (size_t i = 0; i < len; i++) { PgfParseNode* node = gu_buf_get(level, PgfParseNode*, i); - if (node->parent != NULL) - gu_printf(out, err, " n%d -- n%d\n", node->parent->id, node->id); + if (node->parent != NULL) { + gu_printf(out, err, " n%d -- n%d", node->parent->id, node->id); + + GuString edgeStyle, color; + if (node->fun == NULL) { + edgeStyle = opts->leafEdgeStyle; + color = opts->leafColor; + } else { + edgeStyle = opts->nodeEdgeStyle; + color = opts->nodeColor; + } + + if (edgeStyle != NULL && *edgeStyle && color != NULL && *color) + gu_printf(out, err, " [style = \"%s\", color = \"%s\"]", edgeStyle, color); + else if (edgeStyle != NULL && *edgeStyle) + gu_printf(out, err, " [style = \"%s\"]", edgeStyle); + else if (color != NULL && *color) + gu_printf(out, err, " [color = \"%s\"]", color); + + gu_putc('\n', out, err); + } } } PGF_API void -pgf_graphviz_parse_tree(PgfConcr* concr, PgfExpr expr, GuOut* out, GuExn* err) +pgf_graphviz_parse_tree(PgfConcr* concr, PgfExpr expr, PgfGraphvizOptions* opts, GuOut* out, GuExn* err) { GuPool* tmp_pool = gu_local_pool(); @@ -266,9 +338,9 @@ pgf_graphviz_parse_tree(PgfConcr* concr, PgfExpr expr, GuOut* out, GuExn* err) size_t len = gu_buf_length(state.internals); for (size_t i = 0; i < len; i++) { GuBuf* level = gu_buf_get(state.internals, GuBuf*, i); - pgf_graphviz_parse_level(level, out, err); + pgf_graphviz_parse_level(level, opts, out, err); } - pgf_graphviz_parse_level(state.leaves, out, err); + pgf_graphviz_parse_level(state.leaves, opts, out, err); gu_puts("}", out, err); diff --git a/src/runtime/c/pgf/graphviz.h b/src/runtime/c/pgf/graphviz.h index f2fdf11d8..d230fdcd8 100644 --- a/src/runtime/c/pgf/graphviz.h +++ b/src/runtime/c/pgf/graphviz.h @@ -1,10 +1,25 @@ #ifndef PGF_GRAPHVIZ_H_ #define PGF_GRAPHVIZ_H_ +typedef struct { + int noLeaves; + int noFun; + int noCat; + int noDep; + GuString nodeFont; + GuString leafFont; + GuString nodeColor; + GuString leafColor; + GuString nodeEdgeStyle; + GuString leafEdgeStyle; +} PgfGraphvizOptions; + +extern PgfGraphvizOptions pgf_default_graphviz_options[1]; + PGF_API_DECL void -pgf_graphviz_abstract_tree(PgfPGF* pgf, PgfExpr expr, GuOut* out, GuExn* err); +pgf_graphviz_abstract_tree(PgfPGF* pgf, PgfExpr expr, PgfGraphvizOptions* opts, GuOut* out, GuExn* err); PGF_API_DECL void -pgf_graphviz_parse_tree(PgfConcr* concr, PgfExpr expr, GuOut* out, GuExn* err); +pgf_graphviz_parse_tree(PgfConcr* concr, PgfExpr expr, PgfGraphvizOptions* opts, GuOut* out, GuExn* err); #endif diff --git a/src/runtime/haskell-bind/PGF2.hsc b/src/runtime/haskell-bind/PGF2.hsc index 93158213f..45320c6cb 100644 --- a/src/runtime/haskell-bind/PGF2.hsc +++ b/src/runtime/haskell-bind/PGF2.hsc @@ -66,7 +66,8 @@ module PGF2 (-- * PGF -- ** Morphological Analysis MorphoAnalysis, lookupMorpho, fullFormLexicon, -- ** Visualizations - graphvizAbstractTree,graphvizParseTree, + GraphvizOptions(..), graphvizDefaults, + graphvizAbstractTree, graphvizParseTree, -- * Exceptions PGFError(..), @@ -316,30 +317,61 @@ compute (PGF p _) (Expr c_expr touch1) = ----------------------------------------------------------------------------- -- Graphviz +data GraphvizOptions = GraphvizOptions {noLeaves :: Bool, + noFun :: Bool, + noCat :: Bool, + noDep :: Bool, + nodeFont :: String, + leafFont :: String, + nodeColor :: String, + leafColor :: String, + nodeEdgeStyle :: String, + leafEdgeStyle :: String + } + +graphvizDefaults = GraphvizOptions False False False True "" "" "" "" "" "" + -- | Renders an abstract syntax tree in a Graphviz format. -graphvizAbstractTree :: PGF -> Expr -> String -graphvizAbstractTree p e = +graphvizAbstractTree :: PGF -> GraphvizOptions -> Expr -> String +graphvizAbstractTree p opts e = unsafePerformIO $ withGuPool $ \tmpPl -> do (sb,out) <- newOut tmpPl exn <- gu_new_exn tmpPl - pgf_graphviz_abstract_tree (pgf p) (expr e) out exn + c_opts <- newGraphvizOptions tmpPl opts + pgf_graphviz_abstract_tree (pgf p) (expr e) c_opts out exn touchExpr e s <- gu_string_buf_freeze sb tmpPl peekUtf8CString s -graphvizParseTree :: Concr -> Expr -> String -graphvizParseTree c e = +graphvizParseTree :: Concr -> GraphvizOptions -> Expr -> String +graphvizParseTree c opts e = unsafePerformIO $ withGuPool $ \tmpPl -> do (sb,out) <- newOut tmpPl exn <- gu_new_exn tmpPl - pgf_graphviz_parse_tree (concr c) (expr e) out exn + c_opts <- newGraphvizOptions tmpPl opts + pgf_graphviz_parse_tree (concr c) (expr e) c_opts out exn touchExpr e s <- gu_string_buf_freeze sb tmpPl peekUtf8CString s +newGraphvizOptions :: Ptr GuPool -> GraphvizOptions -> IO (Ptr PgfGraphvizOptions) +newGraphvizOptions pool opts = do + c_opts <- gu_malloc pool (#size PgfGraphvizOptions) + (#poke PgfGraphvizOptions, noLeaves) c_opts (if noLeaves opts then 1 else 0 :: CInt) + (#poke PgfGraphvizOptions, noFun) c_opts (if noFun opts then 1 else 0 :: CInt) + (#poke PgfGraphvizOptions, noCat) c_opts (if noCat opts then 1 else 0 :: CInt) + (#poke PgfGraphvizOptions, noDep) c_opts (if noDep opts then 1 else 0 :: CInt) + newUtf8CString (nodeFont opts) pool >>= (#poke PgfGraphvizOptions, nodeFont) c_opts + newUtf8CString (leafFont opts) pool >>= (#poke PgfGraphvizOptions, leafFont) c_opts + newUtf8CString (nodeColor opts) pool >>= (#poke PgfGraphvizOptions, nodeColor) c_opts + newUtf8CString (leafColor opts) pool >>= (#poke PgfGraphvizOptions, leafColor) c_opts + newUtf8CString (nodeEdgeStyle opts) pool >>= (#poke PgfGraphvizOptions, nodeEdgeStyle) c_opts + newUtf8CString (leafEdgeStyle opts) pool >>= (#poke PgfGraphvizOptions, leafEdgeStyle) c_opts + return c_opts + ----------------------------------------------------------------------------- -- Functions using Concr -- Morpho analyses, parsing & linearization diff --git a/src/runtime/haskell-bind/PGF2/FFI.hs b/src/runtime/haskell-bind/PGF2/FFI.hs index 7379aa723..e28e555c2 100644 --- a/src/runtime/haskell-bind/PGF2/FFI.hs +++ b/src/runtime/haskell-bind/PGF2/FFI.hs @@ -148,6 +148,7 @@ data PgfCallbacksMap data PgfOracleCallback data PgfCncTree data PgfLinFuncs +data PgfGraphvizOptions foreign import ccall "pgf/pgf.h pgf_read" pgf_read :: CString -> Ptr GuPool -> Ptr GuExn -> IO (Ptr PgfPGF) @@ -364,7 +365,7 @@ foreign import ccall "pgf/expr.h pgf_read_type" pgf_read_type :: Ptr GuIn -> Ptr GuPool -> Ptr GuExn -> IO PgfType foreign import ccall "pgf/graphviz.h pgf_graphviz_abstract_tree" - pgf_graphviz_abstract_tree :: Ptr PgfPGF -> PgfExpr -> Ptr GuOut -> Ptr GuExn -> IO () + pgf_graphviz_abstract_tree :: Ptr PgfPGF -> PgfExpr -> Ptr PgfGraphvizOptions -> Ptr GuOut -> Ptr GuExn -> IO () foreign import ccall "pgf/graphviz.h pgf_graphviz_parse_tree" - pgf_graphviz_parse_tree :: Ptr PgfConcr -> PgfExpr -> Ptr GuOut -> Ptr GuExn -> IO () + pgf_graphviz_parse_tree :: Ptr PgfConcr -> PgfExpr -> Ptr PgfGraphvizOptions -> Ptr GuOut -> Ptr GuExn -> IO () diff --git a/src/runtime/java/jpgf.c b/src/runtime/java/jpgf.c index 2eb151836..db662f5c2 100644 --- a/src/runtime/java/jpgf.c +++ b/src/runtime/java/jpgf.c @@ -382,6 +382,7 @@ Java_org_grammaticalframework_pgf_PGF_graphvizAbstractTree(JNIEnv* env, jobject pgf_graphviz_abstract_tree(get_ref(env,self), gu_variant_from_ptr(l2p(get_ref(env,jexpr))), + pgf_default_graphviz_options, out, err); jstring jstr = gu2j_string_buf(env, sbuf); @@ -1228,6 +1229,7 @@ Java_org_grammaticalframework_pgf_Concr_graphvizParseTree(JNIEnv* env, jobject s pgf_graphviz_parse_tree(get_ref(env,self), gu_variant_from_ptr(l2p(get_ref(env,jexpr))), + pgf_default_graphviz_options, out, err); jstring jstr = gu2j_string_buf(env, sbuf); diff --git a/src/runtime/python/pypgf.c b/src/runtime/python/pypgf.c index 70728f1c7..7da62e453 100644 --- a/src/runtime/python/pypgf.c +++ b/src/runtime/python/pypgf.c @@ -2281,7 +2281,7 @@ Concr_graphvizParseTree(ConcrObject* self, PyObject *args) { GuStringBuf* sbuf = gu_new_string_buf(tmp_pool); GuOut* out = gu_string_buf_out(sbuf); - pgf_graphviz_parse_tree(self->concr, pyexpr->expr, out, err); + pgf_graphviz_parse_tree(self->concr, pyexpr->expr, pgf_default_graphviz_options, out, err); if (!gu_ok(err)) { if (gu_exn_caught(err, PgfExn)) { GuString msg = (GuString) gu_exn_caught_data(err); @@ -3075,7 +3075,7 @@ PGF_graphvizAbstractTree(PGFObject* self, PyObject *args) { GuStringBuf* sbuf = gu_new_string_buf(tmp_pool); GuOut* out = gu_string_buf_out(sbuf); - pgf_graphviz_abstract_tree(self->pgf, pyexpr->expr, out, err); + pgf_graphviz_abstract_tree(self->pgf, pyexpr->expr, pgf_default_graphviz_options, out, err); if (!gu_ok(err)) { PyErr_SetString(PGFError, "The abstract tree cannot be visualized"); return NULL; -- cgit v1.2.3