started on showPGF

src/runtime/c/pgf/pgf.cxx

@@ -609,6 +609,14 @@ PgfText *pgf_print_expr(PgfExpr e,
     return printer.get_text();
 }
 
+PGF_API
+PgfText *pgf_print_ident(PgfText *name)
+{
+    PgfPrinter printer(NULL,0,NULL);
+    printer.efun(name);
+    return printer.get_text();
+}
+
 PGF_API
 PgfExpr pgf_read_expr(PgfText *input, PgfUnmarshaller *u)
 {

src/runtime/c/pgf/pgf.h

@@ -343,6 +343,9 @@ PgfText *pgf_print_expr(PgfExpr e,
                         PgfPrintContext *ctxt, int prio,
                         PgfMarshaller *m);
 
+PGF_API_DECL
+PgfText *pgf_print_ident(PgfText *name);
+
 PGF_API_DECL
 PgfExpr pgf_read_expr(PgfText *input, PgfUnmarshaller *u);
 

src/runtime/haskell/PGF2.hsc

@@ -168,7 +168,19 @@ writePGF fpath p =
     withPgfExn "writePGF" (pgf_write_pgf c_fpath (a_db p) c_revision)
 
 showPGF :: PGF -> String
-showPGF = error "TODO: showPGF"
+showPGF p =
+  render (text "abstract" <+> ppAbstractName p <+> char '{' $$
+          nest 4 (ppAbsCats p) $$
+          char '}')
+  where
+    ppAbstractName p =
+      unsafePerformIO $
+      withForeignPtr (a_revision p) $ \c_revision ->
+      bracket (withPgfExn "showPGF" (pgf_abstract_name (a_db p) c_revision)) free $ \c_text ->
+      bracket (pgf_print_ident c_text) free $ \c_text ->
+        fmap text (peekText c_text)
+
+    ppAbsCats p = empty
 
 -- | The abstract language name is the name of the top-level
 -- abstract module

src/runtime/haskell/PGF2/FFI.hsc

@@ -80,6 +80,8 @@ foreign import ccall "pgf_abstract_name"
 foreign import ccall "pgf_print_expr"
   pgf_print_expr :: StablePtr Expr -> Ptr PgfPrintContext -> CInt -> Ptr PgfMarshaller -> IO (Ptr PgfText)
 
+foreign import ccall pgf_print_ident :: Ptr PgfText -> IO (Ptr PgfText)
+
 foreign import ccall "pgf_read_expr"
   pgf_read_expr :: Ptr PgfText -> Ptr PgfUnmarshaller -> IO (StablePtr Expr)