mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-24 03:52:50 -06:00
now if some module is compiled with -no-pmcfg then the PMCFG code is generated at the end during the linking phase. Now the default compilation of the libraries with cabal is with -no-pmcfg.
This commit is contained in:
2
Setup.hs
2
Setup.hs
@@ -254,7 +254,7 @@ gfc1 mode pkg lbi file = do
|
|||||||
Minimal -> "-preproc="++({-rgl_src_dir </>-} "mkMinimal")
|
Minimal -> "-preproc="++({-rgl_src_dir </>-} "mkMinimal")
|
||||||
createDirectoryIfMissing True dir
|
createDirectoryIfMissing True dir
|
||||||
putStrLn $ "Compiling [" ++ show mode ++ "] " ++ file
|
putStrLn $ "Compiling [" ++ show mode ++ "] " ++ file
|
||||||
run_gfc pkg lbi ["-s", preproc, "--gfo-dir="++dir, file]
|
run_gfc pkg lbi ["-s", "-no-pmcfg", preproc, "--gfo-dir="++dir, file]
|
||||||
|
|
||||||
gf comm files pkg lbi = do
|
gf comm files pkg lbi = do
|
||||||
putStrLn $ "Reading " ++ unwords files
|
putStrLn $ "Reading " ++ unwords files
|
||||||
|
|||||||
@@ -10,7 +10,7 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
|
|
||||||
module GF.Compile.GeneratePMCFG
|
module GF.Compile.GeneratePMCFG
|
||||||
(generatePMCFG, pgfCncCat
|
(generatePMCFG, pgfCncCat, addPMCFG
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import PGF.CId
|
import PGF.CId
|
||||||
@@ -65,7 +65,7 @@ mapAccumWithKeyM f a m = do let xs = Map.toAscList m
|
|||||||
|
|
||||||
|
|
||||||
addPMCFG :: Options -> SourceGrammar -> Ident -> Ident -> SeqSet -> Ident -> Info -> IO (SeqSet, Info)
|
addPMCFG :: Options -> SourceGrammar -> Ident -> Ident -> SeqSet -> Ident -> Info -> IO (SeqSet, Info)
|
||||||
addPMCFG opts gr am cm seqs id (GF.Grammar.CncFun mty@(Just (cat,cont,val)) mlin@(Just (L _ term)) mprn _) = do
|
addPMCFG opts gr am cm seqs id (GF.Grammar.CncFun mty@(Just (cat,cont,val)) mlin@(Just (L _ term)) mprn Nothing) = do
|
||||||
let pres = protoFCat gr res val
|
let pres = protoFCat gr res val
|
||||||
pargs = [protoFCat gr (snd $ catSkeleton ty) lincat | ((_,_,ty),(_,_,lincat)) <- zip ctxt cont]
|
pargs = [protoFCat gr (snd $ catSkeleton ty) lincat | ((_,_,ty),(_,_,lincat)) <- zip ctxt cont]
|
||||||
|
|
||||||
@@ -98,7 +98,7 @@ addPMCFG opts gr am cm seqs id (GF.Grammar.CncFun mty@(Just (cat,cont,val)) mlin
|
|||||||
newArgs = map getFIds newArgs'
|
newArgs = map getFIds newArgs'
|
||||||
in addFunction env0 newCat fun newArgs
|
in addFunction env0 newCat fun newArgs
|
||||||
|
|
||||||
addPMCFG opts gr am cm seqs id (GF.Grammar.CncCat mty@(Just (L _ lincat)) mdef@(Just (L _ term)) mprn _) = do
|
addPMCFG opts gr am cm seqs id (GF.Grammar.CncCat mty@(Just (L _ lincat)) mdef@(Just (L _ term)) mprn Nothing) = do
|
||||||
let pres = protoFCat gr (am,id) lincat
|
let pres = protoFCat gr (am,id) lincat
|
||||||
parg = protoFCat gr (identW,cVar) typeStr
|
parg = protoFCat gr (identW,cVar) typeStr
|
||||||
|
|
||||||
|
|||||||
@@ -63,6 +63,21 @@ mkCanon2pgf opts gr am = do
|
|||||||
[(loc,i2i f) | ((m,f),AbsFun (Just (L loc ty)) _ _ (Just True)) <- adefs, snd (GM.valCat ty) == cat]
|
[(loc,i2i f) | ((m,f),AbsFun (Just (L loc ty)) _ _ (Just True)) <- adefs, snd (GM.valCat ty) == cat]
|
||||||
|
|
||||||
mkConcr gr cm = do
|
mkConcr gr cm = do
|
||||||
|
let cflags = concatOptions [mflags mo | (i,mo) <- modules gr, isModCnc mo,
|
||||||
|
Just r <- [lookup i (allExtendSpecs gr cm)]]
|
||||||
|
|
||||||
|
(seqs,cdefs) <- addMissingPMCFGs
|
||||||
|
Map.empty
|
||||||
|
([((cPredefAbs,c), CncCat (Just (L NoLoc GM.defLinType)) Nothing Nothing Nothing) | c <- [cInt,cFloat,cString]] ++
|
||||||
|
Look.allOrigInfos gr cm)
|
||||||
|
|
||||||
|
let flags = Map.fromList [(mkCId f,C.LStr x) | (f,x) <- optionsPGF cflags]
|
||||||
|
|
||||||
|
!(!fid_cnt1,!cnccats) = genCncCats gr am cm cdefs
|
||||||
|
!(!fid_cnt2,!productions,!lindefs,!sequences,!cncfuns)
|
||||||
|
= genCncFuns gr am cm seqs cdefs fid_cnt1 cnccats
|
||||||
|
|
||||||
|
printnames = genPrintNames cdefs
|
||||||
return (i2i cm, D.Concr flags
|
return (i2i cm, D.Concr flags
|
||||||
printnames
|
printnames
|
||||||
cncfuns
|
cncfuns
|
||||||
@@ -75,19 +90,13 @@ mkCanon2pgf opts gr am = do
|
|||||||
IntMap.empty
|
IntMap.empty
|
||||||
fid_cnt2)
|
fid_cnt2)
|
||||||
where
|
where
|
||||||
cflags = concatOptions [mflags mo | (i,mo) <- modules gr, isModCnc mo,
|
-- if some module was compiled with -no-pmcfg, then
|
||||||
Just r <- [lookup i (allExtendSpecs gr cm)]]
|
-- we have to create the PMCFG code just before linking
|
||||||
|
addMissingPMCFGs seqs [] = return (seqs,[])
|
||||||
cdefs = [((cPredefAbs,c), CncCat (Just (L NoLoc GM.defLinType)) Nothing Nothing Nothing) | c <- [cInt,cFloat,cString]] ++
|
addMissingPMCFGs seqs (((m,id), info):is) = do
|
||||||
Look.allOrigInfos gr cm
|
(seqs,info) <- addPMCFG opts gr am cm seqs id info
|
||||||
|
(seqs,is ) <- addMissingPMCFGs seqs is
|
||||||
flags = Map.fromList [(mkCId f,C.LStr x) | (f,x) <- optionsPGF cflags]
|
return (seqs, ((m,id), info) : is)
|
||||||
|
|
||||||
!(!fid_cnt1,!cnccats) = genCncCats gr am cm cdefs
|
|
||||||
!(!fid_cnt2,!productions,!lindefs,!sequences,!cncfuns)
|
|
||||||
= genCncFuns gr am cm cdefs fid_cnt1 cnccats
|
|
||||||
|
|
||||||
printnames = genPrintNames cdefs
|
|
||||||
|
|
||||||
i2i :: Ident -> CId
|
i2i :: Ident -> CId
|
||||||
i2i = CId . ident2bs
|
i2i = CId . ident2bs
|
||||||
@@ -185,8 +194,8 @@ genCncCats gr am cm cdefs =
|
|||||||
mkCncCats index (_ :cdefs) = mkCncCats index cdefs
|
mkCncCats index (_ :cdefs) = mkCncCats index cdefs
|
||||||
|
|
||||||
|
|
||||||
genCncFuns gr am cm cdefs fid_cnt cnccats =
|
genCncFuns gr am cm seqs0 cdefs fid_cnt cnccats =
|
||||||
let (fid_cnt1,funs_cnt1,seqs1,funs1,lindefs) = mkCncCats cdefs fid_cnt 0 Map.empty [] IntMap.empty
|
let (fid_cnt1,funs_cnt1,seqs1,funs1,lindefs) = mkCncCats cdefs fid_cnt 0 seqs0 [] IntMap.empty
|
||||||
(fid_cnt2,funs_cnt2,seqs2,funs2,prods) = mkCncFuns cdefs fid_cnt1 funs_cnt1 seqs1 funs1 lindefs Map.empty IntMap.empty
|
(fid_cnt2,funs_cnt2,seqs2,funs2,prods) = mkCncFuns cdefs fid_cnt1 funs_cnt1 seqs1 funs1 lindefs Map.empty IntMap.empty
|
||||||
in (fid_cnt2,prods,lindefs,mkSetArray seqs2,array (0,funs_cnt2-1) funs2)
|
in (fid_cnt2,prods,lindefs,mkSetArray seqs2,array (0,funs_cnt2-1) funs2)
|
||||||
where
|
where
|
||||||
@@ -256,9 +265,12 @@ genCncFuns gr am cm cdefs fid_cnt cnccats =
|
|||||||
Nothing -> error "GrammarToPGF.mkCtxt failed"
|
Nothing -> error "GrammarToPGF.mkCtxt failed"
|
||||||
|
|
||||||
toCncFun offs (m,id) (seqs,funs) (funid0,lins0) =
|
toCncFun offs (m,id) (seqs,funs) (funid0,lins0) =
|
||||||
let Ok (ModInfo{mseqs=Just mseqs}) = lookupModule gr m
|
case lookupModule gr m of
|
||||||
!(!seqs',lins) = mapAccumL (mkLin mseqs) seqs (elems lins0)
|
Ok (ModInfo{mseqs=Just mseqs}) -> let !(!seqs',lins) = mapAccumL (mkLin mseqs) seqs (elems lins0)
|
||||||
in (seqs',(offs+funid0,C.CncFun (i2i id) (mkArray lins)):funs)
|
in (seqs',(offs+funid0,C.CncFun (i2i id) (mkArray lins)):funs)
|
||||||
|
_ -> -- this function should have been compiled during the linking phase
|
||||||
|
-- so its sequences must be in seqs already
|
||||||
|
(seqs,(offs+funid0,C.CncFun (i2i id) lins0):funs)
|
||||||
where
|
where
|
||||||
mkLin mseqs seqs seqid =
|
mkLin mseqs seqs seqid =
|
||||||
let seq = mseqs ! seqid
|
let seq = mseqs ! seqid
|
||||||
|
|||||||
Reference in New Issue
Block a user