From 39f38ed0e2f1e9cbacd84a3f4432844ccabcb394 Mon Sep 17 00:00:00 2001
From: krangelov <kr.angelov@gmail.com>
Date: Thu, 12 Aug 2021 12:39:05 +0200
Subject: [PATCH] added startCat

---
 src/runtime/c/pgf/pgf.cxx        | 36 +++++++++++++++++++++++++++++++-
 src/runtime/c/pgf/pgf.h          |  7 +++++--
 src/runtime/haskell/PGF.hs       |  2 +-
 src/runtime/haskell/PGF2.hsc     | 16 +++++++++++++-
 src/runtime/haskell/PGF2/FFI.hsc |  3 +++
 5 files changed, 59 insertions(+), 5 deletions(-)

diff --git a/src/runtime/c/pgf/pgf.cxx b/src/runtime/c/pgf/pgf.cxx
index feab67fb9..8e508f6a3 100644
--- a/src/runtime/c/pgf/pgf.cxx
+++ b/src/runtime/c/pgf/pgf.cxx
@@ -161,13 +161,47 @@ PgfText *pgf_abstract_name(PgfPGF* pgf)
 }
 
 PGF_API
-void pgf_iter_categories(PgfPGF* pgf, PgfItor* itor)
+void pgf_iter_categories(PgfPGF *pgf, PgfItor *itor)
 {
     DB_scope scope(pgf, READER_SCOPE);
 
     namespace_iter(pgf->get_root<PgfPGFRoot>()->abstract.cats, itor);
 }
 
+PGF_API
+uintptr_t pgf_start_cat(PgfPGF *pgf)
+{
+    DB_scope scope(pgf, READER_SCOPE);
+
+    PgfText *startcat = (PgfText *)
+        alloca(sizeof(PgfText)+9);
+    startcat->size = 8;
+    strcpy(startcat->text, "startcat");
+
+	ref<PgfFlag> flag =
+		namespace_lookup(pgf->get_root<PgfPGFRoot>()->abstract.aflags, startcat);
+
+	if (flag != 0) {
+		switch (ref<PgfLiteral>::get_tag(flag->value)) {
+		case PgfLiteralStr::tag: {
+			auto lstr = ref<PgfLiteralStr>::untagged(flag->value);
+
+            uintptr_t type = pgf_read_type(&lstr->val, pgf->u);
+			if (type == 0)
+				break;
+			return type;
+		}
+		}
+	}
+
+    PgfText *s = (PgfText *)
+        alloca(sizeof(PgfText)+2);
+    s->size = 1;
+    s->text[0] = 'S';
+    s->text[1] = 0;
+	return pgf->u->dtyp(0,NULL,s,0,NULL);
+}
+
 PGF_API
 PgfTypeHypo *pgf_category_context(PgfPGF *pgf, PgfText *catname, size_t *n_hypos)
 {
diff --git a/src/runtime/c/pgf/pgf.h b/src/runtime/c/pgf/pgf.h
index 663457833..018194d89 100644
--- a/src/runtime/c/pgf/pgf.h
+++ b/src/runtime/c/pgf/pgf.h
@@ -157,10 +157,13 @@ PGF_API_DECL
 void pgf_free(PgfPGF *pgf);
 
 PGF_API_DECL
-PgfText *pgf_abstract_name(PgfPGF* pgf);
+PgfText *pgf_abstract_name(PgfPGF *pgf);
 
 PGF_API_DECL
-void pgf_iter_categories(PgfPGF* pgf, PgfItor* itor);
+void pgf_iter_categories(PgfPGF *pgf, PgfItor *itor);
+
+PGF_API_DECL
+uintptr_t pgf_start_cat(PgfPGF *pgf);
 
 PGF_API_DECL PgfTypeHypo*
 pgf_category_context(PgfPGF *pgf, PgfText *catname, size_t *n_hypos);
diff --git a/src/runtime/haskell/PGF.hs b/src/runtime/haskell/PGF.hs
index 7bdf40317..28438eb0d 100644
--- a/src/runtime/haskell/PGF.hs
+++ b/src/runtime/haskell/PGF.hs
@@ -3,7 +3,7 @@ module PGF ( PGF2.PGF, readPGF
 
            , CId, mkCId, wildCId, showCId, readCId
 
-           , categories
+           , PGF2.categories, PGF2.categoryContext, PGF2.startCat
            , functions, functionsByCat
 
            , PGF2.Expr(..), PGF2.Literal(..), Tree
diff --git a/src/runtime/haskell/PGF2.hsc b/src/runtime/haskell/PGF2.hsc
index fb4ce37a8..3d3eff72b 100644
--- a/src/runtime/haskell/PGF2.hsc
+++ b/src/runtime/haskell/PGF2.hsc
@@ -33,7 +33,7 @@ module PGF2 (-- * PGF
              mkFloat,  unFloat,
              mkMeta,   unMeta,
              -- ** Types
-             Type(..), Hypo, BindType(..),
+             Type(..), Hypo, BindType(..), startCat,
              readType,
              mkType, unType,
              mkHypo, mkDepHypo, mkImplHypo,
@@ -139,6 +139,20 @@ abstractName p =
   bracket (pgf_abstract_name p_pgf) free $ \c_text ->
     peekText c_text
 
+-- | The start category is defined in the grammar with
+-- the \'startcat\' flag. This is usually the sentence category
+-- but it is not necessary. Despite that there is a start category
+-- defined you can parse with any category. The start category
+-- definition is just for convenience.
+startCat :: PGF -> Type
+startCat p =
+  unsafePerformIO $
+  withForeignPtr (a_pgf p) $ \c_pgf -> do
+    c_typ <- pgf_start_cat c_pgf
+    typ <- deRefStablePtr c_typ
+    freeStablePtr c_typ
+    return typ
+
 -- | The type of a function
 functionType :: PGF -> Fun -> Maybe Type
 functionType p fn =
diff --git a/src/runtime/haskell/PGF2/FFI.hsc b/src/runtime/haskell/PGF2/FFI.hsc
index 55e0c8a71..d085a8e98 100644
--- a/src/runtime/haskell/PGF2/FFI.hsc
+++ b/src/runtime/haskell/PGF2/FFI.hsc
@@ -63,6 +63,9 @@ foreign import ccall "wrapper"
 foreign import ccall "pgf_iter_categories"
   pgf_iter_categories :: Ptr PgfPGF -> Ptr PgfItor -> IO ()
 
+foreign import ccall "pgf_start_cat"
+  pgf_start_cat :: Ptr PgfPGF -> IO (StablePtr Type)
+
 foreign import ccall "pgf/pgf.h pgf_category_context"
   pgf_category_context :: Ptr PgfPGF -> Ptr PgfText -> Ptr CSize -> IO (Ptr PgfTypeHypo)