From dccb9681a29db5de76c77f67b56cbb84ebaba5a8 Mon Sep 17 00:00:00 2001
From: Krasimir Angelov <kr.angelov@gmail.com>
Date: Tue, 19 Sep 2023 21:19:54 +0200
Subject: [PATCH] started a graphviz visualization for the LR(0) automaton

---
 src/compiler/GF/Compile/Export.hs |  2 +-
 src/compiler/GF/Infra/Option.hs   |  4 +++-
 src/runtime/c/pgf/pgf.cxx         | 27 +++++++++++++++++++++++++++
 src/runtime/c/pgf/pgf.h           |  4 ++++
 src/runtime/haskell/PGF2.hsc      | 11 ++++++++++-
 src/runtime/haskell/PGF2/FFI.hsc  |  2 ++
 6 files changed, 47 insertions(+), 3 deletions(-)

diff --git a/src/compiler/GF/Compile/Export.hs b/src/compiler/GF/Compile/Export.hs
index 816af0aa67..6032448626 100644
--- a/src/compiler/GF/Compile/Export.hs
+++ b/src/compiler/GF/Compile/Export.hs
@@ -48,6 +48,7 @@ exportPGF opts fmt pgf =
       FmtSLF          -> single "slf"  slfPrinter
       FmtRegExp       -> single "rexp" regexpPrinter
       FmtFA           -> single "dot"  slfGraphvizPrinter
+      FmtLR           -> single "dot"  (\_ -> graphvizLRAutomaton)
  where
    name = fromMaybe (abstractName pgf) (flag optName opts)
 
@@ -58,4 +59,3 @@ exportPGF opts fmt pgf =
 
    single :: String -> (PGF -> Concr -> String) -> [(FilePath,String)]
    single ext pr = [(concreteName cnc <.> ext, pr pgf cnc) | cnc <- Map.elems (languages pgf)]
-
diff --git a/src/compiler/GF/Infra/Option.hs b/src/compiler/GF/Infra/Option.hs
index 6ee81ea1d4..373d2ac727 100644
--- a/src/compiler/GF/Infra/Option.hs
+++ b/src/compiler/GF/Infra/Option.hs
@@ -106,6 +106,7 @@ data OutputFormat = FmtPGFPretty
                   | FmtSLF
                   | FmtRegExp
                   | FmtFA
+                  | FmtLR
   deriving (Eq,Ord)
 
 data SISRFormat =
@@ -490,7 +491,8 @@ outputFormatsExpl =
      (("vxml",         FmtVoiceXML),"Voice XML based on abstract syntax"),
      (("slf",          FmtSLF),"SLF speech recognition format"),
      (("regexp",       FmtRegExp),"regular expression"),
-     (("fa",           FmtFA),"finite automaton in graphviz format")
+     (("fa",           FmtFA),"finite automaton in graphviz format"),
+     (("lr",           FmtLR),"LR(0) automaton for PMCFG in graphviz format")
      ]
 
 instance Show OutputFormat where
diff --git a/src/runtime/c/pgf/pgf.cxx b/src/runtime/c/pgf/pgf.cxx
index de7d30a2b1..18664bbaf6 100644
--- a/src/runtime/c/pgf/pgf.cxx
+++ b/src/runtime/c/pgf/pgf.cxx
@@ -3137,3 +3137,30 @@ pgf_align_words(PgfDB *db, PgfConcrRevision revision,
 
     return NULL;
 }
+
+PGF_API PgfText *
+pgf_graphviz_lr_automaton(PgfDB *db, PgfConcrRevision revision,
+                          PgfExn *err)
+{
+    PGF_API_BEGIN {
+        DB_scope scope(db, READER_SCOPE);
+
+        ref<PgfConcr> concr = db->revision2concr(revision);
+
+        PgfPrinter printer(NULL,0,NULL);
+        
+        printer.puts("digraph {");
+        for (size_t i = 0; i < concr->lrtable->len; i++) {
+            ref<PgfLRState> state = vector_elem(concr->lrtable, i);
+            for (size_t j = 0; j < state->shifts->len; j++) {
+                ref<PgfLRShift> shift = vector_elem(state->shifts, j);
+                printer.nprintf(16, "  s%zu -> s%zu;\n", i, shift->next_state);
+            }
+        }
+        printer.puts("}");
+
+        return printer.get_text();
+    } PGF_API_END
+
+    return NULL;
+}
diff --git a/src/runtime/c/pgf/pgf.h b/src/runtime/c/pgf/pgf.h
index 675ababcc4..9747ecad32 100644
--- a/src/runtime/c/pgf/pgf.h
+++ b/src/runtime/c/pgf/pgf.h
@@ -906,4 +906,8 @@ pgf_align_words(PgfDB *db, PgfConcrRevision revision,
                 size_t *n_phrases /* out */,
                 PgfExn* err);
 
+PGF_API PgfText *
+pgf_graphviz_lr_automaton(PgfDB *db, PgfConcrRevision revision,
+                          PgfExn *err);
+
 #endif // PGF_H_
diff --git a/src/runtime/haskell/PGF2.hsc b/src/runtime/haskell/PGF2.hsc
index 6ffa7819cc..7f1e0d7da3 100644
--- a/src/runtime/haskell/PGF2.hsc
+++ b/src/runtime/haskell/PGF2.hsc
@@ -72,7 +72,7 @@ module PGF2 (-- * PGF
              graphvizAbstractTree, graphvizParseTree,
              Labels, getDepLabels,
              graphvizDependencyTree, conlls2latexDoc, getCncDepLabels,
-             graphvizWordAlignment,
+             graphvizWordAlignment, graphvizLRAutomaton,
 
              -- * Concrete syntax
              ConcName,Concr,languages,concreteName,languageCode,concreteFlag,
@@ -1389,6 +1389,15 @@ graphvizDependencyTree
   -> String -- ^ Rendered output in the specified format
 graphvizDependencyTree format debug mlab mclab concr t = error "TODO: graphvizDependencyTree"
 
+graphvizLRAutomaton :: Concr -> String
+graphvizLRAutomaton c =
+  unsafePerformIO $
+  withForeignPtr (c_revision c) $ \c_revision ->
+  bracket (withPgfExn "graphvizLRAutomaton" (pgf_graphviz_lr_automaton (c_db c) c_revision)) free $ \c_text ->
+    if c_text == nullPtr
+      then return ""
+      else peekText c_text
+
 ---------------------- should be a separate module?
 
 -- visualization with latex output. AR Nov 2015
diff --git a/src/runtime/haskell/PGF2/FFI.hsc b/src/runtime/haskell/PGF2/FFI.hsc
index f882e984cd..1ee6176407 100644
--- a/src/runtime/haskell/PGF2/FFI.hsc
+++ b/src/runtime/haskell/PGF2/FFI.hsc
@@ -315,6 +315,8 @@ foreign import ccall pgf_graphviz_parse_tree :: Ptr PgfDB -> Ptr Concr -> Stable
 
 foreign import ccall pgf_graphviz_word_alignment :: Ptr PgfDB -> Ptr (Ptr Concr) -> CSize -> StablePtr Expr -> Ptr PgfPrintContext -> Ptr PgfMarshaller -> Ptr PgfGraphvizOptions -> Ptr PgfExn -> IO (Ptr PgfText)
 
+foreign import ccall pgf_graphviz_lr_automaton :: Ptr PgfDB -> Ptr Concr -> Ptr PgfExn -> IO (Ptr PgfText)
+
 
 -----------------------------------------------------------------------
 -- Texts