forked from GitHub/gf-core
Unify the data model between the C runtime and the Haskell binding
This commit is contained in:
@@ -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
|
||||
return (PMCFGRule (PMCFGCat r rs) args (reverse lins))
|
||||
args <- zipWithM tnk2lparam args ctxt
|
||||
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
|
||||
|
||||
@@ -103,13 +103,17 @@ instance Binary Options where
|
||||
toString (LInt n) = show n
|
||||
toString (LFlt d) = show d
|
||||
|
||||
instance Binary PMCFGCat where
|
||||
put (PMCFGCat r rs) = put (r,rs)
|
||||
get = get >>= \(r,rs) -> return (PMCFGCat r rs)
|
||||
instance Binary LParam where
|
||||
put (LParam r rs) = put (r,rs)
|
||||
get = get >>= \(r,rs) -> return (LParam r rs)
|
||||
|
||||
instance Binary PMCFGRule where
|
||||
put (PMCFGRule res args rules) = put (res,args,rules)
|
||||
get = get >>= \(res,args,rules) -> return (PMCFGRule res args rules)
|
||||
instance Binary PArg where
|
||||
put (PArg x y) = put (x,y)
|
||||
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 (SymLit n l) = putWord8 1 >> put (n,l)
|
||||
put (SymCat d r) = putWord8 0 >> put (d,r)
|
||||
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
|
||||
|
||||
@@ -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,
|
||||
| CncFun (Maybe ([Ident],Ident,Context,Type)) (Maybe (L Term)) (Maybe (L Term)) (Maybe [PMCFGRule]) -- ^ (/CNC/) type info added at 'TC'
|
||||
| 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 [Production]) -- ^ (/CNC/) type info added at 'TC'
|
||||
|
||||
-- indirection to module Ident
|
||||
| AnyInd Bool ModuleName -- ^ (/INDIR/) the 'Bool' says if canonical
|
||||
|
||||
@@ -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
|
||||
ppPmcfgCat cat (PMCFGCat r rs) = pp cat <> parens (ppLinFun ppLParam r rs)
|
||||
ppPArg cat (PArg _ p) = ppPmcfgCat cat p
|
||||
|
||||
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 (SymLit d r) = pp '{' <> pp d <> pp ',' <> pp r <> pp '}'
|
||||
ppSymbol (SymCat d r)= pp '<' <> pp d <> pp ',' <> ppLParam 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
|
||||
|
||||
@@ -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;
|
||||
|
||||
|
||||
@@ -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,
|
||||
|
||||
@@ -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,
|
||||
|
||||
@@ -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;
|
||||
}
|
||||
|
||||
@@ -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();
|
||||
|
||||
@@ -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);
|
||||
}
|
||||
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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 ()
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user