diff --git a/src/compiler/GF/Command/Commands.hs b/src/compiler/GF/Command/Commands.hs index ddb7763bf..30b8883ba 100644 --- a/src/compiler/GF/Command/Commands.hs +++ b/src/compiler/GF/Command/Commands.hs @@ -619,8 +619,8 @@ pgfCommands = Map.fromList [ mapM_ putStrLn ss return void else do - let funs = not (isOpt "nofun" opts) - let cats = not (isOpt "nocat" opts) + let funs = isOpt "nofun" opts + let cats = isOpt "nocat" opts let grphs = map (graphvizAbstractTree pgf (graphvizDefaults{noFun=funs,noCat=cats})) es if isFlag "view" opts || isFlag "format" opts then do diff --git a/src/runtime/c/pgf/pgf.cxx b/src/runtime/c/pgf/pgf.cxx index 00c0ea815..3abb69374 100644 --- a/src/runtime/c/pgf/pgf.cxx +++ b/src/runtime/c/pgf/pgf.cxx @@ -2067,6 +2067,24 @@ void pgf_set_concrete_flag(PgfDB *db, PgfConcrRevision revision, } PGF_API_END } +PGF_API PgfText * +pgf_graphviz_abstract_tree(PgfDB *db, PgfRevision revision, + PgfExpr expr, PgfMarshaller *m, + PgfGraphvizOptions* opts, + PgfExn *err) +{ + PGF_API_BEGIN { + DB_scope scope(db, READER_SCOPE); + + ref pgf = PgfDB::revision2pgf(revision); + + PgfAbstractGraphvizOutput out(&pgf->abstract, opts, m); + return out.generate_graphviz(expr); + } PGF_API_END + + return NULL; +} + PGF_API PgfText * pgf_graphviz_parse_tree(PgfDB *db, PgfConcrRevision revision, PgfExpr expr, PgfMarshaller *m, diff --git a/src/runtime/c/pgf/printer.cxx b/src/runtime/c/pgf/printer.cxx index fbec41f32..014192b67 100644 --- a/src/runtime/c/pgf/printer.cxx +++ b/src/runtime/c/pgf/printer.cxx @@ -447,6 +447,20 @@ void PgfPrinter::parg(ref ty, ref parg) puts(")"); } +void PgfPrinter::bindings(size_t n_vars) +{ + bool first = true; + PgfPrintContext *context = ctxt; + while (context != NULL && n_vars > 0) { + if (!first) { + puts(","); + first = false; + } + efun(&context->name); + context = context->next; + } +} + void PgfPrinter::lvar(size_t var) { char vars[] = "ijklmnopqr"; diff --git a/src/runtime/c/pgf/printer.h b/src/runtime/c/pgf/printer.h index 4cfdf0b81..6e2978c70 100644 --- a/src/runtime/c/pgf/printer.h +++ b/src/runtime/c/pgf/printer.h @@ -18,14 +18,6 @@ class PGF_INTERNAL_DECL PgfPrinter : public PgfUnmarshaller { // of lambda expressions is finished. void flush_lambdas(); - // Push a new variable in the printing context. If the name - // collides with an existing variable, the variable is renamed - // by adding a number. - void push_variable(PgfText *name); - - // Pop the last variable name from the context. - void pop_variable(); - // The current operator priority int prio; @@ -39,6 +31,14 @@ public: PgfPrinter(PgfPrintContext *context, int priority, PgfMarshaller *marshaller); + // Push a new variable in the printing context. If the name + // collides with an existing variable, the variable is renamed + // by adding a number. + void push_variable(PgfText *name); + + // Pop the last variable name from the context. + void pop_variable(); + void puts(PgfText *s); void puts(const char *s); @@ -72,6 +72,8 @@ public: PgfText *cat, size_t n_exprs, PgfExpr *exprs); virtual void free_ref(object x); + + void bindings(size_t n_vars); }; #endif diff --git a/src/runtime/haskell/PGF2.hsc b/src/runtime/haskell/PGF2.hsc index ef98989bf..031075eef 100644 --- a/src/runtime/haskell/PGF2.hsc +++ b/src/runtime/haskell/PGF2.hsc @@ -881,7 +881,14 @@ withGraphvizOptions opts f = -- | Renders an abstract syntax tree in a Graphviz format. graphvizAbstractTree :: PGF -> GraphvizOptions -> Expr -> String -graphvizAbstractTree p opts e = error "TODO: graphvizAbstractTree" +graphvizAbstractTree p opts e = + unsafePerformIO $ + withForeignPtr (a_revision p) $ \c_revision -> + bracket (newStablePtr e) freeStablePtr $ \c_e -> + withForeignPtr marshaller $ \m -> + withGraphvizOptions opts $ \c_opts -> + bracket (withPgfExn "graphvizAbstractTree" (pgf_graphviz_abstract_tree (a_db p) c_revision c_e m c_opts)) free $ \c_text -> + peekText c_text graphvizParseTree :: Concr -> GraphvizOptions -> Expr -> String graphvizParseTree c opts e = diff --git a/src/runtime/haskell/PGF2/FFI.hsc b/src/runtime/haskell/PGF2/FFI.hsc index 47cee9485..44bf8ba80 100644 --- a/src/runtime/haskell/PGF2/FFI.hsc +++ b/src/runtime/haskell/PGF2/FFI.hsc @@ -227,6 +227,8 @@ foreign import ccall pgf_get_concrete_flag :: Ptr PgfDB -> Ptr Concr -> Ptr PgfT foreign import ccall pgf_set_concrete_flag :: Ptr PgfDB -> Ptr Concr -> Ptr PgfText -> StablePtr Literal -> Ptr PgfMarshaller -> Ptr PgfExn -> IO () +foreign import ccall pgf_graphviz_abstract_tree :: Ptr PgfDB -> Ptr PGF -> StablePtr Expr -> Ptr PgfMarshaller -> Ptr PgfGraphvizOptions -> Ptr PgfExn -> IO (Ptr PgfText) + foreign import ccall pgf_graphviz_parse_tree :: Ptr PgfDB -> Ptr Concr -> StablePtr Expr -> Ptr PgfMarshaller -> Ptr PgfGraphvizOptions -> Ptr PgfExn -> IO (Ptr PgfText)