GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-13 14:59:32 -06:00
Code Issues Packages Projects Releases Wiki Activity

restore the sharing of sequences. Shrinks the grammar by ~45%

Browse Source
This commit is contained in:
Krasimir Angelov
2022-01-08 19:49:42 +01:00
parent cd2c6aa32a
commit 00f857559d
31 changed files with 882 additions and 353 deletions
Download Patch File Download Diff File Expand all files Collapse all files

116
src/compiler/GF/Compile/GeneratePMCFG.hs
View File

@@ -22,77 +22,99 @@ import GF.Text.Pretty
import GF.Compile.Compute.Concrete
import GF.Data.Operations(Err(..))
import PGF2.Transactions
import qualified Data.Map.Strict as Map
import Control.Monad
import Data.List(mapAccumL,sortBy)
import Data.Maybe(fromMaybe)
import Control.Monad.State
import qualified Data.Map.Strict as Map
import qualified Data.Sequence as Seq
import Data.List(mapAccumL,sortOn)
import Data.Maybe(fromMaybe,isNothing)
generatePMCFG :: Options -> FilePath -> SourceGrammar -> SourceModule -> Check SourceModule
generatePMCFG opts cwd gr cmo@(cm,cmi)
| mstatus cmi == MSComplete && isModCnc cmi =
| mstatus cmi == MSComplete && isModCnc cmi && isNothing (mseqs cmi) =
do let gr' = prependModule gr cmo
js <- mapM (addPMCFG opts cwd gr' cmi) (Map.toList (jments cmi))
return (cm,cmi{jments = (Map.fromAscList js)})
(js,seqs) <- runStateT (Map.traverseWithKey (\id info -> StateT (addPMCFG opts cwd gr' cmi id info)) (jments cmi)) Map.empty
return (cm,cmi{jments = js, mseqs=Just (mapToSequence seqs)})
| otherwise = return cmo
where
mapToSequence m = Seq.fromList (map fst (sortOn snd (Map.toList m)))
addPMCFG opts cwd gr cmi (id,CncCat mty@(Just (L loc ty)) mdef mref mprn Nothing) = do
defs <- case mdef of
type SequenceSet = Map.Map [Symbol] Int
addPMCFG opts cwd gr cmi id (CncCat mty@(Just (L loc ty)) mdef mref mprn Nothing) seqs = do
(defs,seqs) <-
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
pmcfgForm gr term [(Explicit,identW,typeStr)] ty seqs
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
pmcfgForm gr term [(Explicit,identW,typeStr)] ty seqs
(refs,seqs) <-
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
pmcfgForm gr term [(Explicit,identW,ty)] typeStr seqs
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
pmcfgForm gr term [(Explicit,identW,ty)] typeStr seqs
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
return (CncCat mty mdef mref mprn (Just (defs,refs)),seqs)
addPMCFG opts cwd gr cmi id (CncFun mty@(Just (_,cat,ctxt,val)) mlin@(Just (L loc term)) mprn Nothing) seqs = do
(rules,seqs) <-
checkInModule cwd cmi loc ("Happened in the PMCFG generation for" <+> id) $
pmcfgForm gr term ctxt val seqs
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,CncFun mty mlin mprn (Just rules))
addPMCFG opts cwd gr cmi id_info = return id_info
return (CncFun mty mlin mprn (Just rules),seqs)
addPMCFG opts cwd gr cmi id info seqs = return (info,seqs)
pmcfgForm :: Grammar -> Term -> Context -> Type -> Check [Production]
pmcfgForm gr t ctxt ty =
runEvalM gr $ do
((_,ms),args) <- mapAccumM (\(d,ms) (_,_,ty) -> do
let (ms',_,t) = type2metaTerm gr d ms 0 [] ty
tnk <- newThunk [] t
return ((d+1,ms'),tnk))
(0,Map.empty) ctxt
sequence_ [newNarrowing i ty | (i,ty) <- Map.toList ms]
v <- eval [] t args
(lins,params) <- flatten v ty ([],[])
lins <- mapM str2lin lins
(r,rs,_) <- compute params
args <- zipWithM tnk2lparam args ctxt
vars <- getVariables
return (Production vars args (LParam r (order rs)) (reverse lins))
where
tnk2lparam tnk (_,_,ty) = do
v <- force tnk
(_,params) <- flatten v ty ([],[])
(r,rs,_) <- compute params
return (PArg [] (LParam r (order rs)))
pmcfgForm :: Grammar -> Term -> Context -> Type -> SequenceSet -> Check ([Production],SequenceSet)
pmcfgForm gr t ctxt ty seqs = do
res <- runEvalM gr $ do
((_,ms),args) <- mapAccumM (\(d,ms) (_,_,ty) -> do
let (ms',_,t) = type2metaTerm gr d ms 0 [] ty
tnk <- newThunk [] t
return ((d+1,ms'),tnk))
(0,Map.empty) ctxt
sequence_ [newNarrowing i ty | (i,ty) <- Map.toList ms]
v <- eval [] t args
(lins,params) <- flatten v ty ([],[])
lins <- fmap reverse $ mapM str2lin lins
(r,rs,_) <- compute params
args <- zipWithM tnk2lparam args ctxt
vars <- getVariables
let res = LParam r (order rs)
return (vars,args,res,lins)
return (runState (mapM mkProduction res) seqs)
where
tnk2lparam tnk (_,_,ty) = do
v <- force tnk
(_,params) <- flatten v ty ([],[])
(r,rs,_) <- compute params
return (PArg [] (LParam r (order rs)))
compute [] = return (0,[],1)
compute ((v,ty):params) = do
(r, rs ,cnt ) <- param2int v ty
(r',rs',cnt') <- compute params
return (r*cnt'+r',combine cnt' rs rs',cnt*cnt')
compute [] = return (0,[],1)
compute ((v,ty):params) = do
(r, rs ,cnt ) <- param2int v ty
(r',rs',cnt') <- compute params
return (r*cnt'+r',combine cnt' rs rs',cnt*cnt')
mkProduction (vars,args,res,lins) = do
lins <- mapM getSeqId lins
return (Production vars args res lins)
where
getSeqId :: [Symbol] -> State (Map.Map [Symbol] SeqId) SeqId
getSeqId lin = state $ \m ->
case Map.lookup lin m of
Just seqid -> (seqid,m)
Nothing -> let seqid = Map.size m
in (seqid,Map.insert lin seqid m)
type2metaTerm :: SourceGrammar -> Int -> Map.Map MetaId Type -> LIndex -> [(LIndex,(Ident,Type))] -> Type -> (Map.Map MetaId Type,Int,Term)
type2metaTerm gr d ms r rs (Sort s) | s == cStr =
@@ -238,7 +260,7 @@ combine cnt' ((r,pv):rs) ((r',pv'):rs') =
EQ -> (r*cnt'+r',pv ) : combine cnt' rs ((r',pv'):rs')
GT -> ( r',pv') : combine cnt' ((r,pv):rs) rs'
order = sortBy (\(r1,_) (r2,_) -> compare r2 r1)
order = sortOn fst
mapAccumM f a [] = return (a,[])
mapAccumM f a (x:xs) = do (a, y) <- f a x

54
src/compiler/GF/Compile/GrammarToPGF.hs
View File

@@ -18,12 +18,13 @@ import GF.Infra.Option
import GF.Infra.UseIO (IOE)
import GF.Data.Operations
import Control.Monad(forM_)
import Control.Monad(forM_,foldM)
import Data.List
import Data.Char
import qualified Data.Set as Set
import qualified Data.Map as Map
import qualified Data.IntMap as IntMap
import qualified Data.Sequence as Seq
import Data.Array.IArray
import Data.Maybe(fromMaybe)
import System.FilePath
@@ -56,14 +57,18 @@ grammar2PGF opts mb_pgf gr am probs = do
createConcrete (mi2i cm) $ do
let cflags = err (const noOptions) mflags (lookupModule gr cm)
sequence_ [setConcreteFlag name value | (name,value) <- optionsPGF cflags]
let id_prod = Production [] [PArg [] (LParam 0 [])] (LParam 0 []) [[SymCat 0 (LParam 0 [])]]
prods = ([id_prod],[id_prod])
infos = (((cPredefAbs,cInt), CncCat (Just (noLoc GM.defLinType)) Nothing Nothing Nothing (Just prods))
:((cPredefAbs,cString),CncCat (Just (noLoc GM.defLinType)) Nothing Nothing Nothing (Just prods))
:((cPredefAbs,cFloat), CncCat (Just (noLoc GM.defLinType)) Nothing Nothing Nothing (Just prods))
: Look.allOrigInfos gr cm)
forM_ infos createCncCats
forM_ infos createCncFuns
let infos = ( Seq.fromList [Left [SymCat 0 (LParam 0 [])]]
, let id_prod = Production [] [PArg [] (LParam 0 [])] (LParam 0 []) [0]
prods = ([id_prod],[id_prod])
in [(cInt, CncCat (Just (noLoc GM.defLinType)) Nothing Nothing Nothing (Just prods))
,(cString,CncCat (Just (noLoc GM.defLinType)) Nothing Nothing Nothing (Just prods))
,(cFloat, CncCat (Just (noLoc GM.defLinType)) Nothing Nothing Nothing (Just prods))
]
)
: prepareSeqTbls (Look.allOrigInfos gr cm)
infos <- processInfos createCncCats infos
infos <- processInfos createCncFuns infos
return ()
return pgf
where
aflags = err (const noOptions) mflags (lookupModule gr am)
@@ -95,19 +100,38 @@ grammar2PGF opts mb_pgf 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)) _ _ mprn (Just (lindefs,linrefs))) = do
createLincat (i2i c) (type2fields gr ty) lindefs linrefs
prepareSeqTbls infos =
(map addSeqTable . Map.toList . Map.fromListWith (++))
[(m,[(c,info)]) | ((m,c),info) <- infos]
where
addSeqTable (m,infos) =
case lookupModule gr m of
Ok mi -> case mseqs mi of
Just seqs -> (fmap Left seqs,infos)
Nothing -> (Seq.empty,[])
Bad msg -> error msg
processInfos f [] = return []
processInfos f ((seqtbl,infos):rest) = do
seqtbl <- foldM f seqtbl infos
rest <- processInfos f rest
return ((seqtbl,infos):rest)
createCncCats seqtbl (c,CncCat (Just (L _ ty)) _ _ mprn (Just (lindefs,linrefs))) = do
seqtbl <- createLincat (i2i c) (type2fields gr ty) lindefs linrefs seqtbl
case mprn of
Nothing -> return ()
Just (L _ prn) -> setPrintName (i2i c) (unwords (term2tokens prn))
createCncCats _ = return ()
return seqtbl
createCncCats seqtbl _ = return seqtbl
createCncFuns ((m,f),CncFun _ _ mprn (Just prods)) = do
createLin (i2i f) prods
createCncFuns seqtbl (f,CncFun _ _ mprn (Just prods)) = do
seqtbl <- createLin (i2i f) prods seqtbl
case mprn of
Nothing -> return ()
Just (L _ prn) -> setPrintName (i2i f) (unwords (term2tokens prn))
createCncFuns _ = return ()
return seqtbl
createCncFuns seqtbl _ = return seqtbl
term2tokens (K tok) = [tok]
term2tokens (C t1 t2) = term2tokens t1 ++ term2tokens t2

6
src/compiler/GF/Compile/Update.hs
View File

@@ -78,7 +78,7 @@ extendModule cwd gr (name,m)
-- | rebuilding instance + interface, and "with" modules, prior to renaming.
-- AR 24/10/2003
rebuildModule :: FilePath -> SourceGrammar -> SourceModule -> Check SourceModule
rebuildModule cwd gr mo@(i,mi@(ModInfo mt stat fs_ me mw ops_ med_ msrc_ js_)) =
rebuildModule cwd gr mo@(i,mi@(ModInfo mt stat fs_ me mw ops_ med_ msrc_ mseqs js_)) =
checkInModule cwd mi NoLoc empty $ do
---- deps <- moduleDeps ms
@@ -115,7 +115,7 @@ rebuildModule cwd gr mo@(i,mi@(ModInfo mt stat fs_ me mw ops_ med_ msrc_ js_)) =
else MSIncomplete
unless (stat' == MSComplete || stat == MSIncomplete)
(checkError ("module" <+> i <+> "remains incomplete"))
ModInfo mt0 _ fs me' _ ops0 _ fpath js <- lookupModule gr ext
ModInfo mt0 _ fs me' _ ops0 _ fpath _ js <- lookupModule gr ext
let ops1 = nub $
ops_ ++ -- N.B. js has been name-resolved already
[OQualif i j | (i,j) <- ops] ++
@@ -131,7 +131,7 @@ rebuildModule cwd gr mo@(i,mi@(ModInfo mt stat fs_ me mw ops_ med_ msrc_ js_)) =
js
let js1 = Map.union js0 js_
let med1= nub (ext : infs ++ insts ++ med_)
return $ ModInfo mt0 stat' fs1 me Nothing ops1 med1 msrc_ js1
return $ ModInfo mt0 stat' fs1 me Nothing ops1 med1 msrc_ mseqs js1
return (i,mi')

6
src/compiler/GF/Grammar/Binary.hs
View File

@@ -34,8 +34,8 @@ instance Binary Grammar where
instance Binary ModuleInfo where
put mi = do put (mtype mi,mstatus mi,mflags mi,mextend mi,mwith mi,mopens mi,mexdeps mi,msrc mi,jments mi)
get = do (mtype,mstatus,mflags,mextend,mwith,mopens,med,msrc,jments) <- get
return (ModInfo mtype mstatus mflags mextend mwith mopens med msrc jments)
get = do (mtype,mstatus,mflags,mextend,mwith,mopens,med,msrc,mseqs,jments) <- get
return (ModInfo mtype mstatus mflags mextend mwith mopens med msrc mseqs jments)
instance Binary ModuleType where
put MTAbstract = putWord8 0
@@ -365,7 +365,7 @@ decodeModuleHeader :: MonadIO io => FilePath -> io (VersionTagged Module)
decodeModuleHeader = liftIO . fmap (fmap conv) . decodeFile'
where
conv (m,mtype,mstatus,mflags,mextend,mwith,mopens,med,msrc) =
(m,ModInfo mtype mstatus mflags mextend mwith mopens med msrc Map.empty)
(m,ModInfo mtype mstatus mflags mextend mwith mopens med msrc Nothing Map.empty)
encodeModule :: MonadIO io => FilePath -> SourceModule -> io ()
encodeModule fpath mo = liftIO $ encodeFile fpath (Tagged mo)

4
src/compiler/GF/Grammar/Grammar.hs
View File

@@ -74,11 +74,12 @@ import GF.Infra.Location
import GF.Data.Operations
import PGF2(BindType(..))
import PGF2.Transactions(LIndex,LVar,LParam(..),PArg(..),Symbol(..),Production(..))
import PGF2.Transactions(SeqId,LIndex,LVar,LParam(..),PArg(..),Symbol(..),Production(..))
import Data.Array.IArray(Array)
import Data.Array.Unboxed(UArray)
import qualified Data.Map as Map
import qualified Data.Sequence as Seq
import GF.Text.Pretty
@@ -100,6 +101,7 @@ data ModuleInfo = ModInfo {
mopens :: [OpenSpec],
mexdeps :: [ModuleName],
msrc :: FilePath,
mseqs :: Maybe (Seq.Seq [Symbol]),
jments :: Map.Map Ident Info
}

4
src/compiler/GF/Grammar/Parser.y
View File

@@ -132,14 +132,14 @@ ModDef
(opens,jments,opts) = case content of { Just c -> c; Nothing -> ([],[],noOptions) }
jments <- mapM (checkInfoType mtype) jments
defs <- buildAnyTree id jments
return (id, ModInfo mtype mstat opts extends with opens [] "" defs) }
return (id, ModInfo mtype mstat opts extends with opens [] "" Nothing defs) }
ModHeader :: { SourceModule }
ModHeader
: ComplMod ModType '=' ModHeaderBody { let { mstat = $1 ;
(mtype,id) = $2 ;
(extends,with,opens) = $4 }
in (id, ModInfo mtype mstat noOptions extends with opens [] "" Map.empty) }
in (id, ModInfo mtype mstat noOptions extends with opens [] "" Nothing Map.empty) }
ComplMod :: { ModuleStatus }
ComplMod

25
src/compiler/GF/Grammar/Printer.hs
View File

@@ -25,6 +25,7 @@ module GF.Grammar.Printer
import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint
import PGF2(Literal(..))
import PGF2.Transactions(SeqId)
import GF.Infra.Ident
import GF.Infra.Option
import GF.Grammar.Values
@@ -34,8 +35,9 @@ import GF.Grammar.Grammar
import GF.Text.Pretty
import Data.Maybe (isNothing)
import Data.List (intersperse)
import Data.Foldable (toList)
import qualified Data.Map as Map
import qualified Data.Array.IArray as Array
import qualified Data.Sequence as Seq
import qualified GHC.Show
data TermPrintQual
@@ -46,10 +48,11 @@ instance Pretty Grammar where
pp = vcat . map (ppModule Qualified) . modules
ppModule :: TermPrintQual -> SourceModule -> Doc
ppModule q (mn, ModInfo mtype mstat opts exts with opens _ _ jments) =
ppModule q (mn, ModInfo mtype mstat opts exts with opens _ _ mseqs jments) =
hdr $$
nest 2 (ppOptions opts $$
vcat (map (ppJudgement q) (Map.toList jments))) $$
vcat (map (ppJudgement q) (Map.toList jments)) $$
maybe empty (ppSequences q) mseqs) $$
ftr
where
hdr = complModDoc <+> modTypeDoc <+> '=' <+>
@@ -160,7 +163,7 @@ ppJudgement q (id, AnyInd cann mid) =
Internal -> "ind" <+> id <+> '=' <+> (if cann then pp "canonical" else empty) <+> mid <+> ';'
_ -> empty
ppPmcfgRule id arg_cats res_cat (Production vars args res lins) =
ppPmcfgRule id arg_cats res_cat (Production vars args res seqids) =
pp id <+> (':' <+>
(if null vars
then empty
@@ -169,7 +172,7 @@ ppPmcfgRule id arg_cats res_cat (Production vars args res lins) =
then empty
else hsep (intersperse (pp '*') (zipWith ppPArg arg_cats args)) <+> "->") <+>
ppPmcfgCat res_cat res $$
'=' <+> brackets (vcat (map (hsep . map ppSymbol) lins)))
'=' <+> brackets (hcat (intersperse (pp ',') (map ppSeqId seqids))))
ppPArg cat (PArg _ p) = ppPmcfgCat cat p
@@ -340,6 +343,18 @@ ppAltern q (x,y) = ppTerm q 0 x <+> '/' <+> ppTerm q 0 y
ppParams q ps = fsep (intersperse (pp '|') (map (ppParam q) ps))
ppParam q (id,cxt) = id <+> hsep (map (ppDDecl q) cxt)
ppSeqId :: SeqId -> Doc
ppSeqId seqid = 'S' <> pp seqid
ppSequences q seqs
| Seq.null seqs || q /= Internal = empty
| otherwise = "sequences" <+> '{' $$
nest 2 (vcat (zipWith ppSeq [0..] (toList seqs))) $$
'}'
where
ppSeq seqid seq =
ppSeqId seqid <+> ":=" <+> hsep (map ppSymbol seq)
commaPunct f ds = (hcat (punctuate "," (map f ds)))
prec d1 d2 doc

15
src/compiler/GF/Interactive.hs
View File

@@ -28,8 +28,9 @@ import PGF2
import PGF2.Transactions hiding (modifyPGF,checkoutPGF)
import Data.Char
import Data.List(isPrefixOf)
import Data.List(isPrefixOf,sortOn)
import qualified Data.Map as Map
import qualified Data.Sequence as Seq
import qualified Text.ParserCombinators.ReadP as RP
import System.Directory(getAppUserDataDirectory)
import Control.Exception(SomeException,fromException,evaluate,try)
@@ -256,9 +257,9 @@ transactionCommand (CreateLin opts f t) pgf = do
in return (fields,type2term mo ty)
Nothing -> fail ("Function "++f++" is not in the abstract syntax")
case runCheck (compileLinTerm sgr mo t ty) of
Ok ((prods,fields'),_)
Ok ((prods,seqtbl,fields'),_)
| fields == fields' ->
do lift $ modifyPGF pgf (alterConcrete lang (createLin f prods))
do lift $ modifyPGF pgf (alterConcrete lang (createLin f prods seqtbl >> return ()))
return ()
| otherwise -> fail "The linearization categories in the resource and the compiled grammar does not match"
Bad msg -> fail msg
@@ -272,8 +273,10 @@ transactionCommand (CreateLin opts f t) pgf = do
t <- renameSourceTerm sgr mo (Typed t ty)
(t,ty) <- inferLType sgr [] t
let (ctxt,res_ty) = typeFormCnc ty
prods <- pmcfgForm sgr t ctxt res_ty
return (prods,type2fields sgr res_ty)
(prods,seqs) <- pmcfgForm sgr t ctxt res_ty Map.empty
return (prods,mapToSequence seqs,type2fields sgr res_ty)
where
mapToSequence m = Seq.fromList (map (Left . fst) (sortOn snd (Map.toList m)))
transactionCommand (CreateLincat opts c t) pgf = do
sgr <- getGrammar
@@ -281,7 +284,7 @@ transactionCommand (CreateLincat opts c t) pgf = do
mo <- maybe (fail "no source grammar in scope") return $
greatestResource sgr
case runCheck (compileLincatTerm sgr mo t) of
Ok (fields,_)-> do lift $ modifyPGF pgf (alterConcrete lang (createLincat c fields [] []))
Ok (fields,_)-> do lift $ modifyPGF pgf (alterConcrete lang (createLincat c fields [] [] Seq.empty >> return ()))
return ()
Bad msg -> fail msg
where

4
src/runtime/c/Makefile.am
View File

@@ -29,7 +29,9 @@ libpgf_la_SOURCES = \
pgf/data.h \
pgf/expr.cxx \
pgf/expr.h \
pgf/namespace.h
pgf/namespace.h \
pgf/phrasetable.cxx \
pgf/phrasetable.h
libpgf_la_LDFLAGS = -no-undefined
libpgf_la_CXXFLAGS = -fno-rtti -std=c++11 -DCOMPILING_PGF

55
src/runtime/c/pgf/data.cxx
View File

@@ -3,6 +3,7 @@
void PgfFlag::release(ref<PgfFlag> flag)
{
pgf_literal_free(flag->value);
PgfDB::free(flag);
}
void PgfAbsFun::release(ref<PgfAbsFun> absfun)
@@ -12,11 +13,14 @@ void PgfAbsFun::release(ref<PgfAbsFun> absfun)
if (absfun->bytecode != 0) {
PgfDB::free(absfun->bytecode);
}
PgfDB::free(absfun);
}
void PgfAbsCat::release(ref<PgfAbsCat> abscat)
{
pgf_context_free(abscat->context);
PgfDB::free(abscat);
}
void PgfPGF::release(ref<PgfPGF> pgf)
@@ -27,6 +31,7 @@ void PgfPGF::release(ref<PgfPGF> pgf)
namespace_release(pgf->abstract.funs);
namespace_release(pgf->abstract.cats);
namespace_release(pgf->concretes);
PgfDB::free(pgf);
}
void PgfConcr::release(ref<PgfConcr> concr)
@@ -35,6 +40,7 @@ void PgfConcr::release(ref<PgfConcr> concr)
namespace_release(concr->lins);
namespace_release(concr->lincats);
namespace_release(concr->printnames);
PgfDB::free(concr);
}
void PgfConcrLincat::release(ref<PgfConcrLincat> lincat)
@@ -44,6 +50,29 @@ void PgfConcrLincat::release(ref<PgfConcrLincat> lincat)
}
PgfDB::free(lincat->fields);
for (size_t i = 0; i < lincat->args->len; i++) {
PgfDB::free(vector_elem(lincat->args, i)->param);
}
PgfDB::free(lincat->args);
for (size_t i = 0; i < lincat->res->len; i++) {
ref<PgfPResult> res = *vector_elem(lincat->res, i);
if (res->vars != 0)
PgfDB::free(res->vars);
PgfDB::free(res);
}
PgfDB::free(lincat->res);
for (size_t i = 0; i < lincat->seqs->len; i++) {
ref<PgfSequence> seq = *vector_elem(lincat->seqs, i);
if (!(--seq->ref_count)) {
PgfSequence::release(seq);
}
}
PgfDB::free(lincat->seqs);
PgfDB::free(lincat);
}
PGF_INTERNAL
@@ -52,9 +81,9 @@ void pgf_symbol_free(PgfSymbol sym)
switch (ref<PgfSymbol>::get_tag(sym)) {
case PgfSymbolKP::tag: {
auto sym_kp = ref<PgfSymbolKP>::untagged(sym);
pgf_symbols_free(sym_kp->default_form);
PgfSequence::release(sym_kp->default_form);
for (size_t i = 0; i < sym_kp->alts.len; i++) {
pgf_symbols_free(sym_kp->alts.data[i].form);
PgfSequence::release(sym_kp->alts.data[i].form);
for (size_t j = 0; j < sym_kp->alts.data[i].prefixes->len; j++) {
ref<PgfText> prefix = *vector_elem(sym_kp->alts.data[i].prefixes, j);
PgfDB::free(prefix);
@@ -75,14 +104,13 @@ void pgf_symbol_free(PgfSymbol sym)
}
}
PGF_INTERNAL
void pgf_symbols_free(ref<Vector<PgfSymbol>> syms)
void PgfSequence::release(ref<PgfSequence> seq)
{
for (size_t i = 0; i < syms->len; i++) {
PgfSymbol sym = *vector_elem(syms, i);
for (size_t i = 0; i < seq->syms.len; i++) {
PgfSymbol sym = *vector_elem(&seq->syms, i);
pgf_symbol_free(sym);
}
PgfDB::free(syms);
PgfDB::free(seq);
}
void PgfConcrLin::release(ref<PgfConcrLin> lin)
@@ -101,17 +129,18 @@ void PgfConcrLin::release(ref<PgfConcrLin> lin)
PgfDB::free(lin->res);
for (size_t i = 0; i < lin->seqs->len; i++) {
ref<Vector<PgfSymbol>> syms = *vector_elem(lin->seqs, i);
for (size_t j = 0; j < syms->len; j++) {
PgfSymbol sym = *vector_elem(syms, j);
pgf_symbol_free(sym);
}
PgfDB::free(syms);
ref<PgfSequence> seq = *vector_elem(lin->seqs, i);
if (!(--seq->ref_count)) {
PgfSequence::release(seq);
}
}
PgfDB::free(lin->seqs);
PgfDB::free(lin);
}
void PgfConcrPrintname::release(ref<PgfConcrPrintname> printname)
{
PgfDB::free(printname->printname);
PgfDB::free(printname);
}

21
src/runtime/c/pgf/data.h
View File

@@ -64,6 +64,7 @@ class PgfConcr;
#include "text.h"
#include "vector.h"
#include "namespace.h"
#include "phrasetable.h"
#include "expr.h"
struct PGF_INTERNAL_DECL PgfFlag {
@@ -128,6 +129,14 @@ struct PGF_INTERNAL_DECL PgfPResult {
typedef object PgfSymbol;
struct PGF_INTERNAL_DECL PgfSequence {
size_t seq_id;
size_t ref_count;
Vector<PgfSymbol> syms;
static void release(ref<PgfSequence> lincat);
};
struct PGF_INTERNAL_DECL PgfSymbolCat {
static const uint8_t tag = 0;
size_t d;
@@ -151,7 +160,7 @@ struct PGF_INTERNAL_DECL PgfSymbolKS {
};
struct PGF_INTERNAL_DECL PgfAlternative {
ref<Vector<PgfSymbol>> form;
ref<PgfSequence> form;
/**< The form of this variant as a list of tokens. */
ref<Vector<ref<PgfText>>> prefixes;
@@ -161,7 +170,7 @@ struct PGF_INTERNAL_DECL PgfAlternative {
struct PGF_INTERNAL_DECL PgfSymbolKP {
static const uint8_t tag = 4;
ref<Vector<PgfSymbol>> default_form;
ref<PgfSequence> default_form;
Vector<PgfAlternative> alts;
};
@@ -192,9 +201,6 @@ struct PGF_INTERNAL_DECL PgfSymbolALLCAPIT {
PGF_INTERNAL_DECL
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;
@@ -205,7 +211,7 @@ struct PGF_INTERNAL_DECL PgfConcrLincat {
size_t n_lindefs;
ref<Vector<PgfPArg>> args;
ref<Vector<ref<PgfPResult>>> res;
ref<Vector<ref<Vector<PgfSymbol>>>> seqs;
ref<Vector<ref<PgfSequence>>> seqs;
PgfText name;
@@ -219,7 +225,7 @@ struct PGF_INTERNAL_DECL PgfConcrLin {
ref<Vector<PgfPArg>> args;
ref<Vector<ref<PgfPResult>>> res;
ref<Vector<ref<Vector<PgfSymbol>>>> seqs;
ref<Vector<ref<PgfSequence>>> seqs;
PgfText name;
@@ -240,6 +246,7 @@ struct PGF_INTERNAL_DECL PgfConcr {
Namespace<PgfFlag> cflags;
Namespace<PgfConcrLin> lins;
Namespace<PgfConcrLincat> lincats;
PgfPhrasetable phrasetable;
Namespace<PgfConcrPrintname> printnames;
// If there are references from the host language to this concrete,

2
src/runtime/c/pgf/db.cxx
View File

@@ -792,7 +792,6 @@ void PgfDB::cleanup_revisions()
ref<PgfPGF> pgf = ms->transient_revisions;
ref<PgfPGF> next = pgf->next;
PgfPGF::release(pgf);
PgfDB::free(pgf);
ms->transient_revisions = next;
}
@@ -802,7 +801,6 @@ void PgfDB::cleanup_revisions()
concr->ref_count -= concr->ref_count_ex;
if (!concr->ref_count) {
PgfConcr::release(concr);
PgfDB::free(concr);
}
ms->transient_concr_revisions = next;
}

22
src/runtime/c/pgf/linearizer.cxx
View File

@@ -52,10 +52,10 @@ void PgfLinearizer::TreeNode::linearize_var(PgfLinearizationOutputIface *out, Pg
out->symbol_token(linearizer->printer.get_text());
}
void PgfLinearizer::TreeNode::linearize_syms(PgfLinearizationOutputIface *out, PgfLinearizer *linearizer, ref<Vector<PgfSymbol>> syms)
void PgfLinearizer::TreeNode::linearize_seq(PgfLinearizationOutputIface *out, PgfLinearizer *linearizer, ref<PgfSequence> seq)
{
for (size_t i = 0; i < syms->len; i++) {
PgfSymbol sym = *vector_elem(syms, i);
for (size_t i = 0; i < seq->syms.len; i++) {
PgfSymbol sym = *vector_elem(&seq->syms, i);
switch (ref<PgfSymbol>::get_tag(sym)) {
case PgfSymbolCat::tag: {
@@ -307,8 +307,8 @@ void PgfLinearizer::TreeLinNode::linearize(PgfLinearizationOutputIface *out, Pgf
}
size_t n_seqs = lin->seqs->len / lin->res->len;
ref<Vector<PgfSymbol>> syms = *vector_elem(lin->seqs, (lin_index-1)*n_seqs + lindex);
linearize_syms(out, linearizer, syms);
ref<PgfSequence> seq = *vector_elem(lin->seqs, (lin_index-1)*n_seqs + lindex);
linearize_seq(out, linearizer, seq);
if (linearizer->pre_stack == NULL)
out->end_phrase(cat, fid, field, &lin->name);
@@ -382,8 +382,8 @@ void PgfLinearizer::TreeLindefNode::linearize(PgfLinearizationOutputIface *out,
linearizer->pre_stack->bracket_stack = bracket;
}
ref<Vector<PgfSymbol>> syms = *vector_elem(lincat->seqs, (lin_index-1)*lincat->fields->len + lindex);
linearize_syms(out, linearizer, syms);
ref<PgfSequence> seq = *vector_elem(lincat->seqs, (lin_index-1)*lincat->fields->len + lindex);
linearize_seq(out, linearizer, seq);
if (linearizer->pre_stack == NULL)
out->end_phrase(&lincat->name, fid, field, linearizer->wild);
@@ -429,8 +429,8 @@ void PgfLinearizer::TreeLinrefNode::linearize(PgfLinearizationOutputIface *out,
ref<PgfConcrLincat> lincat = args->get_lincat(linearizer);
if (lincat != 0) {
size_t i = lincat->n_lindefs*lincat->fields->len + (lin_index-1);
ref<Vector<PgfSymbol>> syms = *vector_elem(lincat->seqs, i);
linearize_syms(out, linearizer, syms);
ref<PgfSequence> seq = *vector_elem(lincat->seqs, i);
linearize_seq(out, linearizer, seq);
} else {
args->linearize(out, linearizer, lindex);
}
@@ -573,14 +573,14 @@ void PgfLinearizer::flush_pre_stack(PgfLinearizationOutputIface *out, PgfText *t
for (size_t j = 0; j < alt->prefixes->len; j++) {
ref<PgfText> prefix = *vector_elem(alt->prefixes,j);
if (textstarts(token, &(*prefix))) {
pre->node->linearize_syms(out, this, alt->form);
pre->node->linearize_seq(out, this, alt->form);
goto done;
}
}
}
}
pre->node->linearize_syms(out, this, pre->sym_kp->default_form);
pre->node->linearize_seq(out, this, pre->sym_kp->default_form);
done:
if (pre->bracket_stack != NULL)

2
src/runtime/c/pgf/linearizer.h
View File

@@ -45,7 +45,7 @@ class PGF_INTERNAL_DECL PgfLinearizer : public PgfUnmarshaller {
virtual void check_category(PgfLinearizer *linearizer, PgfText *cat)=0;
virtual void linearize_arg(PgfLinearizationOutputIface *out, PgfLinearizer *linearizer, size_t d, PgfLParam *r);
virtual void linearize_var(PgfLinearizationOutputIface *out, PgfLinearizer *linearizer, size_t d, size_t r);
virtual void linearize_syms(PgfLinearizationOutputIface *out, PgfLinearizer *linearizer, ref<Vector<PgfSymbol>> syms);
virtual void linearize_seq(PgfLinearizationOutputIface *out, PgfLinearizer *linearizer, ref<PgfSequence> seq);
virtual void linearize(PgfLinearizationOutputIface *out, PgfLinearizer *linearizer, size_t lindex)=0;
size_t eval_param(PgfLParam *param);
virtual ref<PgfConcrLincat> get_lincat(PgfLinearizer *linearizer)=0;

1
src/runtime/c/pgf/namespace.h
View File

@@ -509,7 +509,6 @@ void namespace_release(Namespace<V> node)
if (!(--node->value->ref_count)) {
V::release(node->value);
PgfDB::free(node->value);
}
PgfDB::free(node);

272
src/runtime/c/pgf/pgf.cxx
View File

@@ -273,7 +273,7 @@ PGF_API_DECL
void pgf_free_revision(PgfDB *db, PgfRevision revision)
{
try {
DB_scope scope(db, WRITER_SCOPE);
DB_scope scope(db, READER_SCOPE);
ref<PgfPGF> pgf = PgfDB::revision2pgf(revision);
if (pgf->ref_count == 1 && PgfDB::is_persistant_revision(pgf)) {
@@ -287,7 +287,6 @@ void pgf_free_revision(PgfDB *db, PgfRevision revision)
if (!(--pgf->ref_count)) {
PgfDB::unlink_transient_revision(pgf);
PgfPGF::release(pgf);
PgfDB::free(pgf);
}
db->ref_count--;
@@ -303,7 +302,7 @@ PGF_API_DECL
void pgf_free_concr_revision(PgfDB *db, PgfConcrRevision revision)
{
try {
DB_scope scope(db, WRITER_SCOPE);
DB_scope scope(db, READER_SCOPE);
ref<PgfConcr> concr = PgfDB::revision2concr(revision);
if (!(--concr->ref_count_ex)) {
@@ -312,7 +311,6 @@ void pgf_free_concr_revision(PgfDB *db, PgfConcrRevision revision)
if (!(--concr->ref_count)) {
PgfConcr::release(concr);
PgfDB::free(concr);
}
db->ref_count--;
@@ -357,8 +355,7 @@ struct PgfItorConcrHelper : PgfItor
};
static
void iter_concretes_helper(PgfItor *itor, PgfText *key, object value,
PgfExn *err)
void iter_concretes_helper(PgfItor *itor, PgfText *key, object value, PgfExn *err)
{
PgfItorConcrHelper* helper = (PgfItorConcrHelper*) itor;
ref<PgfConcr> concr = value;
@@ -501,8 +498,7 @@ struct PgfItorCatHelper : PgfItor
};
static
void iter_by_cat_helper(PgfItor *itor, PgfText *key, object value,
PgfExn *err)
void iter_by_cat_helper(PgfItor *itor, PgfText *key, object value, PgfExn *err)
{
PgfItorCatHelper* helper = (PgfItorCatHelper*) itor;
ref<PgfAbsFun> absfun = value;
@@ -830,6 +826,19 @@ void pgf_iter_lins(PgfDB *db, PgfConcrRevision cnc_revision,
} PGF_API_END
}
PGF_API
void pgf_iter_sequences(PgfDB *db, PgfConcrRevision cnc_revision,
PgfSequenceItor *itor, PgfExn *err)
{
PGF_API_BEGIN {
DB_scope scope(db, READER_SCOPE);
ref<PgfConcr> concr = PgfDB::revision2concr(cnc_revision);
size_t next_id = 0;
phrasetable_iter(concr->phrasetable, itor, &next_id, err);
} PGF_API_END
}
PGF_API
void pgf_get_lincat_counts_internal(object o, size_t *counts)
{
@@ -847,15 +856,14 @@ PgfText *pgf_get_lincat_field_internal(object o, size_t i)
}
PGF_API
void pgf_get_lin_counts_internal(object o, size_t *counts)
size_t pgf_get_lin_get_prod_count(object o)
{
ref<PgfConcrLin> lin = o;
counts[0] = lin->res->len;
counts[1] = lin->seqs->len / lin->res->len;
return lin->res->len;
}
PGF_API
PgfText *pgf_print_lindef_sig_internal(object o, size_t i)
PgfText *pgf_print_lindef_internal(object o, size_t i)
{
ref<PgfConcrLincat> lincat = o;
@@ -877,29 +885,24 @@ PgfText *pgf_print_lindef_sig_internal(object o, size_t i)
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);
printer.puts(") = [");
size_t n_seqs = lincat->fields->len;
ref<Vector<PgfSymbol>> syms = *vector_elem(lincat->seqs, i*n_seqs + j);
for (size_t j = 0; j < n_seqs; j++) {
if (j > 0)
printer.puts(",");
printer.symbols(syms);
ref<PgfSequence> seq = *vector_elem(lincat->seqs, i*n_seqs + j);
printer.seq_id(seq->seq_id);
}
printer.puts("]");
return printer.get_text();
}
PGF_API
PgfText *pgf_print_linref_sig_internal(object o, size_t i)
PgfText *pgf_print_linref_internal(object o, size_t i)
{
ref<PgfConcrLincat> lincat = o;
@@ -919,29 +922,19 @@ PgfText *pgf_print_linref_sig_internal(object o, size_t i)
printer.efun(&lincat->name);
printer.puts("(");
printer.lparam(vector_elem(lincat->args, lincat->n_lindefs+i)->param);
printer.puts(") -> String(0)");
printer.puts(") -> String(0) = [");
size_t n_seqs = lincat->fields->len;
ref<PgfSequence> seq = *vector_elem(lincat->seqs, lincat->n_lindefs*n_seqs+i);
printer.seq_id(seq->seq_id);
printer.puts("]");
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)
PgfText *pgf_print_lin_internal(object o, size_t i)
{
ref<PgfConcrLin> lin = o;
ref<PgfDTyp> ty = lin->absfun->type;
@@ -974,23 +967,33 @@ PgfText *pgf_print_lin_sig_internal(object o, size_t i)
printer.efun(&ty->name);
printer.puts("(");
printer.lparam(ref<PgfLParam>::from_ptr(&res->param));
printer.puts(")");
printer.puts(") = [");
size_t n_seqs = lin->seqs->len / lin->res->len;
for (size_t j = 0; j < n_seqs; j++) {
if (j > 0)
printer.puts(",");
ref<PgfSequence> seq = *vector_elem(lin->seqs, i*n_seqs + j);
printer.seq_id(seq->seq_id);
}
printer.puts("]");
return printer.get_text();
}
PGF_API
PgfText *pgf_print_lin_seq_internal(object o, size_t i, size_t j)
PgfText *pgf_print_sequence_internal(object o)
{
ref<PgfConcrLin> lin = o;
ref<PgfSequence> seq = o;
PgfInternalMarshaller m;
PgfPrinter printer(NULL,0,&m);
size_t n_seqs = lin->seqs->len / lin->res->len;
ref<Vector<PgfSymbol>> syms = *vector_elem(lin->seqs, i*n_seqs + j);
printer.symbols(syms);
printer.seq_id(seq->seq_id);
printer.puts(" = ");
printer.sequence(seq);
return printer.get_text();
}
@@ -1256,6 +1259,7 @@ PgfConcrRevision pgf_create_concrete(PgfDB *db, PgfRevision revision,
concr->cflags = 0;
concr->lins = 0;
concr->lincats = 0;
concr->phrasetable = 0;
concr->printnames = 0;
concr->prev = 0;
concr->next = 0;
@@ -1348,9 +1352,11 @@ void pgf_drop_concrete(PgfDB *db, PgfRevision revision,
class PGF_INTERNAL PgfLinBuilder : public PgfLinBuilderIface
{
ref<PgfConcr> concr;
ref<Vector<PgfPArg>> args;
ref<Vector<ref<PgfPResult>>> res;
ref<Vector<ref<Vector<PgfSymbol>>>> seqs;
ref<Vector<ref<PgfSequence>>> seqs;
size_t var_index;
size_t arg_index;
@@ -1362,7 +1368,7 @@ class PGF_INTERNAL PgfLinBuilder : public PgfLinBuilderIface
size_t n_lindefs;
size_t n_linrefs;
ref<Vector<PgfSymbol>> syms;
ref<PgfSequence> seq;
size_t pre_sym_index;
@@ -1370,8 +1376,10 @@ class PGF_INTERNAL PgfLinBuilder : public PgfLinBuilderIface
"Detected incorrect use of the linearization builder";
public:
PgfLinBuilder()
PgfLinBuilder(ref<PgfConcr> concr)
{
this->concr = concr;
this->args = 0;
this->res = 0;
this->seqs = 0;
@@ -1383,11 +1391,11 @@ public:
this->alt_index = (size_t) -1;
this->n_lindefs = 0;
this->n_linrefs = 0;
this->syms = 0;
this->seq = 0;
this->pre_sym_index = (size_t) -1;
}
ref<PgfConcrLincat> build(ref<PgfAbsCat> abscat, PgfConcr *concr,
ref<PgfConcrLincat> build(ref<PgfAbsCat> abscat,
size_t n_fields, PgfText **fields,
size_t n_lindefs, size_t n_linrefs,
PgfBuildLinIface *build, PgfExn *err)
@@ -1395,7 +1403,7 @@ public:
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->seqs = vector_new<ref<PgfSequence>>(n_lindefs*n_fields+n_linrefs);
this->n_lindefs = n_lindefs;
this->n_linrefs = n_linrefs;
@@ -1434,7 +1442,7 @@ public:
return lincat;
}
ref<PgfConcrLin> build(ref<PgfAbsFun> absfun, PgfConcr *concr, size_t n_prods,
ref<PgfConcrLin> build(ref<PgfAbsFun> absfun, size_t n_prods,
PgfBuildLinIface *build, PgfExn *err)
{
ref<PgfConcrLincat> lincat =
@@ -1445,7 +1453,7 @@ public:
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->seqs = vector_new<ref<PgfSequence>>(n_prods*lincat->fields->len);
this->n_lindefs = n_prods;
ref<PgfConcrLin> lin = PgfDB::malloc<PgfConcrLin>(absfun->name.size+1);
@@ -1569,8 +1577,12 @@ public:
if (seq_index >= seqs->len)
throw pgf_error(builder_error_msg);
syms = vector_new<PgfSymbol>(n_syms);
*vector_elem(seqs, seq_index) = syms;
seq = PgfDB::malloc<PgfSequence>(n_syms*sizeof(PgfSymbol));
seq->seq_id = 0;
seq->ref_count = 1;
seq->syms.len = n_syms;
*vector_elem(seqs, seq_index) = seq;
sym_index = 0;
} PGF_API_END
}
@@ -1581,7 +1593,7 @@ public:
return;
PGF_API_BEGIN {
if (syms == 0 || sym_index == (size_t) -1 || sym_index >= syms->len)
if (seq == 0 || sym_index == (size_t) -1 || sym_index >= seq->syms.len)
throw pgf_error(builder_error_msg);
ref<PgfSymbolCat> symcat = PgfDB::malloc<PgfSymbolCat>(n_terms*2*sizeof(size_t));
@@ -1594,7 +1606,7 @@ public:
symcat->r.terms[i].var = terms[2*i+1];
}
*vector_elem(syms, sym_index) = ref<PgfSymbolCat>::tagged(symcat);
*vector_elem(&seq->syms, sym_index) = ref<PgfSymbolCat>::tagged(symcat);
sym_index++;
} PGF_API_END
}
@@ -1605,7 +1617,7 @@ public:
return;
PGF_API_BEGIN {
if (syms == 0 || sym_index == (size_t) -1 || sym_index >= syms->len)
if (seq == 0 || sym_index == (size_t) -1 || sym_index >= seq->syms.len)
throw pgf_error(builder_error_msg);
ref<PgfSymbolLit> symlit = PgfDB::malloc<PgfSymbolLit>(n_terms*2*sizeof(size_t));
@@ -1618,7 +1630,7 @@ public:
symlit->r.terms[i].var = terms[2*i+1];
}
*vector_elem(syms, sym_index) = ref<PgfSymbolLit>::tagged(symlit);
*vector_elem(&seq->syms, sym_index) = ref<PgfSymbolLit>::tagged(symlit);
sym_index++;
} PGF_API_END
}
@@ -1629,14 +1641,14 @@ public:
return;
PGF_API_BEGIN {
if (syms == 0 || sym_index == (size_t) -1 || sym_index >= syms->len)
if (seq == 0 || sym_index == (size_t) -1 || sym_index >= seq->syms.len)
throw pgf_error(builder_error_msg);
ref<PgfSymbolVar> symvar = PgfDB::malloc<PgfSymbolVar>();
symvar->d = d;
symvar->r = r;
*vector_elem(syms, sym_index) = ref<PgfSymbolVar>::tagged(symvar);
*vector_elem(&seq->syms, sym_index) = ref<PgfSymbolVar>::tagged(symvar);
sym_index++;
} PGF_API_END
}
@@ -1647,13 +1659,13 @@ public:
return;
PGF_API_BEGIN {
if (syms == 0 || sym_index == (size_t) -1 || sym_index >= syms->len)
if (seq == 0 || sym_index == (size_t) -1 || sym_index >= seq->syms.len)
throw pgf_error(builder_error_msg);
ref<PgfSymbolKS> symtok = PgfDB::malloc<PgfSymbolKS>(token->size+1);
memcpy(&symtok->token, token, sizeof(PgfText)+token->size+1);
*vector_elem(syms, sym_index) = ref<PgfSymbolKS>::tagged(symtok);
*vector_elem(&seq->syms, sym_index) = ref<PgfSymbolKS>::tagged(symtok);
sym_index++;
} PGF_API_END
}
@@ -1664,19 +1676,22 @@ public:
return;
PGF_API_BEGIN {
if (syms == 0 || sym_index == (size_t) -1 || sym_index >= syms->len || pre_sym_index != (size_t) -1)
if (seq == 0 || sym_index == (size_t) -1 || sym_index >= seq->syms.len || pre_sym_index != (size_t) -1)
throw pgf_error(builder_error_msg);
ref<Vector<PgfSymbol>> def = vector_new<PgfSymbol>(n_syms);
ref<PgfSequence> def = PgfDB::malloc<PgfSequence>(n_syms*sizeof(PgfSymbol));
def->seq_id = 0;
def->ref_count = 1;
def->syms.len = n_syms;
ref<PgfSymbolKP> symkp = PgfDB::malloc<PgfSymbolKP>(n_alts*sizeof(PgfAlternative));
symkp->default_form = def;
symkp->alts.len = n_alts;
*vector_elem(syms, sym_index) = ref<PgfSymbolKP>::tagged(symkp);
*vector_elem(&seq->syms, sym_index) = ref<PgfSymbolKP>::tagged(symkp);
pre_sym_index = sym_index;
syms = def;
seq = def;
sym_index = 0;
alt_index = 0;
} PGF_API_END
@@ -1691,7 +1706,10 @@ public:
if (pre_sym_index == (size_t) -1)
throw pgf_error(builder_error_msg);
ref<Vector<PgfSymbol>> form = vector_new<PgfSymbol>(n_syms);
ref<PgfSequence> form = PgfDB::malloc<PgfSequence>(n_syms*sizeof(PgfSymbol));
form->seq_id = 0;
form->ref_count = 1;
form->syms.len = n_syms;
ref<Vector<ref<PgfText>>> prefixes = vector_new<ref<PgfText>>(n_prefs);
for (size_t i = 0; i < n_prefs; i++) {
@@ -1699,14 +1717,14 @@ public:
*vector_elem(prefixes, i) = pref;
}
syms = *vector_elem(seqs, seq_index);
ref<PgfSymbolKP> symkp = ref<PgfSymbolKP>::untagged(*vector_elem(syms, pre_sym_index));
seq = *vector_elem(seqs, seq_index);
ref<PgfSymbolKP> symkp = ref<PgfSymbolKP>::untagged(*vector_elem(&seq->syms, pre_sym_index));
ref<PgfAlternative> alt = ref<PgfAlternative>::from_ptr(&symkp->alts.data[alt_index]);
alt->form = form;
alt->prefixes = prefixes;
syms = form;
seq = form;
sym_index = 0;
} PGF_API_END
}
@@ -1720,8 +1738,8 @@ public:
if (pre_sym_index == (size_t) -1)
throw pgf_error(builder_error_msg);
syms = *vector_elem(seqs, seq_index);
ref<PgfSymbolKP> symkp = ref<PgfSymbolKP>::untagged(*vector_elem(syms, pre_sym_index));
seq = *vector_elem(seqs, seq_index);
ref<PgfSymbolKP> symkp = ref<PgfSymbolKP>::untagged(*vector_elem(&seq->syms, pre_sym_index));
if (alt_index >= symkp->alts.len)
throw pgf_error(builder_error_msg);
@@ -1738,7 +1756,7 @@ public:
if (pre_sym_index == (size_t) -1)
throw pgf_error(builder_error_msg);
syms = *vector_elem(seqs, seq_index);
seq = *vector_elem(seqs, seq_index);
sym_index = pre_sym_index+1;
alt_index = 0;
pre_sym_index = (size_t) -1;
@@ -1751,10 +1769,10 @@ public:
return;
PGF_API_BEGIN {
if (syms == 0 || sym_index == (size_t) -1 || sym_index >= syms->len)
if (seq == 0 || sym_index == (size_t) -1 || sym_index >= seq->syms.len)
throw pgf_error(builder_error_msg);
*vector_elem(syms, sym_index) = ref<PgfSymbolBIND>::tagged(0);
*vector_elem(&seq->syms, sym_index) = ref<PgfSymbolBIND>::tagged(0);
sym_index++;
} PGF_API_END
}
@@ -1765,10 +1783,10 @@ public:
return;
PGF_API_BEGIN {
if (syms == 0 || sym_index == (size_t) -1 || sym_index >= syms->len)
if (seq == 0 || sym_index == (size_t) -1 || sym_index >= seq->syms.len)
throw pgf_error(builder_error_msg);
*vector_elem(syms, sym_index) = ref<PgfSymbolSOFTBIND>::tagged(0);
*vector_elem(&seq->syms, sym_index) = ref<PgfSymbolSOFTBIND>::tagged(0);
sym_index++;
} PGF_API_END
}
@@ -1779,10 +1797,10 @@ public:
return;
PGF_API_BEGIN {
if (syms == 0 || sym_index == (size_t) -1 || sym_index >= syms->len)
if (seq == 0 || sym_index == (size_t) -1 || sym_index >= seq->syms.len)
throw pgf_error(builder_error_msg);
*vector_elem(syms, sym_index) = ref<PgfSymbolNE>::tagged(0);
*vector_elem(&seq->syms, sym_index) = ref<PgfSymbolNE>::tagged(0);
sym_index++;
} PGF_API_END
}
@@ -1793,10 +1811,10 @@ public:
return;
PGF_API_BEGIN {
if (syms == 0 || sym_index == (size_t) -1 || sym_index >= syms->len)
if (seq == 0 || sym_index == (size_t) -1 || sym_index >= seq->syms.len)
throw pgf_error(builder_error_msg);
*vector_elem(syms, sym_index) = ref<PgfSymbolSOFTSPACE>::tagged(0);
*vector_elem(&seq->syms, sym_index) = ref<PgfSymbolSOFTSPACE>::tagged(0);
sym_index++;
} PGF_API_END
}
@@ -1807,10 +1825,10 @@ public:
return;
PGF_API_BEGIN {
if (syms == 0 || sym_index == (size_t) -1 || sym_index >= syms->len)
if (seq == 0 || sym_index == (size_t) -1 || sym_index >= seq->syms.len)
throw pgf_error(builder_error_msg);
*vector_elem(syms, sym_index) = ref<PgfSymbolCAPIT>::tagged(0);
*vector_elem(&seq->syms, sym_index) = ref<PgfSymbolCAPIT>::tagged(0);
sym_index++;
} PGF_API_END
}
@@ -1821,27 +1839,57 @@ public:
return;
PGF_API_BEGIN {
if (syms == 0 || sym_index == (size_t) -1 || sym_index >= syms->len)
if (seq == 0 || sym_index == (size_t) -1 || sym_index >= seq->syms.len)
throw pgf_error(builder_error_msg);
*vector_elem(syms, sym_index) = ref<PgfSymbolALLCAPIT>::tagged(0);
*vector_elem(&seq->syms, sym_index) = ref<PgfSymbolALLCAPIT>::tagged(0);
sym_index++;
} PGF_API_END
}
void end_sequence(PgfExn *err)
object end_sequence(PgfExn *err)
{
if (err->type != PGF_EXN_NONE)
return 0;
ref<PgfSequence> res = 0;
PGF_API_BEGIN {
if (seq == 0 || sym_index != seq->syms.len)
throw pgf_error(builder_error_msg);
PgfPhrasetable phrasetable =
phrasetable_internalize(concr->phrasetable, &seq);
if (phrasetable != concr->phrasetable) {
phrasetable_release(concr->phrasetable);
concr->phrasetable = phrasetable;
} else {
*vector_elem(seqs, seq_index) = seq;
}
res = seq;
sym_index = (size_t) -1;
seq = 0;
seq_index++;
} PGF_API_END
return res.as_object();
}
void add_sequence_id(object seq_id, PgfExn *err)
{
if (err->type != PGF_EXN_NONE)
return;
PGF_API_BEGIN {
if (syms == 0 || sym_index != syms->len)
if (seq_index >= seqs->len)
throw pgf_error(builder_error_msg);
sym_index = (size_t) -1;
syms = 0;
*vector_elem(seqs, seq_index) = seq_id;
seq_index++;
} PGF_API_END
}
}
void end_production(PgfExn *err)
{
@@ -1882,33 +1930,33 @@ public:
PgfDB::free(res);
for (size_t i = 0; i < seq_index; i++) {
ref<Vector<PgfSymbol>> syms = *vector_elem(seqs, i);
pgf_symbols_free(syms);
ref<PgfSequence> seq = *vector_elem(seqs, i);
PgfSequence::release(seq);
}
if (sym_index != (size_t) -1) {
ref<Vector<PgfSymbol>> syms = *vector_elem(seqs, seq_index);
ref<PgfSequence> seq = *vector_elem(seqs, seq_index);
if (pre_sym_index != (size_t) -1) {
auto sym_kp = ref<PgfSymbolKP>::untagged(*vector_elem(syms, pre_sym_index));
auto sym_kp = ref<PgfSymbolKP>::untagged(*vector_elem(&seq->syms, pre_sym_index));
if (this->syms == sym_kp->default_form) {
if (this->seq == sym_kp->default_form) {
for (size_t i = 0; i < sym_index; i++) {
PgfSymbol sym = *vector_elem(syms, i);
PgfSymbol sym = *vector_elem(&seq->syms, i);
pgf_symbol_free(sym);
}
PgfDB::free(syms);
PgfDB::free(seq);
} else {
pgf_symbols_free(sym_kp->default_form);
PgfSequence::release(sym_kp->default_form);
for (size_t i = 0; i < alt_index; i++) {
pgf_symbols_free(sym_kp->alts.data[i].form);
PgfSequence::release(sym_kp->alts.data[i].form);
for (size_t j = 0; j < sym_kp->alts.data[i].prefixes->len; j++) {
ref<PgfText> prefix = *vector_elem(sym_kp->alts.data[i].prefixes, j);
PgfDB::free(prefix);
}
}
for (size_t i = 0; i < sym_index; i++) {
PgfSymbol sym = *vector_elem(sym_kp->alts.data[alt_index].form, i);
PgfSymbol sym = *vector_elem(&sym_kp->alts.data[alt_index].form->syms, i);
pgf_symbol_free(sym);
}
PgfDB::free(sym_kp->alts.data[alt_index].form);
@@ -1923,10 +1971,10 @@ public:
}
for (size_t j = 0; j < sym_index; j++) {
PgfSymbol sym = *vector_elem(syms, j);
PgfSymbol sym = *vector_elem(&seq->syms, j);
pgf_symbol_free(sym);
}
PgfDB::free(syms);
PgfDB::free(seq);
}
PgfDB::free(seqs);
@@ -1954,7 +2002,7 @@ void pgf_create_lincat(PgfDB *db,
}
ref<PgfConcrLincat> lincat =
PgfLinBuilder().build(abscat, concr, n_fields, fields, n_lindefs, n_linrefs, build, err);
PgfLinBuilder(concr).build(abscat, n_fields, fields, n_lindefs, n_linrefs, build, err);
if (lincat != 0) {
Namespace<PgfConcrLincat> lincats =
namespace_insert(concr->lincats, lincat);
@@ -2004,7 +2052,7 @@ void pgf_create_lin(PgfDB *db,
}
ref<PgfConcrLin> lin =
PgfLinBuilder().build(absfun, concr, n_prods, build, err);
PgfLinBuilder(concr).build(absfun, n_prods, build, err);
if (lin != 0) {
Namespace<PgfConcrLin> lins =
namespace_insert(concr->lins, lin);

31
src/runtime/c/pgf/pgf.h
View File

@@ -396,6 +396,15 @@ PGF_API_DECL
void pgf_iter_lins(PgfDB *db, PgfConcrRevision cnc_revision,
PgfItor *itor, PgfExn *err);
typedef struct PgfSequenceItor PgfSequenceItor;
struct PgfSequenceItor {
void (*fn)(PgfSequenceItor* self, object value, PgfExn *err);
};
PGF_API
void pgf_iter_sequences(PgfDB *db, PgfConcrRevision cnc_revision,
PgfSequenceItor *itor, PgfExn *err);
PGF_API_DECL
void pgf_get_lincat_counts_internal(object o, size_t *counts);
@@ -403,25 +412,19 @@ PGF_API_DECL
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);
size_t pgf_get_lin_get_prod_count(object o);
PGF_API_DECL
PgfText *pgf_print_lindef_sig_internal(object o, size_t i);
PgfText *pgf_print_lindef_internal(object o, size_t i);
PGF_API_DECL
PgfText *pgf_print_lindef_seq_internal(object o, size_t i, size_t j);
PgfText *pgf_print_linref_internal(object o, size_t i);
PGF_API_DECL
PgfText *pgf_print_linref_sig_internal(object o, size_t i);
PgfText *pgf_print_lin_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);
PGF_API_DECL
PgfText *pgf_print_lin_seq_internal(object o, size_t i, size_t j);
PgfText *pgf_print_sequence_internal(object o);
PGF_API_DECL
void pgf_check_expr(PgfDB *db, PgfRevision revision,
@@ -515,7 +518,8 @@ struct PgfLinBuilderIface {
virtual void add_symsoftspace(PgfExn *err)=0;
virtual void add_symcapit(PgfExn *err)=0;
virtual void add_symallcapit(PgfExn *err)=0;
virtual void end_sequence(PgfExn *err)=0;
virtual object end_sequence(PgfExn *err)=0;
virtual void add_sequence_id(object seq_id, PgfExn *err)=0;
virtual void end_production(PgfExn *err)=0;
};
@@ -545,7 +549,8 @@ typedef struct {
void (*add_symsoftspace)(PgfLinBuilderIface *this, PgfExn *err);
void (*add_symcapit)(PgfLinBuilderIface *this, PgfExn *err);
void (*add_symallcapit)(PgfLinBuilderIface *this, PgfExn *err);
void (*end_sequence)(PgfLinBuilderIface *this, PgfExn *err);
object (*end_sequence)(PgfLinBuilderIface *this, PgfExn *err);
void (*add_sequence_id)(PgfLinBuilderIface *this, object seq_id, PgfExn *err);
void (*end_production)(PgfLinBuilderIface *this, PgfExn *err);
} PgfLinBuilderIfaceVtbl;

239
src/runtime/c/pgf/phrasetable.cxx Normal file
View File

@@ -0,0 +1,239 @@
#include "data.h"
static
int lparam_cmp(PgfLParam *p1, PgfLParam *p2)
{
if (p1->i0 < p2->i0)
return -1;
else if (p1->i0 > p2->i0)
return 1;
for (size_t i = 0; ; i++) {
if (i >= p1->n_terms)
return -(i < p2->n_terms);
if (i >= p2->n_terms)
return 1;
if (p1->terms[i].factor > p2->terms[i].factor)
return 1;
else if (p1->terms[i].factor < p2->terms[i].factor)
return -1;
else if (p1->terms[i].var > p2->terms[i].var)
return 1;
else if (p1->terms[i].var < p2->terms[i].var)
return -1;
}
return 0;
}
static
int sequence_cmp(ref<PgfSequence> seq1, ref<PgfSequence> seq2);
static
void symbol_cmp(PgfSymbol sym1, PgfSymbol sym2, int res[2])
{
uint8_t t1 = ref<PgfSymbol>::get_tag(sym1);
uint8_t t2 = ref<PgfSymbol>::get_tag(sym2);
if (t1 != t2) {
res[0] = (res[1] = ((int) t1) - ((int) t2));
return;
}
switch (t1) {
case PgfSymbolCat::tag: {
auto sym_cat1 = ref<PgfSymbolCat>::untagged(sym1);
auto sym_cat2 = ref<PgfSymbolCat>::untagged(sym2);
if (sym_cat1->d < sym_cat2->d)
res[0] = (res[1] = -1);
else if (sym_cat1->d > sym_cat2->d)
res[0] = (res[1] = 1);
else
res[0] = (res[1] = lparam_cmp(&sym_cat1->r, &sym_cat2->r));
break;
}
case PgfSymbolLit::tag: {
auto sym_lit1 = ref<PgfSymbolLit>::untagged(sym1);
auto sym_lit2 = ref<PgfSymbolLit>::untagged(sym2);
if (sym_lit1->d < sym_lit2->d)
res[0] = (res[1] = -1);
else if (sym_lit1->d > sym_lit2->d)
res[0] = (res[1] = 1);
else
res[0] = (res[1] = lparam_cmp(&sym_lit1->r, &sym_lit2->r));
break;
}
case PgfSymbolVar::tag: {
auto sym_var1 = ref<PgfSymbolVar>::untagged(sym1);
auto sym_var2 = ref<PgfSymbolVar>::untagged(sym2);
if (sym_var1->d < sym_var2->d)
res[0] = (res[1] = -1);
else if (sym_var1->d > sym_var2->d)
res[0] = (res[1] = 1);
else if (sym_var1->r < sym_var2->r)
res[0] = (res[1] = -1);
else if (sym_var1->r > sym_var2->r)
res[0] = (res[1] = 1);
break;
}
case PgfSymbolKS::tag: {
auto sym_ks1 = ref<PgfSymbolKS>::untagged(sym1);
auto sym_ks2 = ref<PgfSymbolKS>::untagged(sym2);
texticmp(&sym_ks1->token,&sym_ks2->token,res);
break;
}
case PgfSymbolKP::tag: {
auto sym_kp1 = ref<PgfSymbolKP>::untagged(sym1);
auto sym_kp2 = ref<PgfSymbolKP>::untagged(sym2);
res[0] = (res[1] = sequence_cmp(sym_kp1->default_form, sym_kp2->default_form));
if (res[0] != 0)
return;
for (size_t i = 0; ; i++) {
if (i >= sym_kp1->alts.len) {
res[0] = (res[1] = -(i < sym_kp2->alts.len));
return;
}
if (i >= sym_kp2->alts.len) {
res[0] = (res[1] = 1);
return;
}
res[0] = (res[1] = sequence_cmp(sym_kp1->alts.data[i].form, sym_kp2->alts.data[i].form));
if (res[0] != 0)
return;
ref<Vector<ref<PgfText>>> prefixes1 = sym_kp1->alts.data[i].prefixes;
ref<Vector<ref<PgfText>>> prefixes2 = sym_kp2->alts.data[i].prefixes;
for (size_t j = 0; ; j++) {
if (j >= prefixes1->len) {
res[0] = (res[1] = -(j < prefixes2->len));
return;
}
if (j >= prefixes2->len) {
res[0] = (res[1] = 1);
return;
}
res[0] = (res[1] = textcmp(&(**vector_elem(prefixes1, j)), &(**vector_elem(prefixes2, j))));
if (res[0] != 0)
return;
}
}
}
case PgfSymbolBIND::tag:
case PgfSymbolSOFTBIND::tag:
case PgfSymbolNE::tag:
case PgfSymbolSOFTSPACE::tag:
case PgfSymbolCAPIT::tag:
case PgfSymbolALLCAPIT::tag:
break;
default:
throw pgf_error("Unknown symbol tag");
}
}
static
int sequence_cmp(ref<PgfSequence> seq1, ref<PgfSequence> seq2)
{
int res[2] = {0,0};
for (size_t i = 0; ; i++) {
if (i >= seq1->syms.len) {
if (i < seq2->syms.len)
return -1;
return res[1];
}
if (i >= seq2->syms.len)
return 1;
symbol_cmp(seq1->syms.data[i], seq2->syms.data[i], res);
if (res[0] != 0)
return res[0];
}
return 0;
}
PGF_INTERNAL
PgfPhrasetable phrasetable_internalize(PgfPhrasetable table, ref<PgfSequence> *pseq)
{
if (table == 0) {
PgfPhrasetable table = Node<PgfSequence>::new_node(*pseq);
Node<PgfSequence>::add_value_ref(table->value);
return table;
}
int cmp = sequence_cmp(*pseq,table->value);
if (cmp < 0) {
PgfPhrasetable left = phrasetable_internalize(table->left, pseq);
if (left == table->left)
return table;
else {
PgfPhrasetable node = Node<PgfSequence>::balanceL(table->value,left,table->right);
namespace_release(left);
return node;
}
} else if (cmp > 0) {
PgfPhrasetable right = phrasetable_internalize(table->right, pseq);
if (right == table->right)
return table;
else {
PgfPhrasetable node = Node<PgfSequence>::balanceR(table->value, table->left, right);
phrasetable_release(right);
return node;
}
} else {
if (!(--(*pseq)->ref_count)) {
PgfSequence::release(*pseq);
}
Node<PgfSequence>::add_value_ref(table->value);
*pseq = table->value;
return table;
}
}
PGF_INTERNAL_DECL
ref<PgfSequence> phrasetable_get(PgfPhrasetable table, size_t seq_id)
{
while (table != 0) {
size_t left_sz = table->left->sz;
if (seq_id < left_sz)
table = table->left;
else if (seq_id == left_sz)
return table->value;
else {
table = table->right;
seq_id -= left_sz+1;
}
}
return 0;
}
PGF_INTERNAL
void phrasetable_iter(PgfPhrasetable table, PgfSequenceItor* itor, size_t *p_next_id, PgfExn *err)
{
if (table == 0)
return;
phrasetable_iter(table->left, itor, p_next_id, err);
if (err->type != PGF_EXN_NONE)
return;
table->value->seq_id = (*p_next_id)++;
itor->fn(itor, table->value.as_object(), err);
if (err->type != PGF_EXN_NONE)
return;
phrasetable_iter(table->right, itor, p_next_id, err);
if (err->type != PGF_EXN_NONE)
return;
}
PGF_INTERNAL
void phrasetable_release(PgfPhrasetable table)
{
namespace_release(table);
}

20
src/runtime/c/pgf/phrasetable.h Normal file
View File

@@ -0,0 +1,20 @@
#ifndef PHRASETABLE_H
#define PHRASETABLE_H
class PgfSequence;
class PgfSequenceItor;
typedef ref<Node<PgfSequence>> PgfPhrasetable;
PGF_INTERNAL_DECL
PgfPhrasetable phrasetable_internalize(PgfPhrasetable table, ref<PgfSequence> *seq);
PGF_INTERNAL_DECL
ref<PgfSequence> phrasetable_get(PgfPhrasetable table, size_t seq_id);
PGF_INTERNAL_DECL
void phrasetable_iter(PgfPhrasetable table, PgfSequenceItor* itor, size_t *p_next_id, PgfExn *err);
PGF_INTERNAL_DECL
void phrasetable_release(PgfPhrasetable table);
#endif

15
src/runtime/c/pgf/printer.cxx
View File

@@ -529,11 +529,11 @@ void PgfPrinter::symbol(PgfSymbol sym)
auto sym_kp = ref<PgfSymbolKP>::untagged(sym);
puts("pre {");
symbols(sym_kp->default_form);
sequence(sym_kp->default_form);
for (size_t i = 0; i < sym_kp->alts.len; i++) {
puts("; ");
symbols(sym_kp->alts.data[i].form);
sequence(sym_kp->alts.data[i].form);
puts(" /");
for (size_t j = 0; j < sym_kp->alts.data[i].prefixes->len; j++) {
puts(" ");
@@ -565,16 +565,21 @@ void PgfPrinter::symbol(PgfSymbol sym)
}
}
void PgfPrinter::symbols(ref<Vector<PgfSymbol>> syms)
void PgfPrinter::sequence(ref<PgfSequence> seq)
{
for (size_t i = 0; i < syms->len; i++) {
for (size_t i = 0; i < seq->syms.len; i++) {
if (i > 0)
puts(" ");
symbol(*vector_elem(syms, i));
symbol(*vector_elem(&seq->syms, i));
}
}
void PgfPrinter::seq_id(size_t seq_id)
{
nprintf(5, "S%zu", seq_id);
}
void PgfPrinter::free_ref(object x)
{
}

3
src/runtime/c/pgf/printer.h
View File

@@ -56,8 +56,9 @@ public:
void lvar(size_t var);
void lparam(ref<PgfLParam> lparam);
void lvar_ranges(ref<Vector<PgfVariableRange>> vars);
void seq_id(size_t seqid);
void symbol(PgfSymbol sym);
void symbols(ref<Vector<PgfSymbol>> syms);
void sequence(ref<PgfSequence> seq);
virtual PgfExpr eabs(PgfBindType btype, PgfText *name, PgfExpr body);
virtual PgfExpr eapp(PgfExpr fun, PgfExpr arg);

56
src/runtime/c/pgf/reader.cxx
View File

@@ -7,6 +7,7 @@ PgfReader::PgfReader(FILE *in)
{
this->in = in;
this->abstract = 0;
this->concrete = 0;
}
uint8_t PgfReader::read_uint8()
@@ -515,14 +516,14 @@ PgfSymbol PgfReader::read_symbol()
sym_kp->alts.len = n_alts;
for (size_t i = 0; i < n_alts; i++) {
auto form = read_vector(&PgfReader::read_symbol2);
auto form = read_seq();
auto prefixes = read_vector(&PgfReader::read_text2);
sym_kp->alts.data[i].form = form;
sym_kp->alts.data[i].prefixes = prefixes;
}
auto default_form = read_vector(&PgfReader::read_symbol2);
auto default_form = read_seq();
sym_kp->default_form = default_form;
sym = ref<PgfSymbolKP>::tagged(sym_kp);
@@ -559,6 +560,32 @@ PgfSymbol PgfReader::read_symbol()
return sym;
}
ref<PgfSequence> PgfReader::read_seq()
{
size_t n_syms = read_len();
ref<PgfSequence> seq = PgfDB::malloc<PgfSequence>(n_syms*sizeof(PgfSymbol));
seq->seq_id = 0;
seq->ref_count = 1;
seq->syms.len = n_syms;
for (size_t i = 0; i < n_syms; i++) {
PgfSymbol sym = read_symbol();
*vector_elem(&seq->syms,i) = sym;
}
return seq;
}
void PgfReader::read_seq_id(ref<ref<PgfSequence>> r)
{
size_t seq_id = read_len();
ref<PgfSequence> seq = phrasetable_get(concrete->phrasetable, seq_id);
if (seq == 0)
throw pgf_error("Invalid sequence id");
*r = seq;
}
ref<PgfConcrLincat> PgfReader::read_lincat()
{
ref<PgfConcrLincat> lincat = read_name(&PgfConcrLincat::name);
@@ -568,7 +595,7 @@ ref<PgfConcrLincat> PgfReader::read_lincat()
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);
lincat->seqs = read_vector(&PgfReader::read_seq_id);
return lincat;
}
@@ -579,7 +606,7 @@ ref<PgfConcrLin> PgfReader::read_lin()
lin->absfun = namespace_lookup(abstract->funs, &lin->name);
lin->args = read_vector(&PgfReader::read_parg);
lin->res = read_vector(&PgfReader::read_presult2);
lin->seqs = read_vector(&PgfReader::read_seq2);
lin->seqs = read_vector(&PgfReader::read_seq_id);
return lin;
}
@@ -593,16 +620,17 @@ ref<PgfConcrPrintname> PgfReader::read_printname()
ref<PgfConcr> PgfReader::read_concrete()
{
ref<PgfConcr> concr = read_name(&PgfConcr::name);
concr->ref_count = 1;
concr->ref_count_ex = 0;
concr->cflags = read_namespace<PgfFlag>(&PgfReader::read_flag);
concr->lincats = read_namespace<PgfConcrLincat>(&PgfReader::read_lincat);
concr->lins = read_namespace<PgfConcrLin>(&PgfReader::read_lin);
concr->printnames = read_namespace<PgfConcrPrintname>(&PgfReader::read_printname);
concr->prev = 0;
concr->next = 0;
return concr;
concrete = read_name(&PgfConcr::name);
concrete->ref_count = 1;
concrete->ref_count_ex = 0;
concrete->cflags = read_namespace<PgfFlag>(&PgfReader::read_flag);
concrete->phrasetable = read_namespace<PgfSequence>(&PgfReader::read_seq);
concrete->lincats = read_namespace<PgfConcrLincat>(&PgfReader::read_lincat);
concrete->lins = read_namespace<PgfConcrLin>(&PgfReader::read_lin);
concrete->printnames = read_namespace<PgfConcrPrintname>(&PgfReader::read_printname);
concrete->prev = 0;
concrete->next = 0;
return concrete;
}
ref<PgfPGF> PgfReader::read_pgf()

9
src/runtime/c/pgf/reader.h
View File

@@ -73,6 +73,8 @@ public:
void read_parg(ref<PgfPArg> parg);
ref<PgfPResult> read_presult();
PgfSymbol read_symbol();
ref<PgfSequence> read_seq();
void read_seq_id(ref<ref<PgfSequence>> r);
ref<PgfConcrLin> read_lin();
ref<PgfConcrPrintname> read_printname();
@@ -84,14 +86,13 @@ public:
private:
FILE *in;
ref<PgfAbstr> abstract;
ref<PgfConcr> concrete;
object read_name_internal(size_t struct_size);
object read_text_internal(size_t struct_size);
void read_text2(ref<ref<PgfText>> r) { auto text = read_text(); *r = text; };
void read_lparam(ref<ref<PgfLParam>> r) { auto lparam = read_lparam(); *r = lparam; };
void read_symbol2(ref<PgfSymbol> r) { auto sym = read_symbol(); *r = sym; };
void read_seq2(ref<ref<Vector<PgfSymbol>>> r) { auto seq = read_vector(&PgfReader::read_symbol2); *r = seq; }
void read_text2(ref<ref<PgfText>> r) { auto text = read_text(); *r = text; }
void read_lparam(ref<ref<PgfLParam>> r) { auto lparam = read_lparam(); *r = lparam; }
void read_presult2(ref<ref<PgfPResult>> r) { auto res = read_presult(); *r = res; }
template<class I>

48
src/runtime/c/pgf/text.cxx
View File

@@ -5,7 +5,7 @@ int textcmp(PgfText *t1, PgfText *t2)
{
for (size_t i = 0; ; i++) {
if (i >= t1->size)
return (i - t2->size);
return -(i < t2->size);
if (i >= t2->size)
return 1;
@@ -16,6 +16,48 @@ int textcmp(PgfText *t1, PgfText *t2)
}
}
PGF_INTERNAL
void texticmp(PgfText *t1, PgfText *t2, int res[2])
{
const uint8_t *s1 = (uint8_t*) &t1->text;
const uint8_t *e1 = s1+t1->size;
const uint8_t *s2 = (uint8_t*) &t2->text;
const uint8_t *e2 = s2+t2->size;
for (;;) {
if (s1 >= e1) {
res[0] = (res[1] = -(s2 < e2));
return;
}
if (s2 >= e2) {
res[0] = (res[1] = 1);
return;
}
uint32_t ucs1 = pgf_utf8_decode(&s1);
uint32_t ucs1i = pgf_utf8_to_upper(ucs1);
uint32_t ucs2 = pgf_utf8_decode(&s2);
uint32_t ucs2i = pgf_utf8_to_upper(ucs2);
if (ucs1i > ucs2i) {
res[0] = (res[1] = 1);
return;
}
else if (ucs1i < ucs2i) {
res[0] = (res[1] = -1);
return;
}
else if (res[1] == 0) {
if (ucs1 > ucs2)
res[1] = 1;
else if (ucs1 < ucs2)
res[1] = -1;
}
}
}
PGF_INTERNAL
bool textstarts(PgfText *t, PgfText *prefix)
{
@@ -49,7 +91,7 @@ ref<PgfText> textdup_db(PgfText *t1)
}
PGF_API uint32_t
pgf_utf8_decode(const uint8_t** src_inout)
pgf_utf8_decode(const uint8_t **src_inout)
{
const uint8_t* src = *src_inout;
uint8_t c = src[0];
@@ -74,7 +116,7 @@ pgf_utf8_decode(const uint8_t** src_inout)
}
PGF_API void
pgf_utf8_encode(uint32_t ucs, uint8_t** buf)
pgf_utf8_encode(uint32_t ucs, uint8_t **buf)
{
uint8_t* p = *buf;
if (ucs < 0x80) {

10
src/runtime/c/pgf/text.h
View File

@@ -1,9 +1,19 @@
#ifndef TEXT_H
#define TEXT_H
/* Case sensitive comparison */
PGF_INTERNAL_DECL
int textcmp(PgfText *t1, PgfText *t2);
/* Performs both case-insensitive and case-sensitive comparison.
* The first element in res contains the result from
* the case-insensitive comparison. The second the result
* from case-sensitive one. Usually res must be initialized
* with {0,0}. If it is not then that can be used
* to chain a list of comparisons.*/
PGF_INTERNAL_DECL
void texticmp(PgfText *t1, PgfText *t2, int res[2]);
PGF_INTERNAL_DECL
bool textstarts(PgfText *t, PgfText *prefix);

6
src/runtime/c/pgf/vector.h
View File

@@ -30,4 +30,10 @@ ref<A> vector_elem(ref<Vector<A>> v, size_t index)
return ref<A>::from_ptr(&v->data[index]);
}
template <class A> inline
A *vector_elem(Vector<A> *v, size_t index)
{
return &v->data[index];
}
#endif // VECTOR_H

21
src/runtime/c/pgf/writer.cxx
View File

@@ -135,7 +135,7 @@ void PgfWriter::write_text(PgfText *text)
template<class V>
void PgfWriter::write_namespace(Namespace<V> nmsp, void (PgfWriter::*write_value)(ref<V>))
{
write_len(nmsp->sz);
write_len(namespace_size(nmsp));
write_namespace_helper(nmsp, write_value);
}
@@ -393,10 +393,11 @@ void PgfWriter::write_symbol(PgfSymbol sym)
auto sym_kp = ref<PgfSymbolKP>::untagged(sym);
write_len(sym_kp->alts.len);
for (size_t i = 0; i < sym_kp->alts.len; i++) {
write_seq(sym_kp->alts.data[i].form);
write_vector(sym_kp->alts.data[i].prefixes, &PgfWriter::write_text);
PgfAlternative *alt = vector_elem(&sym_kp->alts, i);
write_vector(ref<Vector<PgfSymbol>>::from_ptr(&alt->form->syms), &PgfWriter::write_symbol);
write_vector(alt->prefixes, &PgfWriter::write_text);
}
write_seq(sym_kp->default_form);
write_vector(ref<Vector<PgfSymbol>>::from_ptr(&sym_kp->default_form->syms), &PgfWriter::write_symbol);
break;
}
case PgfSymbolBIND::tag:
@@ -411,9 +412,10 @@ void PgfWriter::write_symbol(PgfSymbol sym)
}
}
void PgfWriter::write_seq(ref<Vector<PgfSymbol>> seq)
void PgfWriter::write_seq(ref<PgfSequence> seq)
{
write_vector(seq, &PgfWriter::write_symbol);
seq->seq_id = next_seq_id++;
write_vector(ref<Vector<PgfSymbol>>::from_ptr(&seq->syms), &PgfWriter::write_symbol);
}
void PgfWriter::write_lincat(ref<PgfConcrLincat> lincat)
@@ -423,7 +425,7 @@ void PgfWriter::write_lincat(ref<PgfConcrLincat> lincat)
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);
write_vector(lincat->seqs, &PgfWriter::write_seq_id);
}
void PgfWriter::write_lin(ref<PgfConcrLin> lin)
@@ -431,7 +433,7 @@ void PgfWriter::write_lin(ref<PgfConcrLin> lin)
write_name(&lin->name);
write_vector(lin->args, &PgfWriter::write_parg);
write_vector(lin->res, &PgfWriter::write_presult);
write_vector(lin->seqs, &PgfWriter::write_seq);
write_vector(lin->seqs, &PgfWriter::write_seq_id);
}
void PgfWriter::write_printname(ref<PgfConcrPrintname> printname)
@@ -442,8 +444,11 @@ void PgfWriter::write_printname(ref<PgfConcrPrintname> printname)
void PgfWriter::write_concrete(ref<PgfConcr> concr)
{
next_seq_id = 0;
write_name(&concr->name);
write_namespace<PgfFlag>(concr->cflags, &PgfWriter::write_flag);
write_namespace<PgfSequence>(concr->phrasetable, &PgfWriter::write_seq);
write_namespace<PgfConcrLincat>(concr->lincats, &PgfWriter::write_lincat);
write_namespace<PgfConcrLin>(concr->lins, &PgfWriter::write_lin);
write_namespace<PgfConcrPrintname>(concr->printnames, &PgfWriter::write_printname);

6
src/runtime/c/pgf/writer.h
View File

@@ -44,7 +44,8 @@ public:
void write_parg(ref<PgfPArg> linarg);
void write_presult(ref<PgfPResult> linres);
void write_symbol(PgfSymbol sym);
void write_seq(ref<Vector<PgfSymbol>> seq);
void write_seq(ref<PgfSequence> seq);
void write_seq_id(ref<ref<PgfSequence>> r) { write_len((*r)->seq_id); };
void write_lin(ref<PgfConcrLin> lin);
void write_printname(ref<PgfConcrPrintname> printname);
@@ -58,10 +59,11 @@ private:
void write_text(ref<ref<PgfText>> r) { write_text(&(**r)); };
void write_lparam(ref<ref<PgfLParam>> r) { write_lparam(*r); };
void write_seq(ref<ref<Vector<PgfSymbol>>> r) { write_seq(*r); };
void write_symbol(ref<PgfSymbol> r) { write_symbol(*r); };
void write_presult(ref<ref<PgfPResult>> r) { write_presult(*r); };
size_t next_seq_id;
FILE *out;
ref<PgfAbstr> abstract;
};

76
src/runtime/haskell/PGF2.hsc
View File

@@ -222,11 +222,15 @@ showPGF p =
def <- bracket (pgf_print_function_internal val) free peekText
modifyIORef ref (\doc -> doc $$ text def)
ppConcr name c =
text "concrete" <+> text name <+> char '{' $$
nest 2 (ppLincats c $$
ppLins c) $$
char '}'
ppConcr name c = unsafePerformIO $ do
doc <- prepareSequences c -- run first to update all seq_id
return (text "concrete" <+> text name <+> char '{' $$
nest 2 (ppLincats c $$
ppLins c $$
(text "sequences" <+> char '{' $$
nest 2 doc $$
char '}')) $$
char '}')
ppLincats c = unsafePerformIO $ do
ref <- newIORef empty
@@ -248,32 +252,20 @@ showPGF p =
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
fields <- 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
def <- bracket (pgf_print_lindef_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)
modifyIORef ref (\doc -> doc $$ text "lindef" <+> def)
forM_ (init [0..n_linrefs]) $ \i -> do
sig <- bracket (pgf_print_linref_sig_internal val i) free $ \c_text -> do
def <- bracket (pgf_print_linref_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)
modifyIORef ref $ (\doc -> doc $$ text "linref" <+> def)
ppLins c = unsafePerformIO $ do
ref <- newIORef empty
@@ -285,22 +277,28 @@ showPGF p =
readIORef ref
where
getLins :: IORef Doc -> ItorCallback
getLins ref itor key val exn =
allocaBytes (2*(#size size_t)) $ \pcounts -> do
pgf_get_lin_counts_internal val pcounts
n_prods <- peekElemOff pcounts 0
n_seqs <- peekElemOff pcounts 1
forM_ (init [0..n_prods]) $ \i -> do
sig <- bracket (pgf_print_lin_sig_internal val i) free $ \c_text -> do
fmap text (peekText c_text)
syms <- forM (init [0..n_seqs]) $ \j ->
bracket (pgf_print_lin_seq_internal val i j) free $ \c_text -> do
fmap text (peekText c_text)
let def = text "lin" <+> (sig <+> char '=' <+> char '[' $$
nest 2 (vcat syms) $$
char ']')
modifyIORef ref $ (\doc -> doc $$ def)
return ()
getLins ref itor key val exn = do
n_prods <- pgf_get_lin_get_prod_count val
forM_ (init [0..n_prods]) $ \i -> do
def <- bracket (pgf_print_lin_internal val i) free $ \c_text -> do
fmap text (peekText c_text)
modifyIORef ref (\doc -> doc $$ text "lin" <+> def)
return ()
prepareSequences c = do
ref <- newIORef empty
(allocaBytes (#size PgfSequenceItor) $ \itor ->
bracket (wrapSequenceItorCallback (getSequences ref)) freeHaskellFunPtr $ \fptr ->
withForeignPtr (c_revision c) $ \c_revision -> do
(#poke PgfSequenceItor, fn) itor fptr
withPgfExn "showPGF" (pgf_iter_sequences (a_db p) c_revision itor))
readIORef ref
where
getSequences :: IORef Doc -> SequenceItorCallback
getSequences ref itor val exn = do
def <- bracket (pgf_print_sequence_internal val) free $ \c_text -> do
fmap text (peekText c_text)
modifyIORef ref $ (\doc -> doc $$ def)
-- | The abstract language name is the name of the top-level
-- abstract module

23
src/runtime/haskell/PGF2/FFI.hsc
View File

@@ -45,6 +45,7 @@ data PgfBuildLinIface
data PgfLinBuilderIface
data PgfLinearizationOutputIface
data PgfGraphvizOptions
data PgfSequenceItor
type Wrapper a = a -> IO (FunPtr a)
type Dynamic a = FunPtr a -> a
@@ -110,23 +111,25 @@ foreign import ccall pgf_iter_lincats :: Ptr PgfDB -> Ptr Concr -> Ptr PgfItor -
foreign import ccall pgf_iter_lins :: Ptr PgfDB -> Ptr Concr -> Ptr PgfItor -> Ptr PgfExn -> IO ()
type SequenceItorCallback = Ptr PgfSequenceItor -> Ptr () -> Ptr PgfExn -> IO ()
foreign import ccall "wrapper" wrapSequenceItorCallback :: Wrapper SequenceItorCallback
foreign import ccall pgf_iter_sequences :: Ptr PgfDB -> Ptr Concr -> Ptr PgfSequenceItor -> Ptr PgfExn -> IO ()
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_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_internal :: Ptr () -> CSize -> IO (Ptr PgfText)
foreign import ccall pgf_print_linref_sig_internal :: Ptr () -> CSize -> IO (Ptr PgfText)
foreign import ccall pgf_get_lin_get_prod_count :: Ptr () -> IO CSize
foreign import ccall pgf_print_linref_seq_internal :: Ptr () -> CSize -> IO (Ptr PgfText)
foreign import ccall pgf_print_lin_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)
foreign import ccall pgf_print_lin_seq_internal :: Ptr () -> CSize -> CSize -> IO (Ptr PgfText)
foreign import ccall pgf_print_sequence_internal :: Ptr () -> IO (Ptr PgfText)
type ItorCallback = Ptr PgfItor -> Ptr PgfText -> Ptr () -> Ptr PgfExn -> IO ()
@@ -200,6 +203,8 @@ 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 "dynamic" callLinBuilder7 :: Dynamic (Ptr PgfLinBuilderIface -> Ptr PgfExn -> IO CSize)
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 ()

63
src/runtime/haskell/PGF2/Transactions.hsc
View File

@@ -13,7 +13,7 @@ module PGF2.Transactions
, setAbstractFlag
-- concrete syntax
, Token, LIndex, LVar, LParam(..)
, Token, SeqId, LIndex, LIndex, LVar, LParam(..)
, PArg(..), Symbol(..), Production(..)
, createConcrete
@@ -21,6 +21,7 @@ module PGF2.Transactions
, dropConcrete
, mergePGF
, setConcreteFlag
, SeqTable
, createLincat
, dropLincat
, createLin
@@ -35,6 +36,8 @@ import PGF2.ByteCode
import Foreign
import Foreign.C
import Control.Exception
import qualified Data.Sequence as Seq
import Data.IORef
#include <pgf/pgf.h>
@@ -197,10 +200,11 @@ setConcreteFlag name value = Transaction $ \c_db _ c_revision c_exn ->
type Token = String
type SeqId = Int
type LIndex = Int
type LVar = Int
data LParam = LParam {-# UNPACK #-} !LIndex [(LIndex,LVar)]
deriving (Eq,Show)
deriving (Eq,Ord,Show)
data Symbol
= SymCat {-# UNPACK #-} !Int {-# UNPACK #-} !LParam
@@ -214,21 +218,23 @@ data Symbol
| SymSOFT_SPACE -- the special SOFT_SPACE token
| SymCAPIT -- the special CAPIT token
| SymALL_CAPIT -- the special ALL_CAPIT token
deriving (Eq,Show)
deriving (Eq,Ord,Show)
data PArg = PArg [(LIndex,LIndex)] {-# UNPACK #-} !LParam
deriving (Eq,Show)
data Production = Production [(LVar,LIndex)] [PArg] LParam [[Symbol]]
data Production = Production [(LVar,LIndex)] [PArg] LParam [SeqId]
deriving (Eq,Show)
createLincat :: Cat -> [String] -> [Production] -> [Production] -> Transaction Concr ()
createLincat name fields lindefs linrefs = Transaction $ \c_db c_abstr c_revision c_exn ->
type SeqTable = Seq.Seq (Either [Symbol] SeqId)
createLincat :: Cat -> [String] -> [Production] -> [Production] -> SeqTable -> Transaction Concr SeqTable
createLincat name fields lindefs linrefs seqtbl = 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 $
withBuildLinIface (lindefs++linrefs) $ \c_build ->
withBuildLinIface (lindefs++linrefs) seqtbl $ \c_build ->
pgf_create_lincat c_db c_abstr c_revision c_name
(fromIntegral n_fields) c_fields
(fromIntegral (length lindefs)) (fromIntegral (length linrefs))
@@ -245,19 +251,21 @@ dropLincat name = Transaction $ \c_db _ c_revision c_exn ->
withText name $ \c_name ->
pgf_drop_lincat c_db c_revision c_name c_exn
createLin :: Fun -> [Production] -> Transaction Concr ()
createLin name prods = Transaction $ \c_db c_abstr c_revision c_exn ->
createLin :: Fun -> [Production] -> SeqTable -> Transaction Concr SeqTable
createLin name prods seqtbl = Transaction $ \c_db c_abstr c_revision c_exn ->
withText name $ \c_name ->
withBuildLinIface prods $ \c_build ->
withBuildLinIface prods seqtbl $ \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
f c_build
withBuildLinIface prods seqtbl f = do
ref <- newIORef seqtbl
(allocaBytes (#size PgfBuildLinIface) $ \c_build ->
allocaBytes (#size PgfBuildLinIfaceVtbl) $ \vtbl ->
bracket (wrapLinBuild (build ref)) freeHaskellFunPtr $ \c_callback -> do
(#poke PgfBuildLinIface, vtbl) c_build vtbl
(#poke PgfBuildLinIfaceVtbl, build) vtbl c_callback
f c_build)
readIORef ref
where
forM_ [] c_exn f = return ()
forM_ (x:xs) c_exn f = do
@@ -266,9 +274,9 @@ withBuildLinIface prods f =
then f x >> forM_ xs c_exn f
else return ()
build _ c_builder c_exn = do
build ref _ c_builder c_exn = do
vtbl <- (#peek PgfLinBuilderIface, vtbl) c_builder
forM_ prods c_exn $ \(Production vars args res seqs) -> do
forM_ prods c_exn $ \(Production vars args res seqids) -> do
fun <- (#peek PgfLinBuilderIfaceVtbl, start_production) vtbl
callLinBuilder0 fun c_builder c_exn
fun <- (#peek PgfLinBuilderIfaceVtbl, add_argument) vtbl
@@ -279,12 +287,17 @@ withBuildLinIface prods f =
fun <- (#peek PgfLinBuilderIfaceVtbl, add_variable) vtbl
forM_ vars c_exn $ \(v,r) ->
callLinBuilder2 fun c_builder (fromIntegral v) (fromIntegral r) c_exn
forM_ seqs c_exn $ \syms -> do
fun <- (#peek PgfLinBuilderIfaceVtbl, start_sequence) vtbl
callLinBuilder1 fun c_builder (fromIntegral (length syms)) c_exn
forM_ syms c_exn (addSymbol c_builder vtbl c_exn)
fun <- (#peek PgfLinBuilderIfaceVtbl, end_sequence) vtbl
callLinBuilder0 fun c_builder c_exn
fun <- (#peek PgfLinBuilderIfaceVtbl, add_sequence_id) vtbl
seqtbl <- readIORef ref
forM_ seqids c_exn $ \seqid ->
case Seq.index seqtbl seqid of
Left syms -> do fun <- (#peek PgfLinBuilderIfaceVtbl, start_sequence) vtbl
callLinBuilder1 fun c_builder (fromIntegral (length syms)) c_exn
forM_ syms c_exn (addSymbol c_builder vtbl c_exn)
fun <- (#peek PgfLinBuilderIfaceVtbl, end_sequence) vtbl
seqid' <- callLinBuilder7 fun c_builder c_exn
writeIORef ref $! Seq.update seqid (Right (fromIntegral seqid')) seqtbl
Right seqid -> do callLinBuilder1 fun c_builder (fromIntegral seqid) c_exn
fun <- (#peek PgfLinBuilderIfaceVtbl, end_production) vtbl
callLinBuilder0 fun c_builder c_exn