compile lindef & linref rules

src/compiler/GF/Compile/Compute/Concrete.hs

@@ -154,6 +154,8 @@ eval env (Table t1 t2)  []  = do v1 <- eval env t1 []
                                  return (VTable v1 v2)
 eval env (T (TTyped ty) cs)[]=do vty <- eval env ty []
                                  return (VT vty env cs)
+eval env (T (TWild ty) cs) []=do vty <- eval env ty []
+                                 return (VT vty env cs)
 eval env (V ty ts)      []  = do vty <- eval env ty []
                                  tnks <- mapM (newThunk env) ts
                                  return (VV vty tnks)

src/compiler/GF/Compile/GeneratePMCFG.hs

@@ -25,6 +25,7 @@ import PGF2.Transactions
 import qualified Data.Map.Strict as Map
 import Control.Monad
 import Data.List(mapAccumL,sortBy)
+import Data.Maybe(fromMaybe)
 
 generatePMCFG :: Options -> FilePath -> SourceGrammar -> SourceModule -> Check SourceModule
 generatePMCFG opts cwd gr cmo@(cm,cmi) = do
@@ -32,6 +33,25 @@ generatePMCFG opts cwd gr cmo@(cm,cmi) = do
   js <- mapM (addPMCFG opts cwd gr' cmi) (Map.toList (jments cmi))
   return (cm,cmi{jments = (Map.fromAscList js)})
 
+addPMCFG opts cwd gr cmi (id,CncCat mty@(Just (L loc ty)) mdef mref mprn Nothing) = do
+  defs <- case mdef of
+            Nothing           -> checkInModule cwd cmi loc ("Happened in the PMCFG generation for the lindef of" <+> id) $ do
+                                   term <- mkLinDefault gr ty
+                                   pmcfgForm gr term [(Explicit,identW,typeStr)] ty
+            Just (L loc term) -> checkInModule cwd cmi loc ("Happened in the PMCFG generation for the lindef of" <+> id) $ do
+                                   pmcfgForm gr term [(Explicit,identW,typeStr)] ty
+  refs <- case mref of
+            Nothing           -> checkInModule cwd cmi loc ("Happened in the PMCFG generation for the linref of" <+> id) $ do
+                                   term <- mkLinReference gr ty
+                                   pmcfgForm gr term [(Explicit,identW,ty)] typeStr
+            Just (L loc term) -> checkInModule cwd cmi loc ("Happened in the PMCFG generation for the linref of" <+> id) $ do
+                                   pmcfgForm gr term [(Explicit,identW,ty)] typeStr
+  mprn  <- case mprn of
+             Nothing          -> return Nothing
+             Just (L loc prn) -> checkInModule cwd cmi loc ("Happened in the computation of the print name for" <+> id) $ do
+                                   prn <- normalForm gr prn
+                                   return (Just (L loc prn))
+  return (id,CncCat mty mdef mref mprn (Just (defs,refs)))
 addPMCFG opts cwd gr cmi (id,CncFun mty@(Just (_,cat,ctxt,val)) mlin@(Just (L loc term)) mprn Nothing) = do
   rules <- checkInModule cwd cmi loc ("Happened in the PMCFG generation for" <+> id) $
              pmcfgForm gr term ctxt val
@@ -200,3 +220,47 @@ type2fields gr = type2fields empty
       let Ok ts = allParamValues gr p
       in concatMap (\t -> type2fields (d <+> ppTerm Unqualified 5 t) q) ts
     type2fields d _ = []
+
+mkLinDefault :: SourceGrammar -> Type -> Check Term
+mkLinDefault gr typ = liftM (Abs Explicit varStr) $ mkDefField typ
+ where
+   mkDefField ty =
+     case ty of
+       Table p t  -> do t' <- mkDefField t
+                        let T _ cs = mkWildCases t'
+                        return $ T (TWild p) cs
+       Sort s | s == cStr -> return (Vr varStr)
+       QC p       -> case lookupParamValues gr p of
+                       Ok []    -> checkError ("no parameter values given to type" <+> ppQIdent Qualified p)
+                       Ok (v:_) -> return v
+                       Bad msg  -> fail msg
+       RecType r -> do
+         let (ls,ts) = unzip r
+         ts <- mapM mkDefField ts
+         return $ R (zipWith assign ls ts)
+       _ | Just _ <- isTypeInts typ -> return $ EInt 0 -- exists in all as first val
+       _ -> checkError ("linearization type field cannot be" <+> ty)
+
+mkLinReference :: SourceGrammar -> Type -> Check Term
+mkLinReference gr typ = do
+  mb_term <- mkRefField typ (Vr varStr)
+  return (Abs Explicit varStr (fromMaybe Empty mb_term))
+  where
+    mkRefField ty trm =
+      case ty of
+        Table pty ty -> case allParamValues gr pty of
+                          Ok []     -> checkError ("no parameter values given to type" <+> pty)
+                          Ok (p:ps) -> mkRefField ty (S trm p)
+                          Bad msg   -> fail msg
+        Sort s | s == cStr -> return (Just trm)
+        QC p       -> return Nothing
+        RecType [] -> return Nothing
+        RecType rs -> traverse rs trm
+        _ | Just _ <- isTypeInts typ -> return Nothing
+        _ -> checkError ("linearization type field cannot be" <+> typ)
+
+    traverse []          trm = return Nothing
+    traverse ((l,ty):rs) trm = do res <- mkRefField ty (P trm l)
+                                  case res of
+                                    Just trm -> return (Just trm)
+                                    Nothing  -> traverse rs trm

src/compiler/GF/Compile/GrammarToPGF.hs

@@ -86,8 +86,11 @@ grammar2PGF opts gr am probs = do
                       0 -> 0
                       n -> max 0 ((1 - sum [d | (f,Just d) <- pfs]) / fromIntegral n)
 
-    createCncCats ((m,c),CncCat (Just (L _ ty)) _ _ _ _) = do
-      createLincat (i2i c) (type2fields gr ty)
+    createCncCats ((m,c),CncCat (Just (L _ ty)) _ _ mprn (Just (lindefs,linrefs))) = do
+      createLincat (i2i c) (type2fields gr ty) lindefs linrefs
+      case mprn of
+        Nothing        -> return ()
+        Just (L _ prn) -> setPrintName (i2i c) (unwords (term2tokens prn))
     createCncCats _ = return ()
 
     createCncFuns ((m,f),CncFun _ _ mprn (Just prods)) = do

src/compiler/GF/Grammar/Grammar.hs

@@ -329,7 +329,7 @@ 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 [Production]) -- ^ (/CNC/) lindef ini'zed, 
+ | CncCat  (Maybe (L Type))                     (Maybe (L Term)) (Maybe (L Term)) (Maybe (L Term)) (Maybe ([Production],[Production])) -- ^ (/CNC/) lindef ini'zed, 
  | CncFun  (Maybe ([Ident],Ident,Context,Type)) (Maybe (L Term))                  (Maybe (L Term)) (Maybe [Production]) -- ^ (/CNC/) type info added at 'TC'
 
 -- indirection to module Ident

src/compiler/GF/Grammar/Printer.hs

@@ -28,6 +28,7 @@ import PGF2(Literal(..))
 import GF.Infra.Ident
 import GF.Infra.Option
 import GF.Grammar.Values
+import GF.Grammar.Predef
 import GF.Grammar.Grammar
 
 import GF.Text.Pretty
@@ -134,9 +135,10 @@ ppJudgement q (id, CncCat mtyp pdef pref pprn mpmcfg) =
      Just (L _ prn) -> "printname" <+> id <+> '=' <+> ppTerm q 0 prn <+> ';'
      Nothing        -> empty) $$
   (case (mtyp,mpmcfg,q) of
-     (Just (L _ typ),Just rules,Internal)
+     (Just (L _ typ),Just (lindefs,linrefs),Internal)
                     -> "pmcfg" <+> '{' $$
-                       nest 2 (vcat (map (ppPmcfgRule id [] id) rules)) $$
+                       nest 2 (vcat (map (ppPmcfgRule (identS "lindef") [cString] id) lindefs)  $$
+                               vcat (map (ppPmcfgRule (identS "linref") [id] cString) linrefs)) $$
                        '}'
      _              -> empty)
 ppJudgement q (id, CncFun mtyp pdef pprn mpmcfg) =

src/runtime/c/pgf/data.h

@@ -103,17 +103,6 @@ typedef struct {
     Namespace<PgfAbsCat> cats;
 } PgfAbstr;
 
-struct PGF_INTERNAL_DECL PgfConcrLincat {
-    size_t ref_count;
-
-    ref<PgfAbsCat> abscat;
-
-    ref<Vector<ref<PgfText>>> fields;
-    PgfText name;
-
-    static void release(ref<PgfConcrLincat> lincat);
-};
-
 struct PGF_INTERNAL_DECL PgfLParam {
     size_t i0;
     size_t n_terms;
@@ -206,6 +195,23 @@ void pgf_symbol_free(PgfSymbol sym);
 PGF_INTERNAL_DECL
 void pgf_symbols_free(ref<Vector<PgfSymbol>> syms);
 
+struct PGF_INTERNAL_DECL PgfConcrLincat {
+    size_t ref_count;
+
+    ref<PgfAbsCat> abscat;
+
+    ref<Vector<ref<PgfText>>> fields;
+
+    size_t n_lindefs;
+    ref<Vector<PgfPArg>> args;
+    ref<Vector<ref<PgfPResult>>> res;
+    ref<Vector<ref<Vector<PgfSymbol>>>> seqs;
+
+    PgfText name;
+
+    static void release(ref<PgfConcrLincat> lincat);
+};
+
 struct PGF_INTERNAL_DECL PgfConcrLin {
     size_t ref_count;
 

src/runtime/c/pgf/pgf.cxx

@@ -794,6 +794,8 @@ void pgf_get_lincat_counts_internal(object o, size_t *counts)
 {
     ref<PgfConcrLincat> lincat = o;
     counts[0] = lincat->fields->len;
+    counts[1] = lincat->n_lindefs;
+    counts[2] = lincat->res->len - lincat->n_lindefs;
 }
 
 PGF_API
@@ -811,6 +813,92 @@ void pgf_get_lin_counts_internal(object o, size_t *counts)
     counts[1] = lin->seqs->len / lin->res->len;
 }
 
+PGF_API
+PgfText *pgf_print_lindef_sig_internal(object o, size_t i)
+{
+    ref<PgfConcrLincat> lincat = o;
+
+    PgfInternalMarshaller m;
+    PgfPrinter printer(NULL,0,&m);
+
+    printer.efun(&lincat->name);
+    printer.puts(" : ");
+
+    ref<PgfPResult> res = *vector_elem(lincat->res, i);
+
+    if (res->vars != 0) {
+        printer.lvar_ranges(res->vars);
+        printer.puts(" . ");
+    }
+
+    printer.puts(" String(0) -> ");
+
+    printer.efun(&lincat->name);
+    printer.puts("(");
+    printer.lparam(ref<PgfLParam>::from_ptr(&res->param));
+    printer.puts(")");
+
+    return printer.get_text();
+}
+
+PGF_API
+PgfText *pgf_print_lindef_seq_internal(object o, size_t i, size_t j)
+{
+    ref<PgfConcrLincat> lincat = o;
+
+    PgfInternalMarshaller m;
+    PgfPrinter printer(NULL,0,&m);
+
+    size_t n_seqs = lincat->fields->len;
+    ref<Vector<PgfSymbol>> syms = *vector_elem(lincat->seqs, i*n_seqs + j);
+
+    printer.symbols(syms);
+
+    return printer.get_text();
+}
+
+PGF_API
+PgfText *pgf_print_linref_sig_internal(object o, size_t i)
+{
+    ref<PgfConcrLincat> lincat = o;
+
+    PgfInternalMarshaller m;
+    PgfPrinter printer(NULL,0,&m);
+
+    printer.efun(&lincat->name);
+    printer.puts(" : ");
+
+    ref<PgfPResult> res = *vector_elem(lincat->res, lincat->n_lindefs+i);
+
+    if (res->vars != 0) {
+        printer.lvar_ranges(res->vars);
+        printer.puts(" . ");
+    }
+
+    printer.efun(&lincat->name);
+    printer.puts("(");
+    printer.lparam(vector_elem(lincat->args, lincat->n_lindefs+i)->param);
+    printer.puts(") -> String(0)");
+
+    return printer.get_text();
+}
+
+PGF_API
+PgfText *pgf_print_linref_seq_internal(object o, size_t i)
+{
+    ref<PgfConcrLincat> lincat = o;
+
+    PgfInternalMarshaller m;
+    PgfPrinter printer(NULL,0,&m);
+
+    size_t n_seqs = lincat->fields->len;
+    ref<Vector<PgfSymbol>> syms = *vector_elem(lincat->seqs, lincat->n_lindefs*n_seqs+i);
+
+    printer.symbols(syms);
+
+    return printer.get_text();
+}
+
 PGF_API
 PgfText *pgf_print_lin_sig_internal(object o, size_t i)
 {
@@ -1206,7 +1294,10 @@ void pgf_drop_concrete(PgfDB *db, PgfRevision revision,
 
 class PGF_INTERNAL PgfLinBuilder : public PgfLinBuilderIface
 {
-    ref<PgfConcrLin> lin;
+    ref<Vector<PgfPArg>> args;
+    ref<Vector<ref<PgfPResult>>> res;
+    ref<Vector<ref<Vector<PgfSymbol>>>> seqs;
+
     size_t var_index;
     size_t arg_index;
     size_t res_index;
@@ -1214,6 +1305,9 @@ class PGF_INTERNAL PgfLinBuilder : public PgfLinBuilderIface
     size_t sym_index;
     size_t alt_index;
 
+    size_t n_lindefs;
+    size_t n_linrefs;
+
     ref<Vector<PgfSymbol>> syms;
 
     size_t pre_sym_index;
@@ -1222,7 +1316,72 @@ class PGF_INTERNAL PgfLinBuilder : public PgfLinBuilderIface
         "Detected incorrect use of the linearization builder";
 
 public:
-    PgfLinBuilder(ref<PgfAbsFun> absfun, PgfConcr *concr, size_t n_prods)
+    PgfLinBuilder()
+    {
+        this->args = 0;
+        this->res  = 0;
+        this->seqs = 0;
+        this->var_index = 0;
+        this->arg_index = 0;
+        this->res_index = 0;
+        this->seq_index = 0;
+        this->sym_index = (size_t) -1;
+        this->alt_index = (size_t) -1;
+        this->n_lindefs = 0;
+        this->n_linrefs = 0;
+        this->syms = 0;
+        this->pre_sym_index = (size_t) -1;
+    }
+
+    ref<PgfConcrLincat> build(ref<PgfAbsCat> abscat, PgfConcr *concr,
+                              size_t n_fields, PgfText **fields,
+                              size_t n_lindefs, size_t n_linrefs,
+                              PgfBuildLinIface *build, PgfExn *err)
+    {
+        size_t n_prods = n_lindefs+n_linrefs;
+        this->args = vector_new<PgfPArg>(n_prods);
+        this->res  = vector_new<ref<PgfPResult>>(n_prods);
+        this->seqs = vector_new<ref<Vector<PgfSymbol>>>(n_lindefs*n_fields+n_linrefs);
+        this->n_lindefs = n_lindefs;
+        this->n_linrefs = n_linrefs;
+
+        ref<Vector<ref<PgfText>>> db_fields = vector_new<ref<PgfText>>(n_fields);
+        for (size_t i = 0; i < n_fields; i++) {
+            ref<PgfText> field = textdup_db(fields[i]);
+            *vector_elem(db_fields, i) = field;
+        }
+
+        ref<PgfConcrLincat> lincat = PgfDB::malloc<PgfConcrLincat>(abscat->name.size+1);
+        memcpy(&lincat->name, &abscat->name, sizeof(PgfText)+abscat->name.size+1);
+        lincat->ref_count = 1;
+        lincat->abscat = abscat;
+        lincat->args = args;
+        lincat->res  = res;
+        lincat->seqs = seqs;
+        lincat->fields = db_fields;
+        lincat->n_lindefs = n_lindefs;
+
+        build->build(this, err);
+        if (err->type == PGF_EXN_NONE && res_index != res->len) {
+            err->type = PGF_EXN_PGF_ERROR;
+            err->msg  = builder_error_msg;
+        }
+
+        if (err->type != PGF_EXN_NONE) {
+            failed();
+            for (size_t i = 0; i < n_fields; i++) {
+                PgfDB::free(*vector_elem(db_fields, i));
+            }
+            PgfDB::free(db_fields);
+            PgfDB::free(lincat);
+            return 0;
+        }
+
+        return lincat;
+    }
+
+    ref<PgfConcrLin> build(ref<PgfAbsFun> absfun, PgfConcr *concr, size_t n_prods,
+                           PgfBuildLinIface *build, PgfExn *err)
     {
         ref<PgfConcrLincat> lincat =
             namespace_lookup(concr->lincats, &absfun->type->name);
@@ -1230,14 +1389,12 @@ public:
             throw pgf_error("Missing linearization category");
         }
 
-        ref<Vector<PgfPArg>> args =
-            vector_new<PgfPArg>(n_prods*absfun->type->hypos->len);
-        ref<Vector<ref<PgfPResult>>> res =
-            vector_new<ref<PgfPResult>>(n_prods);
-        ref<Vector<ref<Vector<PgfSymbol>>>> seqs =
-            vector_new<ref<Vector<PgfSymbol>>>(n_prods*lincat->fields->len);
+        this->args = vector_new<PgfPArg>(n_prods*absfun->type->hypos->len);
+        this->res  = vector_new<ref<PgfPResult>>(n_prods);
+        this->seqs = vector_new<ref<Vector<PgfSymbol>>>(n_prods*lincat->fields->len);
+        this->n_lindefs = n_prods;
 
-        lin = PgfDB::malloc<PgfConcrLin>(absfun->name.size+1);
+        ref<PgfConcrLin> lin = PgfDB::malloc<PgfConcrLin>(absfun->name.size+1);
         memcpy(&lin->name, &absfun->name, sizeof(PgfText)+absfun->name.size+1);
         lin->ref_count = 1;
         lin->absfun = absfun;
@@ -1245,16 +1402,19 @@ public:
         lin->res  = res;
         lin->seqs = seqs;
 
-        this->var_index = 0;
-        this->arg_index = 0;
-        this->res_index = 0;
-        this->seq_index = 0;
-        this->sym_index = (size_t) -1;
-        this->alt_index = (size_t) -1;
+        build->build(this, err);
+        if (err->type == PGF_EXN_NONE && res_index != res->len) {
+            err->type = PGF_EXN_PGF_ERROR;
+            err->msg  = builder_error_msg;
+        }
 
-        this->syms = 0;
+        if (err->type != PGF_EXN_NONE) {
+            failed();
+            PgfDB::free(lin);
+            return 0;
+        }
 
-        this->pre_sym_index = (size_t) -1;
+        return lin;
     }
 
     void start_production(PgfExn *err)
@@ -1263,10 +1423,10 @@ public:
             return;
 
         PGF_API_BEGIN {
-            if (res_index >= lin->res->len)
+            if (res_index >= res->len)
                 throw pgf_error(builder_error_msg);
             var_index = 0;
-            *vector_elem(lin->res, res_index) = 0;
+            *vector_elem(res, res_index) = 0;
         } PGF_API_END
     }
 
@@ -1276,7 +1436,7 @@ public:
             return;
 
         PGF_API_BEGIN {
-            if (arg_index >= lin->args->len)
+            if (arg_index >= args->len)
                 throw pgf_error(builder_error_msg);
 
             ref<PgfLParam> param = PgfDB::malloc<PgfLParam>(n_terms*2*sizeof(size_t));
@@ -1288,7 +1448,7 @@ public:
                 param->terms[i].var    = terms[2*i+1];
             }
 
-            ref<PgfPArg> parg = vector_elem(lin->args, arg_index);
+            ref<PgfPArg> parg = vector_elem(args, arg_index);
             parg->param = param;
 
             arg_index++;
@@ -1301,24 +1461,24 @@ public:
             return;
 
         PGF_API_BEGIN {
-            if (res_index >= lin->res->len)
+            if (res_index >= res->len)
                 throw pgf_error(builder_error_msg);
 
             ref<Vector<PgfVariableRange>> vars =
                 (n_vars > 0) ? vector_new<PgfVariableRange>(n_vars)
                              : 0;
 
-            ref<PgfPResult> res = PgfDB::malloc<PgfPResult>(n_terms*2*sizeof(size_t));
-            res->vars = vars;
-            res->param.i0 = i0;
-            res->param.n_terms = n_terms;
+            ref<PgfPResult> res_elem = PgfDB::malloc<PgfPResult>(n_terms*2*sizeof(size_t));
+            res_elem->vars = vars;
+            res_elem->param.i0 = i0;
+            res_elem->param.n_terms = n_terms;
 
             for (size_t i = 0; i < n_terms; i++) {
-                res->param.terms[i].factor = terms[2*i];
-                res->param.terms[i].var    = terms[2*i+1];
+                res_elem->param.terms[i].factor = terms[2*i];
+                res_elem->param.terms[i].var    = terms[2*i+1];
             }
 
-            *vector_elem(lin->res, res_index) = res;
+            *vector_elem(res, res_index) = res_elem;
         } PGF_API_END
     }
 
@@ -1328,17 +1488,17 @@ public:
             return;
 
         PGF_API_BEGIN {
-            if (res_index >= lin->res->len)
+            if (res_index >= res->len)
                 throw pgf_error(builder_error_msg);
 
-            ref<PgfPResult> res =
-                *vector_elem(lin->res, res_index);
+            ref<PgfPResult> res_elem =
+                *vector_elem(res, res_index);
 
-            if (res->vars == 0 || var_index >= res->vars->len)
+            if (res_elem->vars == 0 || var_index >= res_elem->vars->len)
                 throw pgf_error(builder_error_msg);
 
             ref<PgfVariableRange> var_range =
-                vector_elem(res->vars, var_index);
+                vector_elem(res_elem->vars, var_index);
             var_range->var   = var;
             var_range->range = range;
 
@@ -1352,11 +1512,11 @@ public:
             return;
 
         PGF_API_BEGIN {
-            if (seq_index >= lin->seqs->len)
+            if (seq_index >= seqs->len)
                 throw pgf_error(builder_error_msg);
 
             syms = vector_new<PgfSymbol>(n_syms);
-            *vector_elem(lin->seqs, seq_index) = syms;
+            *vector_elem(seqs, seq_index) = syms;
             sym_index = 0;
         } PGF_API_END
     }
@@ -1485,7 +1645,7 @@ public:
                 *vector_elem(prefixes, i) = pref;
             }
 
-            syms = *vector_elem(lin->seqs, seq_index);
+            syms = *vector_elem(seqs, seq_index);
             ref<PgfSymbolKP> symkp = ref<PgfSymbolKP>::untagged(*vector_elem(syms, pre_sym_index));
             ref<PgfAlternative> alt = ref<PgfAlternative>::from_ptr(&symkp->alts.data[alt_index]);
 
@@ -1506,7 +1666,7 @@ public:
             if (pre_sym_index == (size_t) -1)
                 throw pgf_error(builder_error_msg);
 
-            syms = *vector_elem(lin->seqs, seq_index);
+            syms = *vector_elem(seqs, seq_index);
             ref<PgfSymbolKP> symkp = ref<PgfSymbolKP>::untagged(*vector_elem(syms, pre_sym_index));            
             if (alt_index >= symkp->alts.len)
                 throw pgf_error(builder_error_msg);
@@ -1524,7 +1684,7 @@ public:
             if (pre_sym_index == (size_t) -1)
                 throw pgf_error(builder_error_msg);
 
-            syms = *vector_elem(lin->seqs, seq_index);
+            syms = *vector_elem(seqs, seq_index);
             sym_index = pre_sym_index+1;
             alt_index = 0;
             pre_sym_index = (size_t) -1;
@@ -1635,49 +1795,45 @@ public:
             return;
 
         PGF_API_BEGIN {
-            size_t n_args = (lin->args->len/lin->res->len);
+            size_t n_args = (args->len/res->len);
             if (arg_index != (res_index+1)*n_args)
                 throw pgf_error(builder_error_msg);
 
-            if (*vector_elem(lin->res, res_index) == 0)
+            if (*vector_elem(res, res_index) == 0)
                 throw pgf_error(builder_error_msg);
 
-            size_t n_seqs = (lin->seqs->len/lin->res->len);
-            if (seq_index != (res_index+1)*n_seqs)
+            size_t n_seqs = ((seqs->len-n_linrefs)/(res->len-n_linrefs));
+            size_t exp_index =
+                     (res_index < n_lindefs) ? (res_index+1)*n_seqs
+                                             : n_seqs * n_lindefs + (res_index-n_lindefs+1) ;
+            if (seq_index != exp_index)
                 throw pgf_error(builder_error_msg);
 
             res_index++;
         } PGF_API_END
     }
-
-    ref<PgfConcrLin> done()
-    {
-        if (res_index != lin->res->len)
-            throw pgf_error(builder_error_msg);
-        return lin;
-    }
     
     void failed()
     {
         for (size_t i = 0; i < arg_index; i++) {
-            PgfDB::free(vector_elem(lin->args, i)->param);
+            PgfDB::free(vector_elem(args, i)->param);
         }
-        PgfDB::free(lin->args);
+        PgfDB::free(args);
 
         for (size_t i = 0; i < res_index; i++) {
-            ref<PgfPResult> res = *vector_elem(lin->res, i);
-            PgfDB::free(res->vars);
-            PgfDB::free(res);
+            ref<PgfPResult> res_elem = *vector_elem(res, i);
+            PgfDB::free(res_elem->vars);
+            PgfDB::free(res_elem);
         }
-        PgfDB::free(lin->res);
+        PgfDB::free(res);
 
         for (size_t i = 0; i < seq_index; i++) {
-            ref<Vector<PgfSymbol>> syms = *vector_elem(lin->seqs, i);
+            ref<Vector<PgfSymbol>> syms = *vector_elem(seqs, i);
             pgf_symbols_free(syms);
         }
         
         if (sym_index != (size_t) -1) {
-            ref<Vector<PgfSymbol>> syms = *vector_elem(lin->seqs, seq_index);
+            ref<Vector<PgfSymbol>> syms = *vector_elem(seqs, seq_index);
 
             if (pre_sym_index != (size_t) -1) {
                 auto sym_kp = ref<PgfSymbolKP>::untagged(*vector_elem(syms, pre_sym_index));
@@ -1719,10 +1875,7 @@ public:
             PgfDB::free(syms);
         }
 
-        PgfDB::free(lin->seqs);
-
-        PgfDB::free(lin);
-        lin = 0;
+        PgfDB::free(seqs);
     }
 };
 
@@ -1731,6 +1884,7 @@ PGF_API
 void pgf_create_lincat(PgfDB *db,
                        PgfRevision revision, PgfConcrRevision cnc_revision,
                        PgfText *name, size_t n_fields, PgfText **fields,
+                       size_t n_lindefs, size_t n_linrefs, PgfBuildLinIface *build,
                        PgfExn *err)
 {
     PGF_API_BEGIN {
@@ -1745,22 +1899,14 @@ void pgf_create_lincat(PgfDB *db,
             throw pgf_error("There is no corresponding category in the abstract syntax");
         }
 
-        ref<Vector<ref<PgfText>>> db_fields = vector_new<ref<PgfText>>(n_fields);
-        for (size_t i = 0; i < n_fields; i++) {
-            ref<PgfText> field = textdup_db(fields[i]);
-            *vector_elem(db_fields, i) = field;
+        ref<PgfConcrLincat> lincat =
+            PgfLinBuilder().build(abscat, concr, n_fields, fields, n_lindefs, n_linrefs, build, err);
+        if (lincat != 0) {
+            Namespace<PgfConcrLincat> lincats =
+                namespace_insert(concr->lincats, lincat);
+            namespace_release(concr->lincats);
+            concr->lincats = lincats;
         }
-
-        ref<PgfConcrLincat> lincat = PgfDB::malloc<PgfConcrLincat>(name->size+1);
-        memcpy(&lincat->name, name, sizeof(PgfText)+name->size+1);
-        lincat->ref_count = 1;
-        lincat->abscat = abscat;
-        lincat->fields = db_fields;
-
-        Namespace<PgfConcrLincat> lincats =
-            namespace_insert(concr->lincats, lincat);
-        namespace_release(concr->lincats);
-        concr->lincats = lincats;
     } PGF_API_END
 }
 
@@ -1800,16 +1946,13 @@ void pgf_create_lin(PgfDB *db,
             throw pgf_error("There is no corresponding function in the abstract syntax");
         }
 
-        PgfLinBuilder builder(absfun, concr, n_prods);
-        build->build(&builder, err);
-        if (err->type == PGF_EXN_NONE) {
-            ref<PgfConcrLin> lin = builder.done();
+        ref<PgfConcrLin> lin =
+            PgfLinBuilder().build(absfun, concr, n_prods, build, err);
+        if (lin != 0) {
             Namespace<PgfConcrLin> lins =
                 namespace_insert(concr->lins, lin);
             namespace_release(concr->lins);
             concr->lins = lins;
-        } else {
-            builder.failed();
         }
     } PGF_API_END
 }

src/runtime/c/pgf/pgf.h

@@ -397,6 +397,18 @@ PgfText *pgf_get_lincat_field_internal(object o, size_t i);
 PGF_API_DECL
 void pgf_get_lin_counts_internal(object o, size_t *counts);
 
+PGF_API_DECL
+PgfText *pgf_print_lindef_sig_internal(object o, size_t i);
+
+PGF_API_DECL
+PgfText *pgf_print_lindef_seq_internal(object o, size_t i, size_t j);
+
+PGF_API_DECL
+PgfText *pgf_print_linref_sig_internal(object o, size_t i);
+
+PGF_API_DECL
+PgfText *pgf_print_linref_seq_internal(object o, size_t i);
+
 PGF_API_DECL
 PgfText *pgf_print_lin_sig_internal(object o, size_t i);
 
@@ -474,16 +486,6 @@ void pgf_drop_concrete(PgfDB *db, PgfRevision revision,
                        PgfText *name,
                        PgfExn *err);
 
-PGF_API_DECL
-void pgf_create_lincat(PgfDB *db,
-                       PgfRevision revision, PgfConcrRevision cnc_revision,
-                       PgfText *name, size_t n_fields, PgfText **fields,
-                       PgfExn *err);
-
-PGF_API_DECL
-void pgf_drop_lincat(PgfDB *db, PgfConcrRevision revision,
-                     PgfText *name, PgfExn *err);
-
 #ifdef __cplusplus
 struct PgfLinBuilderIface {
     virtual void start_production(PgfExn *err)=0;
@@ -554,6 +556,17 @@ struct PgfBuildLinIface {
 };
 #endif
 
+PGF_API_DECL
+void pgf_create_lincat(PgfDB *db,
+                       PgfRevision revision, PgfConcrRevision cnc_revision,
+                       PgfText *name, size_t n_fields, PgfText **fields,
+                       size_t n_lindefs, size_t n_linrefs, PgfBuildLinIface *build,
+                       PgfExn *err);
+
+PGF_API_DECL
+void pgf_drop_lincat(PgfDB *db, PgfConcrRevision revision,
+                     PgfText *name, PgfExn *err);
+
 PGF_API_DECL
 void pgf_create_lin(PgfDB *db,
                     PgfRevision revision, PgfConcrRevision cnc_revision,

src/runtime/c/pgf/reader.cxx

@@ -530,6 +530,10 @@ ref<PgfConcrLincat> PgfReader::read_lincat()
     lincat->ref_count = 1;
     lincat->abscat = namespace_lookup(abstract->cats, &lincat->name);
     lincat->fields = read_vector(&PgfReader::read_text2);
+    lincat->n_lindefs = read_len();
+    lincat->args = read_vector(&PgfReader::read_parg);
+    lincat->res  = read_vector(&PgfReader::read_presult2);
+    lincat->seqs = read_vector(&PgfReader::read_seq2);
     return lincat;
 }
 

src/runtime/c/pgf/writer.cxx

@@ -330,12 +330,6 @@ void PgfWriter::write_abstract(ref<PgfAbstr> abstract)
     this->abstract = 0;
 }
 
-void PgfWriter::write_lincat(ref<PgfConcrLincat> lincat)
-{
-    write_name(&lincat->name);
-    write_vector(lincat->fields, &PgfWriter::write_text);
-}
-
 void PgfWriter::write_variable_range(ref<PgfVariableRange> var)
 {
     write_int(var->var);
@@ -422,6 +416,16 @@ void PgfWriter::write_seq(ref<Vector<PgfSymbol>> seq)
     write_vector(seq, &PgfWriter::write_symbol);
 }
 
+void PgfWriter::write_lincat(ref<PgfConcrLincat> lincat)
+{
+    write_name(&lincat->name);
+    write_vector(lincat->fields, &PgfWriter::write_text);
+    write_len(lincat->n_lindefs);
+    write_vector(lincat->args, &PgfWriter::write_parg);
+    write_vector(lincat->res, &PgfWriter::write_presult);
+    write_vector(lincat->seqs, &PgfWriter::write_seq);
+}
+
 void PgfWriter::write_lin(ref<PgfConcrLin> lin)
 {
     write_name(&lin->name);

src/runtime/haskell/PGF2.hsc

@@ -240,15 +240,39 @@ showPGF p =
         getLincats ref itor key val exn = do
           name   <- bracket (pgf_print_ident key) free $ \c_text -> do
                       peekText c_text
-          fields <- allocaBytes (1*(#size size_t)) $ \pcounts -> do
+          (n_fields,n_lindefs,n_linrefs) <-
+                    allocaBytes (3*(#size size_t)) $ \pcounts -> do
                       pgf_get_lincat_counts_internal val pcounts
-                      n_fields <- peekElemOff pcounts 0
+                      n_fields  <- peekElemOff pcounts 0
+                      n_lindefs <- peekElemOff pcounts 1
+                      n_linrefs <- peekElemOff pcounts 2
+                      return (n_fields,n_lindefs,n_linrefs)
+          fields <- allocaBytes (3*(#size size_t)) $ \pcounts -> do
                       forM (init [0..n_fields]) $ \i -> do
                         pgf_get_lincat_field_internal val i >>= peekText
           let def = text "lincat" <+> (text name <+> char '=' <+> char '[' $$
                                        nest 2 (vcat (map (text.show) fields)) $$
                                        char ']')
           modifyIORef ref $ (\doc -> doc $$ def)
+          forM_ (init [0..n_lindefs]) $ \i -> do
+            sig <- bracket (pgf_print_lindef_sig_internal val i) free $ \c_text -> do
+                     fmap text (peekText c_text)
+            seqs <- forM (init [0..n_fields]) $ \j ->
+                      bracket (pgf_print_lindef_seq_internal val i j) free $ \c_text -> do
+                          fmap text (peekText c_text)
+            let def = text "lindef" <+> (sig <+> char '=' <+> char '[' $$
+                                         nest 2 (vcat seqs) $$
+                                         char ']')
+            modifyIORef ref $ (\doc -> doc $$ def)
+          forM_ (init [0..n_linrefs]) $ \i -> do
+            sig <- bracket (pgf_print_linref_sig_internal val i) free $ \c_text -> do
+                     fmap text (peekText c_text)
+            seq <- bracket (pgf_print_linref_seq_internal val i) free $ \c_text -> do
+                     fmap text (peekText c_text)
+            let def = text "linref" <+> (sig <+> char '=' <+> char '[' $$
+                                         nest 2 seq $$
+                                         char ']')
+            modifyIORef ref $ (\doc -> doc $$ def)
 
     ppLins c = unsafePerformIO $ do
       ref <- newIORef empty

src/runtime/haskell/PGF2/FFI.hsc

@@ -111,6 +111,14 @@ foreign import ccall pgf_get_lincat_counts_internal :: Ptr () -> Ptr CSize -> IO
 
 foreign import ccall pgf_get_lincat_field_internal :: Ptr () -> CSize -> IO (Ptr PgfText)
 
+foreign import ccall pgf_print_lindef_sig_internal :: Ptr () -> CSize -> IO (Ptr PgfText)
+
+foreign import ccall pgf_print_lindef_seq_internal :: Ptr () -> CSize -> CSize -> IO (Ptr PgfText)
+
+foreign import ccall pgf_print_linref_sig_internal :: Ptr () -> CSize -> IO (Ptr PgfText)
+
+foreign import ccall pgf_print_linref_seq_internal :: Ptr () -> CSize -> IO (Ptr PgfText)
+
 foreign import ccall pgf_get_lin_counts_internal :: Ptr () -> Ptr CSize -> IO ()
 
 foreign import ccall pgf_print_lin_sig_internal :: Ptr () -> CSize -> IO (Ptr PgfText)
@@ -189,7 +197,7 @@ foreign import ccall "dynamic" callLinBuilder5 :: Dynamic (Ptr PgfLinBuilderIfac
 
 foreign import ccall "dynamic" callLinBuilder6 :: Dynamic (Ptr PgfLinBuilderIface -> CSize -> CSize -> Ptr (Ptr PgfText) -> Ptr PgfExn -> IO ())
 
-foreign import ccall pgf_create_lincat :: Ptr PgfDB -> Ptr PGF -> Ptr Concr -> Ptr PgfText -> CSize -> Ptr (Ptr PgfText) -> Ptr PgfExn -> IO ()
+foreign import ccall pgf_create_lincat :: Ptr PgfDB -> Ptr PGF -> Ptr Concr -> Ptr PgfText -> CSize -> Ptr (Ptr PgfText) -> CSize -> CSize -> Ptr PgfBuildLinIface -> Ptr PgfExn -> IO ()
 
 foreign import ccall pgf_drop_lincat :: Ptr PgfDB -> Ptr Concr -> Ptr PgfText -> Ptr PgfExn -> IO ()
 

src/runtime/haskell/PGF2/Transactions.hsc

@@ -216,13 +216,17 @@ data PArg = PArg [(LIndex,LIndex)] {-# UNPACK #-} !LParam
 data Production = Production [(LVar,LIndex)] [PArg] LParam [[Symbol]]
                  deriving (Eq,Show)
 
-createLincat :: Cat -> [String] -> Transaction Concr ()
-createLincat name fields = Transaction $ \c_db c_abstr c_revision c_exn ->
+createLincat :: Cat -> [String] -> [Production] -> [Production] -> Transaction Concr ()
+createLincat name fields lindefs linrefs = Transaction $ \c_db c_abstr c_revision c_exn ->
   let n_fields = length fields
   in withText name $ \c_name ->
      allocaBytes (n_fields*(#size PgfText*)) $ \c_fields ->
      withTexts c_fields 0 fields $
-       pgf_create_lincat c_db c_abstr c_revision c_name (fromIntegral n_fields) c_fields c_exn
+     withBuildLinIface (lindefs++linrefs) $ \c_build ->
+       pgf_create_lincat c_db c_abstr c_revision c_name
+                         (fromIntegral n_fields) c_fields
+                         (fromIntegral (length lindefs)) (fromIntegral (length linrefs))
+                         c_build c_exn
   where
     withTexts p i []     f = f
     withTexts p i (s:ss) f =
@@ -238,12 +242,16 @@ dropLincat name = Transaction $ \c_db _ c_revision c_exn ->
 createLin :: Fun -> [Production] -> Transaction Concr ()
 createLin name prods = Transaction $ \c_db c_abstr c_revision c_exn ->
   withText name $ \c_name ->
+  withBuildLinIface prods $ \c_build ->
+    pgf_create_lin c_db c_abstr c_revision c_name (fromIntegral (length prods)) c_build c_exn
+
+withBuildLinIface prods f =
   allocaBytes (#size PgfBuildLinIface) $ \c_build ->
   allocaBytes (#size PgfBuildLinIfaceVtbl) $ \vtbl ->
   bracket (wrapLinBuild build) freeHaskellFunPtr $ \c_callback -> do
     (#poke PgfBuildLinIface, vtbl) c_build vtbl
     (#poke PgfBuildLinIfaceVtbl, build) vtbl c_callback
-    pgf_create_lin c_db c_abstr c_revision c_name (fromIntegral (length prods)) c_build c_exn
+    f c_build
   where
     forM_ []     c_exn f = return ()
     forM_ (x:xs) c_exn f = do

src/runtime/haskell/tests/basic.pmcfg

@@ -14,11 +14,28 @@ concrete basic_cnc {
   lincat N = [
            "s"
          ]
+  lindef N :  String(0) -> N(0) = [
+           <0,0>
+         ]
+  linref N : ∀{i<2} . N(i) -> String(0) = [
+           <0,0>
+         ]
   lincat P = [
+         ]
+  lindef P :  String(0) -> P(0) = [
+         ]
+  linref P : P(0) -> String(0) = [
+           
          ]
   lincat S = [
            ""
          ]
+  lindef S :  String(0) -> S(0) = [
+           <0,0>
+         ]
+  linref S : S(0) -> String(0) = [
+           <0,0>
+         ]
   lin c : ∀{i<2} . N(i) -> S(0) = [
         <0,0>
       ]