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

src/compiler/GF/Compile/GeneratePMCFG.hs

@@ -38,7 +38,7 @@ addPMCFG opts cwd gr cmi (id,CncFun mty@(Just (_,cat,ctxt,val)) mlin@(Just (L lo
     return (id,CncFun mty mlin mprn (Just rules))
 addPMCFG opts cwd gr cmi id_info = return id_info
 
-pmcfgForm :: Grammar -> Term -> Context -> Type -> Check [PMCFGRule]
+pmcfgForm :: Grammar -> Term -> Context -> Type -> Check [Production]
 pmcfgForm gr t ctxt ty =
   runEvalM gr $ do
     ((_,ms),args) <- mapAccumM (\(d,ms) (_,_,ty) -> do
@@ -51,14 +51,14 @@ pmcfgForm gr t ctxt ty =
     (lins,params) <- flatten v ty ([],[])
     lins <- mapM str2lin lins
     (r,rs,_) <- compute params
-    args <- zipWithM tnk2pmcfgcat args ctxt
+    args <- zipWithM tnk2lparam args ctxt
-    return (PMCFGRule (PMCFGCat r rs) args (reverse lins))
+    return (Production args (LParam r rs) (reverse lins))
     where
-      tnk2pmcfgcat tnk (_,_,ty) = do
+      tnk2lparam tnk (_,_,ty) = do
         v <- force tnk
         (_,params) <- flatten v ty ([],[])
         (r,rs,_) <- compute params
-        return (PMCFGCat r rs)
+        return (PArg [] (LParam r rs))
 
       compute []     = return (0,[],1)
       compute (v:vs) = do
@@ -125,7 +125,7 @@ str2lin (VApp q [])
   | q == (cPredef, cALL_CAPIT)  = return [SymALL_CAPIT]
 str2lin (VStr s)         = return [SymKS s]
 str2lin (VSymCat d r rs) = do (r, rs) <- compute r rs
-                              return [SymCat d r rs]
+                              return [SymCat d (LParam r rs)]
   where
     compute r' []                = return (r',[])
     compute r' ((cnt',tnk):tnks) = do

src/compiler/GF/Grammar/Binary.hs

@@ -103,13 +103,17 @@ instance Binary Options where
              toString (LInt n) = show n
              toString (LFlt d) = show d
 
-instance Binary PMCFGCat where
+instance Binary LParam where
-  put (PMCFGCat r rs) = put (r,rs)
+  put (LParam r rs) = put (r,rs)
-  get = get >>= \(r,rs) -> return (PMCFGCat r rs)
+  get = get >>= \(r,rs) -> return (LParam r rs)
 
-instance Binary PMCFGRule where
+instance Binary PArg where
-  put (PMCFGRule res args rules) = put (res,args,rules)
+  put (PArg x y) = put (x,y)
-  get = get >>= \(res,args,rules) -> return (PMCFGRule res args rules)
+  get = get >>= \(x,y) -> return (PArg x y)
+
+instance Binary Production where
+  put (Production args res rules) = put (args,res,rules)
+  get = get >>= \(args,res,rules) -> return (Production args res rules)
 
 instance Binary Info where
   put (AbsCat x)       = putWord8 0 >> put x
@@ -312,8 +316,8 @@ instance Binary Literal where
              _ -> decodingError
 
 instance Binary Symbol where
-  put (SymCat d r rs)    = putWord8 0 >> put (d,r,rs)
+  put (SymCat d r)       = putWord8 0 >> put (d,r)
-  put (SymLit n l)       = putWord8 1 >> put (n,l)
+  put (SymLit d r)       = putWord8 1 >> put (d,r)
   put (SymVar n l)       = putWord8 2 >> put (n,l)
   put (SymKS ts)         = putWord8 3 >> put ts
   put (SymKP d vs)       = putWord8 4 >> put (d,vs)
@@ -325,7 +329,7 @@ instance Binary Symbol where
   put SymALL_CAPIT       = putWord8 10
   get = do tag <- getWord8
            case tag of
-             0 -> liftM3 SymCat get get get
+             0 -> liftM2 SymCat get get
              1 -> liftM2 SymLit get get
              2 -> liftM2 SymVar get get
              3 -> liftM  SymKS  get

src/compiler/GF/Grammar/Grammar.hs

@@ -64,7 +64,7 @@ module GF.Grammar.Grammar (
         Location(..), L(..), unLoc, noLoc, ppLocation, ppL,
 
         -- ** PMCFG        
-        PMCFGCat(..), PMCFGRule(..)
+        LIndex,LVar,LParam(..),PArg(..),Symbol(..),Production(..)
         ) where
 
 import GF.Infra.Ident
@@ -74,7 +74,7 @@ import GF.Infra.Location
 import GF.Data.Operations
 
 import PGF2(BindType(..))
-import PGF2.Transactions(Symbol,LIndex,LParam)
+import PGF2.Transactions(LIndex,LVar,LParam(..),PArg(..),Symbol(..),Production(..))
 
 import Data.Array.IArray(Array)
 import Data.Array.Unboxed(UArray)
@@ -304,12 +304,6 @@ allConcreteModules gr =
   [i | (i, m) <- modules gr, MTConcrete _ <- [mtype m], isCompleteModule m]
 
 
-data PMCFGCat  = PMCFGCat LIndex [(LIndex,LParam)]
-                 deriving (Eq,Show)
-
-data PMCFGRule = PMCFGRule PMCFGCat [PMCFGCat] [[Symbol]]
-                 deriving (Eq,Show)
-
 -- | the constructors are judgements in 
 --
 --   - abstract syntax (/ABS/)
@@ -335,8 +329,8 @@ data Info =
  | ResOverload [ModuleName] [(L Type,L Term)]        -- ^ (/RES/) idents: modules inherited
 
 -- judgements in concrete syntax
- | CncCat  (Maybe (L Type))                     (Maybe (L Term)) (Maybe (L Term)) (Maybe (L Term)) (Maybe [PMCFGRule]) -- ^ (/CNC/) lindef ini'zed, 
+ | CncCat  (Maybe (L Type))                     (Maybe (L Term)) (Maybe (L Term)) (Maybe (L Term)) (Maybe [Production]) -- ^ (/CNC/) lindef ini'zed, 
- | CncFun  (Maybe ([Ident],Ident,Context,Type)) (Maybe (L Term))                  (Maybe (L Term)) (Maybe [PMCFGRule]) -- ^ (/CNC/) type info added at 'TC'
+ | CncFun  (Maybe ([Ident],Ident,Context,Type)) (Maybe (L Term))                  (Maybe (L Term)) (Maybe [Production]) -- ^ (/CNC/) type info added at 'TC'
 
 -- indirection to module Ident
  | AnyInd Bool ModuleName                        -- ^ (/INDIR/) the 'Bool' says if canonical

src/compiler/GF/Grammar/Printer.hs

@@ -25,7 +25,6 @@ module GF.Grammar.Printer
 import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint
 
 import PGF2(Literal(..))
-import PGF2.Transactions(LIndex,LParam,Symbol(..))
 import GF.Infra.Ident
 import GF.Infra.Option
 import GF.Grammar.Values
@@ -159,16 +158,18 @@ ppJudgement q (id, AnyInd cann mid) =
     Internal -> "ind" <+> id <+> '=' <+> (if cann then pp "canonical" else empty) <+> mid <+> ';'
     _        -> empty
 
-ppPmcfgRule id arg_cats res_cat (PMCFGRule res args lins) =
+ppPmcfgRule id arg_cats res_cat (Production args res lins) =
   pp id <+> (':' <+>
              (if null args
                 then empty
-                else hsep (intersperse (pp '*') (zipWith ppPmcfgCat arg_cats args)) <+> "->") <+>
+                else hsep (intersperse (pp '*') (zipWith ppPArg arg_cats args)) <+> "->") <+>
              ppPmcfgCat res_cat res $$
              '=' <+> brackets (vcat (map (hsep . map ppSymbol) lins)))
 
-ppPmcfgCat :: Ident -> PMCFGCat -> Doc
+ppPArg cat (PArg _ p) = ppPmcfgCat cat p
-ppPmcfgCat cat (PMCFGCat r rs) = pp cat <> parens (ppLinFun ppLParam r rs)
+
+ppPmcfgCat :: Ident -> LParam -> Doc
+ppPmcfgCat cat p = pp cat <> parens (ppLParam p)
 
 instance Pretty Term where pp = ppTerm Unqualified 0
 
@@ -365,8 +366,8 @@ ppLit (LStr s) = pp (show s)
 ppLit (LInt n) = pp n
 ppLit (LFlt d) = pp d
 
-ppSymbol (SymCat d r rs)= pp '<' <> pp d <> pp ',' <> ppLinFun ppLParam r rs <> pp '>'
+ppSymbol (SymCat d r)= pp '<' <> pp d <> pp ',' <> ppLParam r <> pp '>'
-ppSymbol (SymLit d r)   = pp '{' <> pp d <> pp ',' <> pp r <> pp '}'
+ppSymbol (SymLit d r)= pp '{' <> pp d <> pp ',' <> ppLParam r <> pp '}'
 ppSymbol (SymVar d r)   = pp '<' <> pp d <> pp ',' <> pp '$' <> pp r <> pp '>'
 ppSymbol (SymKS t)      = doubleQuotes (pp t)
 ppSymbol SymNE          = pp "nonExist"
@@ -377,6 +378,8 @@ ppSymbol SymCAPIT       = pp "CAPIT"
 ppSymbol SymALL_CAPIT   = pp "ALL_CAPIT"
 ppSymbol (SymKP syms alts) = pp "pre" <+> braces (hsep (punctuate (pp ';') (hsep (map ppSymbol syms) : map ppAlt alts)))
 
+ppLParam (LParam r rs) = ppLinFun ppLVar r rs
+
 ppLinFun ppParam r rs
   | r == 0 && not (null rs) = hcat (intersperse (pp '+') (       map ppTerm rs))
   | otherwise               = hcat (intersperse (pp '+') (pp r : map ppTerm rs))
@@ -385,7 +388,7 @@ ppLinFun ppParam r rs
       | i == 1    = ppParam p
       | otherwise = pp i <> pp '*' <> ppParam p
 
-ppLParam p
+ppLVar p
   | i == 0    = pp (chars !! j)
   | otherwise = pp (chars !! j : show i)
   where

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 {
+struct PGF_INTERNAL_DECL PgfPArg {
-    ref<PgfConcrLincat> lincat;
+    ref<PgfLParam> param;
-    ref<PgfConcrLIndex> param;
-};
-
-struct PGF_INTERNAL_DECL PgfConcrLinRes {
-    ref<PgfConcrLincat> lincat;
-    ref<PgfConcrLIndex> 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<PgfPArg>> args;
-    ref<PgfVector<PgfConcrLinRes>> res;
+    ref<PgfVector<ref<PgfLParam>>> res;
-    ref<PgfVector<ref<PgfSequence>>> seqs;
+    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 =
+    ref<PgfLParam> lparam =
-        PgfDB::malloc<PgfConcrLIndex>(n_terms*sizeof(PgfConcrLIndex::terms[0]));
+        PgfDB::malloc<PgfLParam>(n_terms*sizeof(PgfLParam::terms[0]));
-    lindex->i0 = i0;
+    lparam->i0 = i0;
-    lindex->n_terms = n_terms;
+    lparam->n_terms = n_terms;
 
     for (size_t i = 0; i < n_terms; i++) {
-        lindex->terms[i].factor = read_int();
+        lparam->terms[i].factor = read_int();
-        lindex->terms[i].var    = 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();
+    parg->param  = read_lparam();
-    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();
 }
 
 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->args = read_vector(&PgfReader::read_parg);
-    lin->res  = read_vector(&PgfReader::read_linres);
+    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();
+    ref<PgfLParam> read_lparam();
-    void read_linarg(ref<PgfConcrLinArg> linarg);
+    void read_parg(ref<PgfPArg> parg);
-    void read_linres(ref<PgfConcrLinRes> linres);
     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_int(lparam->i0);
-    write_len(lindex->n_terms);
+    write_len(lparam->n_terms);
-    for (size_t i = 0; i < lindex->n_terms; i++) {
+    for (size_t i = 0; i < lparam->n_terms; i++) {
-        write_int(lindex->terms[i].factor);
+        write_int(lparam->terms[i].factor);
-        write_int(lindex->terms[i].var);
+        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_lparam(parg->param);
-    write_lindex(linarg->param);
-}
-
-void PgfWriter::write_linres(ref<PgfConcrLinRes> linres)
-{
-    write_name(&linres->lincat->name);
-    write_lindex(linres->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->args, &PgfWriter::write_parg);
-    write_vector(lin->res, &PgfWriter::write_linres);
+    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_lparam(ref<PgfLParam> lparam);
-    void write_linarg(ref<PgfConcrLinArg> linarg);
+    void write_parg(ref<PgfPArg> linarg);
-    void write_linres(ref<PgfConcrLinRes> linres);
     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
-
+          , createLin
-            -- concrete syntax
-          , Token, LIndex, LParam, Symbol(..)
           ) 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)]
+  = SymCat {-# UNPACK #-} !Int {-# UNPACK #-} !LParam
-  | SymLit {-# UNPACK #-} !Int {-# UNPACK #-} !LIndex
+  | 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