Unify the data model between the C runtime and the Haskell binding

src/runtime/c/pgf/data.h

@@ -112,7 +112,7 @@ struct PGF_INTERNAL_DECL PgfConcrLincat {
     static void release(ref<PgfConcrLincat> lincat);
 };
 
-struct PGF_INTERNAL_DECL PgfConcrLIndex {
+struct PGF_INTERNAL_DECL PgfLParam {
     size_t i0;
     size_t n_terms;
     struct {
@@ -121,14 +121,8 @@ struct PGF_INTERNAL_DECL PgfConcrLIndex {
     } terms[];
 };
 
-struct PGF_INTERNAL_DECL PgfConcrLinArg {
-    ref<PgfConcrLincat> lincat;
-    ref<PgfConcrLIndex> param;
-};
-
-struct PGF_INTERNAL_DECL PgfConcrLinRes {
-    ref<PgfConcrLincat> lincat;
-    ref<PgfConcrLIndex> param;
+struct PGF_INTERNAL_DECL PgfPArg {
+    ref<PgfLParam> param;
 };
 
 typedef object PgfSymbol;
@@ -136,13 +130,13 @@ typedef object PgfSymbol;
 struct PGF_INTERNAL_DECL PgfSymbolCat {
     static const uint8_t tag = 0;
     size_t d;
-    PgfConcrLIndex r;
+    PgfLParam r;
 };
 
 struct PGF_INTERNAL_DECL PgfSymbolLit {
     static const uint8_t tag = 1;
     size_t d;
-    PgfConcrLIndex r;
+    PgfLParam r;
 };
 
 struct PGF_INTERNAL_DECL PgfSymbolVar {
@@ -183,14 +177,12 @@ struct PGF_INTERNAL_DECL PgfSymbolALLCAPIT {
     static const uint8_t tag = 10;
 };
 
-typedef PgfVector<PgfSymbol> PgfSequence;
-
 struct PGF_INTERNAL_DECL PgfConcrLin {
     size_t ref_count;
 
-    ref<PgfVector<PgfConcrLinArg>> args;
-    ref<PgfVector<PgfConcrLinRes>> res;
-    ref<PgfVector<ref<PgfSequence>>> seqs;
+    ref<PgfVector<PgfPArg>> args;
+    ref<PgfVector<ref<PgfLParam>>> res;
+    ref<PgfVector<ref<PgfVector<PgfSymbol>>>> seqs;
 
     PgfText name;
 

src/runtime/c/pgf/pgf.cxx

@@ -955,6 +955,15 @@ void pgf_drop_concrete(PgfDB *db, PgfRevision revision,
     } PGF_API_END
 }
 
+PGF_API
+void pgf_create_lin(PgfDB *db, PgfConcrRevision revision,
+                    PgfText *name, size_t n_prods, PgfExn *exn)
+{
+    ref<PgfConcrLin> lin = PgfDB::malloc<PgfConcrLin>(name->size+1);
+    lin->ref_count = 1;
+    memcpy(&lin->name, name, sizeof(PgfText)+name->size+1);
+}
+
 PGF_API
 PgfLiteral pgf_get_global_flag(PgfDB *db, PgfRevision revision,
                                PgfText *name,

src/runtime/c/pgf/pgf.h

@@ -418,6 +418,10 @@ void pgf_drop_concrete(PgfDB *db, PgfRevision revision,
                        PgfText *name,
                        PgfExn *err);
 
+PGF_API_DECL
+void pgf_create_lin(PgfDB *db, PgfConcrRevision revision,
+                    PgfText *name, size_t n_prods, PgfExn *exn);
+
 PGF_API_DECL
 PgfLiteral pgf_get_global_flag(PgfDB *db, PgfRevision revision,
                                PgfText *name,

src/runtime/c/pgf/reader.cxx

@@ -435,67 +435,26 @@ void PgfReader::read_abstract(ref<PgfAbstr> abstract)
     abstract->cats = read_namespace<PgfAbsCat>(&PgfReader::read_abscat);
 }
 
-ref<PgfConcrLIndex> PgfReader::read_lindex()
+ref<PgfLParam> PgfReader::read_lparam()
 {
     size_t i0 = read_int();
     size_t n_terms = read_len();
-    ref<PgfConcrLIndex> lindex =
-        PgfDB::malloc<PgfConcrLIndex>(n_terms*sizeof(PgfConcrLIndex::terms[0]));
-    lindex->i0 = i0;
-    lindex->n_terms = n_terms;
+    ref<PgfLParam> lparam =
+        PgfDB::malloc<PgfLParam>(n_terms*sizeof(PgfLParam::terms[0]));
+    lparam->i0 = i0;
+    lparam->n_terms = n_terms;
 
     for (size_t i = 0; i < n_terms; i++) {
-        lindex->terms[i].factor = read_int();
-        lindex->terms[i].var    = read_int();
+        lparam->terms[i].factor = read_int();
+        lparam->terms[i].var    = read_int();
     }
 
-    return lindex;
+    return lparam;
 }
 
-void PgfReader::read_linarg(ref<PgfConcrLinArg> linarg)
+void PgfReader::read_parg(ref<PgfPArg> parg)
 {
-    size_t size = read_len();
-    PgfText* name = (PgfText*) alloca(sizeof(PgfText)+size+1);
-    name->size = size;
-
-    // If reading the extra bytes causes EOF, it is an encoding
-    // error, not a legitimate end of character stream.
-    fread(name->text, size, 1, in);
-    if (feof(in))
-        throw pgf_error("utf8 decoding error");
-    if (ferror(in))
-        throw pgf_error("an error occured while reading the grammar");
-
-    name->text[size] = 0;
-
-    
-    linarg->lincat = namespace_lookup(this->concrete->lincats, name);
-    if (linarg->lincat == 0)
-        throw pgf_error("Encountered an unknown category");
-    linarg->param  = read_lindex();
-}
-
-void PgfReader::read_linres(ref<PgfConcrLinRes> linres)
-{
-    size_t size = read_len();
-    PgfText* name = (PgfText*) alloca(sizeof(PgfText)+size+1);
-    name->size = size;
-
-    // If reading the extra bytes causes EOF, it is an encoding
-    // error, not a legitimate end of character stream.
-    fread(name->text, size, 1, in);
-    if (feof(in))
-        throw pgf_error("utf8 decoding error");
-    if (ferror(in))
-        throw pgf_error("an error occured while reading the grammar");
-
-    name->text[size] = 0;
-
-    
-    linres->lincat = namespace_lookup(this->concrete->lincats, name);
-    if (linres->lincat == 0)
-        throw pgf_error("Encountered an unknown category");
-    linres->param  = read_lindex();
+    parg->param  = read_lparam();
 }
 
 template<class I>
@@ -505,7 +464,7 @@ ref<I> PgfReader::read_symbol_idx()
     size_t i0 = read_int();
     size_t n_terms = read_len();
     ref<I> sym_idx =
-        PgfDB::malloc<I>(n_terms*sizeof(PgfConcrLIndex::terms[0]));
+        PgfDB::malloc<I>(n_terms*sizeof(PgfLParam::terms[0]));
     sym_idx->d = d;
     sym_idx->r.i0 = i0;
     sym_idx->r.n_terms = n_terms;
@@ -594,8 +553,8 @@ ref<PgfConcrLin> PgfReader::read_lin()
 {
     ref<PgfConcrLin> lin = read_name(&PgfConcrLin::name);
     lin->ref_count = 1;
-    lin->args = read_vector(&PgfReader::read_linarg);
-    lin->res  = read_vector(&PgfReader::read_linres);
+    lin->args = read_vector(&PgfReader::read_parg);
+    lin->res  = read_vector(&PgfReader::read_lparam);
     lin->seqs = read_vector(&PgfReader::read_seq2);
     return lin;
 }

src/runtime/c/pgf/reader.h

@@ -67,9 +67,8 @@ public:
     void read_abstract(ref<PgfAbstr> abstract);
 
     ref<PgfConcrLincat> read_lincat();
-    ref<PgfConcrLIndex> read_lindex();
-    void read_linarg(ref<PgfConcrLinArg> linarg);
-    void read_linres(ref<PgfConcrLinRes> linres);
+    ref<PgfLParam> read_lparam();
+    void read_parg(ref<PgfPArg> parg);
     PgfSymbol read_symbol();
     ref<PgfConcrLin> read_lin();
     ref<PgfConcrPrintname> read_printname();
@@ -88,8 +87,9 @@ private:
 
     void read_patt2(ref<PgfPatt> r) { *r = read_patt(); };
     void read_text2(ref<ref<PgfText>> r) { *r = read_text(); };
+    void read_lparam(ref<ref<PgfLParam>> r) { *r = read_lparam(); };
     void read_symbol2(ref<PgfSymbol> r) { *r = read_symbol(); };
-    void read_seq2(ref<ref<PgfSequence>> r) { *r = read_vector(&PgfReader::read_symbol2); }
+    void read_seq2(ref<ref<PgfVector<PgfSymbol>>> r) { *r = read_vector(&PgfReader::read_symbol2); }
 
     template<class I>
     ref<I> read_symbol_idx();

src/runtime/c/pgf/writer.cxx

@@ -391,26 +391,19 @@ void PgfWriter::write_lincat(ref<PgfConcrLincat> lincat)
     write_vector(lincat->fields, &PgfWriter::write_text);
 }
 
-void PgfWriter::write_lindex(ref<PgfConcrLIndex> lindex)
+void PgfWriter::write_lparam(ref<PgfLParam> lparam)
 {
-    write_int(lindex->i0);
-    write_len(lindex->n_terms);
-    for (size_t i = 0; i < lindex->n_terms; i++) {
-        write_int(lindex->terms[i].factor);
-        write_int(lindex->terms[i].var);
+    write_int(lparam->i0);
+    write_len(lparam->n_terms);
+    for (size_t i = 0; i < lparam->n_terms; i++) {
+        write_int(lparam->terms[i].factor);
+        write_int(lparam->terms[i].var);
     }
 }
 
-void PgfWriter::write_linarg(ref<PgfConcrLinArg> linarg)
+void PgfWriter::write_parg(ref<PgfPArg> parg)
 {
-    write_name(&linarg->lincat->name);
-    write_lindex(linarg->param);
-}
-
-void PgfWriter::write_linres(ref<PgfConcrLinRes> linres)
-{
-    write_name(&linres->lincat->name);
-    write_lindex(linres->param);
+    write_lparam(parg->param);
 }
 
 void PgfWriter::write_symbol(PgfSymbol sym)
@@ -422,13 +415,13 @@ void PgfWriter::write_symbol(PgfSymbol sym)
 	case PgfSymbolCat::tag: {
         auto sym_cat = ref<PgfSymbolCat>::untagged(sym);
         write_int(sym_cat->d);
-        write_lindex(ref<PgfConcrLIndex>::from_ptr(&sym_cat->r));
+        write_lparam(ref<PgfLParam>::from_ptr(&sym_cat->r));
 		break;
 	}
 	case PgfSymbolLit::tag: {
         auto sym_lit = ref<PgfSymbolLit>::untagged(sym);
         write_int(sym_lit->d);
-        write_lindex(ref<PgfConcrLIndex>::from_ptr(&sym_lit->r));
+        write_lparam(ref<PgfLParam>::from_ptr(&sym_lit->r));
 		break;
 	}
 	case PgfSymbolVar::tag: {
@@ -458,7 +451,7 @@ void PgfWriter::write_symbol(PgfSymbol sym)
 	}
 }
 
-void PgfWriter::write_seq(ref<PgfSequence> seq)
+void PgfWriter::write_seq(ref<PgfVector<PgfSymbol>> seq)
 {
     write_vector(seq, &PgfWriter::write_symbol);
 }
@@ -466,8 +459,8 @@ void PgfWriter::write_seq(ref<PgfSequence> seq)
 void PgfWriter::write_lin(ref<PgfConcrLin> lin)
 {
     write_name(&lin->name);
-    write_vector(lin->args, &PgfWriter::write_linarg);
-    write_vector(lin->res, &PgfWriter::write_linres);
+    write_vector(lin->args, &PgfWriter::write_parg);
+    write_vector(lin->res, &PgfWriter::write_lparam);
     write_vector(lin->seqs, &PgfWriter::write_seq);
 }
 

src/runtime/c/pgf/writer.h

@@ -42,11 +42,10 @@ public:
     void write_abstract(ref<PgfAbstr> abstract);
 
     void write_lincat(ref<PgfConcrLincat> lincat);
-    void write_lindex(ref<PgfConcrLIndex> lindex);
-    void write_linarg(ref<PgfConcrLinArg> linarg);
-    void write_linres(ref<PgfConcrLinRes> linres);
+    void write_lparam(ref<PgfLParam> lparam);
+    void write_parg(ref<PgfPArg> linarg);
     void write_symbol(PgfSymbol sym);
-    void write_seq(ref<PgfSequence> seq);
+    void write_seq(ref<PgfVector<PgfSymbol>> seq);
     void write_lin(ref<PgfConcrLin> lin);
     void write_printname(ref<PgfConcrPrintname> printname);
 
@@ -60,7 +59,8 @@ private:
 
     void write_patt(ref<PgfPatt> r) { write_patt(*r); };
     void write_text(ref<ref<PgfText>> r) { write_text(&(**r)); };
-    void write_seq(ref<ref<PgfSequence>> r) { write_seq(*r); };
+    void write_lparam(ref<ref<PgfLParam>> r) { write_lparam(*r); };
+    void write_seq(ref<ref<PgfVector<PgfSymbol>>> r) { write_seq(*r); };
     void write_symbol(ref<PgfSymbol> r) { write_symbol(*r); };
 
     FILE *out;

src/runtime/haskell/PGF2/FFI.hsc

@@ -147,6 +147,8 @@ foreign import ccall pgf_clone_concrete :: Ptr PgfDB -> Ptr (PgfRevision PGF) ->
 
 foreign import ccall pgf_drop_concrete :: Ptr PgfDB -> Ptr (PgfRevision PGF) -> Ptr PgfText -> Ptr PgfExn -> IO ()
 
+foreign import ccall pgf_create_lin :: Ptr PgfDB -> Ptr (PgfRevision Concr) -> Ptr PgfText -> CSize -> Ptr PgfExn -> IO ()
+
 foreign import ccall pgf_get_global_flag :: Ptr PgfDB -> Ptr (PgfRevision PGF) -> Ptr PgfText -> Ptr PgfUnmarshaller -> Ptr PgfExn -> IO (StablePtr Literal)
 
 foreign import ccall pgf_set_global_flag :: Ptr PgfDB -> Ptr (PgfRevision PGF) -> Ptr PgfText -> StablePtr Literal -> Ptr PgfMarshaller -> Ptr PgfExn -> IO ()

src/runtime/haskell/PGF2/Transactions.hsc

@@ -9,15 +9,18 @@ module PGF2.Transactions
           , dropFunction
           , createCategory
           , dropCategory
+          , setGlobalFlag
+          , setAbstractFlag
+
+            -- concrete syntax
+          , Token, LIndex, LVar, LParam(..)
+          , PArg(..), Symbol(..), Production(..)
+
           , createConcrete
           , alterConcrete
           , dropConcrete
-          , setGlobalFlag
-          , setAbstractFlag
           , setConcreteFlag
-
-            -- concrete syntax
-          , Token, LIndex, LParam, Symbol(..)
+          , createLin
           ) where
 
 import PGF2.FFI
@@ -180,11 +183,15 @@ setConcreteFlag name value = Transaction $ \c_db c_revision c_exn ->
     pgf_set_concrete_flag c_db c_revision c_name c_value m c_exn
 
 type Token  = String
+
 type LIndex = Int
-type LParam = Int
+type LVar   = Int
+data LParam  = LParam {-# UNPACK #-} !LIndex [(LIndex,LVar)]
+               deriving (Eq,Show)
+
 data Symbol
-  = SymCat {-# UNPACK #-} !Int {-# UNPACK #-} !LIndex [(LIndex,LParam)]
-  | SymLit {-# UNPACK #-} !Int {-# UNPACK #-} !LIndex
+  = SymCat {-# UNPACK #-} !Int {-# UNPACK #-} !LParam
+  | SymLit {-# UNPACK #-} !Int {-# UNPACK #-} !LParam
   | SymVar {-# UNPACK #-} !Int {-# UNPACK #-} !Int
   | SymKS Token
   | SymKP [Symbol] [([Symbol],[String])]
@@ -195,3 +202,14 @@ data Symbol
   | SymCAPIT                        -- the special CAPIT token
   | SymALL_CAPIT                    -- the special ALL_CAPIT token
   deriving (Eq,Show)
+
+data PArg = PArg [(LIndex,LIndex)] {-# UNPACK #-} !LParam
+            deriving (Eq,Show)
+
+data Production = Production [PArg] LParam [[Symbol]]
+                 deriving (Eq,Show)
+
+createLin :: Fun -> [Production] -> Transaction Concr ()
+createLin name rules = Transaction $ \c_db c_revision c_exn ->
+  withText name $ \c_name ->
+    pgf_create_lin c_db c_revision c_name (fromIntegral (length rules)) c_exn