From a7bf47cb87129d03a8e5373d0581aaf02193c830 Mon Sep 17 00:00:00 2001
From: krangelov <kr.angelov@gmail.com>
Date: Tue, 14 Sep 2021 19:10:01 +0200
Subject: [PATCH] added showContext

---
 src/runtime/c/pgf/pgf.cxx        | 14 ++++++++++++
 src/runtime/c/pgf/pgf.h          |  5 +++++
 src/runtime/c/pgf/printer.cxx    | 38 ++++++++++++++++++--------------
 src/runtime/c/pgf/printer.h      |  2 ++
 src/runtime/haskell/PGF2.hsc     |  8 ++++++-
 src/runtime/haskell/PGF2/FFI.hsc |  2 ++
 6 files changed, 51 insertions(+), 18 deletions(-)

diff --git a/src/runtime/c/pgf/pgf.cxx b/src/runtime/c/pgf/pgf.cxx
index 1c08025a4..4b56a6547 100644
--- a/src/runtime/c/pgf/pgf.cxx
+++ b/src/runtime/c/pgf/pgf.cxx
@@ -467,6 +467,20 @@ PgfText *pgf_print_type(PgfType ty,
     return printer.get_text();
 }
 
+PGF_API
+PgfText *pgf_print_context(size_t n_hypos, PgfTypeHypo *hypos,
+                           PgfPrintContext *ctxt, int prio,
+                           PgfMarshaller *m)
+{
+    PgfPrinter printer(ctxt,prio,m);
+    for (size_t i = 0; i < n_hypos; i++) {
+        if (i > 0)
+            printer.puts(" ");
+        printer.hypo(&hypos[i]);
+    }
+    return printer.get_text();
+}
+
 PGF_API
 PgfType pgf_read_type(PgfText *input, PgfUnmarshaller *u)
 {
diff --git a/src/runtime/c/pgf/pgf.h b/src/runtime/c/pgf/pgf.h
index cba765073..87e7ceaae 100644
--- a/src/runtime/c/pgf/pgf.h
+++ b/src/runtime/c/pgf/pgf.h
@@ -331,6 +331,11 @@ PgfText *pgf_print_type(PgfType ty,
                         PgfPrintContext *ctxt, int prio,
                         PgfMarshaller *m);
 
+PGF_API_DECL
+PgfText *pgf_print_context(size_t n_hypos, PgfTypeHypo *hypos,
+                           PgfPrintContext *ctxt, int prio,
+                           PgfMarshaller *m);
+
 PGF_API_DECL
 PgfType pgf_read_type(PgfText *input, PgfUnmarshaller *u);
 
diff --git a/src/runtime/c/pgf/printer.cxx b/src/runtime/c/pgf/printer.cxx
index 633c4db14..7c68abcd4 100644
--- a/src/runtime/c/pgf/printer.cxx
+++ b/src/runtime/c/pgf/printer.cxx
@@ -380,6 +380,26 @@ PgfLiteral PgfPrinter::lstr(PgfText *v)
     return 0;
 }
 
+void PgfPrinter::hypo(PgfTypeHypo *hypo)
+{
+    if (textcmp(hypo->cid, &wildcard) == 0) {
+        prio = 1;
+        m->match_type(this, hypo->type);
+    } else {
+        push_variable(hypo->cid);
+
+        puts("(");
+        if (hypo->bind_type == PGF_BIND_TYPE_IMPLICIT)
+            puts("{");
+        puts(&ctxt->name);
+        if (hypo->bind_type == PGF_BIND_TYPE_IMPLICIT)
+            puts("}");
+        puts(" : ");
+        m->match_type(this, hypo->type);
+        puts(")");
+    }
+}
+
 PgfType PgfPrinter::dtyp(size_t n_hypos, PgfTypeHypo *hypos,
                          PgfText *cat,
                          size_t n_exprs, PgfExpr *exprs)
@@ -391,23 +411,7 @@ PgfType PgfPrinter::dtyp(size_t n_hypos, PgfTypeHypo *hypos,
     PgfPrintContext *save_ctxt = ctxt;
 
     for (int i = 0; i < n_hypos; i++) {
-        if (textcmp(hypos[i].cid, &wildcard) == 0) {
-            prio = 1;
-            m->match_type(this, hypos[i].type);
-        } else {
-            push_variable(hypos[i].cid);
-
-            puts("(");
-            if (hypos[i].bind_type == PGF_BIND_TYPE_IMPLICIT)
-                puts("{");
-            puts(&ctxt->name);
-            if (hypos[i].bind_type == PGF_BIND_TYPE_IMPLICIT)
-                puts("}");
-            puts(" : ");
-            m->match_type(this, hypos[i].type);
-            puts(")");
-        }
-
+        hypo(&hypos[i]);
         puts(" -> ");
     }
 
diff --git a/src/runtime/c/pgf/printer.h b/src/runtime/c/pgf/printer.h
index 6bf39537b..12b26f0da 100644
--- a/src/runtime/c/pgf/printer.h
+++ b/src/runtime/c/pgf/printer.h
@@ -50,6 +50,8 @@ public:
 
     PgfText *get_text();
 
+    void hypo(PgfTypeHypo *hypo);
+
     virtual PgfExpr eabs(PgfBindType btype, PgfText *name, PgfExpr body);
     virtual PgfExpr eapp(PgfExpr fun, PgfExpr arg);
     virtual PgfExpr elit(PgfLiteral lit);
diff --git a/src/runtime/haskell/PGF2.hsc b/src/runtime/haskell/PGF2.hsc
index c0d8c08fa..de3037487 100644
--- a/src/runtime/haskell/PGF2.hsc
+++ b/src/runtime/haskell/PGF2.hsc
@@ -912,7 +912,13 @@ showType scope ty =
     peekText c_text
 
 showContext :: [Var] -> [(BindType,Var,Type)] -> String
-showContext = error "TODO: showContext"
+showContext scope hypos =
+  unsafePerformIO $
+  withHypos hypos $ \n_hypos c_hypos ->
+  bracket (newPrintCtxt scope) freePrintCtxt $ \pctxt ->
+  withForeignPtr marshaller $ \m ->
+  bracket (pgf_print_context n_hypos c_hypos pctxt 0 m) free $ \c_text ->
+    peekText c_text
 
 -- | parses a 'String' as a type
 readType :: String -> Maybe Type
diff --git a/src/runtime/haskell/PGF2/FFI.hsc b/src/runtime/haskell/PGF2/FFI.hsc
index d2eb127ce..b343d5e8a 100644
--- a/src/runtime/haskell/PGF2/FFI.hsc
+++ b/src/runtime/haskell/PGF2/FFI.hsc
@@ -78,6 +78,8 @@ foreign import ccall pgf_read_expr_ex :: Ptr PgfText -> Ptr CString -> Ptr PgfUn
 foreign import ccall "pgf_print_type"
   pgf_print_type :: StablePtr Type -> Ptr PgfPrintContext -> CInt -> Ptr PgfMarshaller -> IO (Ptr PgfText)
 
+foreign import ccall pgf_print_context :: CSize -> Ptr PgfTypeHypo -> Ptr PgfPrintContext -> CInt -> Ptr PgfMarshaller -> IO (Ptr PgfText)
+
 foreign import ccall "pgf_read_type"
   pgf_read_type :: Ptr PgfText -> Ptr PgfUnmarshaller -> IO (StablePtr Type)