msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

fix the handling of separators in BNFC which are not nonempty

Browse Source
This commit is contained in:
krasimir
2016-03-22 13:13:35 +00:00
parent 4fb187b49c
commit 3e8ec361d8
4 changed files with 23 additions and 17 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
src/compiler/GF/Command/Importing.hs
View File

@@ -56,7 +56,7 @@ importCF opts files get convert = impCF
startCat <- case rules of
(Rule cat _ _ : _) -> return cat
_ -> fail "empty CFG"
let pgf = cf2pgf (last files) (uniqueFuns (mkCFG startCat Set.empty rules))
let pgf = cf2pgf (last files) (mkCFG startCat Set.empty rules)
probs <- maybe (return . defaultProbabilities) readProbabilitiesFromFile (flag optProbsFile opts) pgf
return $ setProbabilities probs
$ if flag optOptimizePGF opts then optimizePGF pgf else pgf

2
src/compiler/GF/Compiler.hs
View File

@@ -91,7 +91,7 @@ compileCFFiles opts fs = do
startCat <- case rules of
(Rule cat _ _ : _) -> return cat
_ -> fail "empty CFG"
let pgf = cf2pgf (last fs) (uniqueFuns (mkCFG startCat Set.empty rules))
let pgf = cf2pgf (last fs) (mkCFG startCat Set.empty rules)
unless (flag optStopAfterPhase opts == Compile) $
do probs <- liftIO (maybe (return . defaultProbabilities) readProbabilitiesFromFile (flag optProbsFile opts) pgf)
let pgf' = setProbabilities probs $ if flag optOptimizePGF opts then optimizePGF pgf else pgf

26
src/compiler/GF/Grammar/BNFC.hs
View File

@@ -55,7 +55,7 @@ isSepTerm _ = False
transformRules :: SepMap -> BNFCRule -> [ParamCFRule]
transformRules sepMap (BNFCRule c smbs@(s:ss) r) = Rule (c,[0]) cfSmbs r : rls
where smbs' = map transformSymb smbs
where smbs' = map (transformSymb sepMap) smbs
cfSmbs = [snd s | s <- smbs']
ids = filter (/= "") [fst s | s <- smbs']
rls = concatMap (createListRules sepMap) ids
@@ -71,10 +71,14 @@ fRules c n = Rule (c',[0]) ss rn
ss = [NonTerminal (c ++ show (n+1),[0])]
rn = CFObj (mkCId $ "coercion_" ++ c') []
transformSymb :: BNFCSymbol -> (String, ParamCFSymbol)
transformSymb s = case s of
transformSymb :: SepMap -> BNFCSymbol -> (String, ParamCFSymbol)
transformSymb sepMap s = case s of
NonTerminal (c,False) -> ("", NonTerminal (c,[0]))
NonTerminal (c,True ) -> (c , NonTerminal $ ("List" ++ c,[0]))
NonTerminal (c,True ) -> let needsCoercion =
case lookup c sepMap of
Just (ne, isSep, symb) -> isSep && symb /= "" && not ne
Nothing -> False
in (c , NonTerminal ("List" ++ c,if needsCoercion then [0,1] else [0]))
Terminal t -> ("", Terminal t)
createListRules :: SepMap -> String -> [ParamCFRule]
@@ -84,15 +88,23 @@ createListRules sepMap c =
Nothing -> createListRules' False True "" c
createListRules':: IsNonempty -> IsSeparator -> SepTermSymb -> String -> [ParamCFRule]
createListRules' ne isSep symb c = ruleCons : [ruleBase]
createListRules' ne isSep symb c = ruleBase : ruleCons
where ruleBase = Rule ("List" ++ c,[0]) smbs rn
where smbs = if isSep
then [NonTerminal (c,[0]) | ne]
else [NonTerminal (c,[0]) | ne] ++
[Terminal symb | symb /= "" && ne]
rn = CFObj (mkCId $ "Base" ++ c) []
ruleCons = Rule ("List" ++ c,[0]) smbs rn
where smbs = [NonTerminal (c,[0])] ++
ruleCons
| isSep && symb /= "" && not ne = [Rule ("List" ++ c,[1]) smbs0 rn
,Rule ("List" ++ c,[1]) smbs1 rn]
| otherwise = [Rule ("List" ++ c,[0]) smbs rn]
where smbs0 =[NonTerminal (c,[0])] ++
[NonTerminal ("List" ++ c,[0])]
smbs1 =[NonTerminal (c,[0])] ++
[Terminal symb] ++
[NonTerminal ("List" ++ c,[1])]
smbs = [NonTerminal (c,[0])] ++
[Terminal symb | symb /= ""] ++
[NonTerminal ("List" ++ c,[0])]
rn = CFObj (mkCId $ "Cons" ++ c) []

10
src/compiler/GF/Grammar/CFG.hs
View File

@@ -226,15 +226,9 @@ mkCFG start ext rs = Grammar { cfgStartCat = start, cfgExternalCats = ext, cfgRu
groupProds :: (Ord c,Ord t) => [Rule c t] -> Map c (Set (Rule c t))
groupProds = Map.fromListWith Set.union . map (\r -> (ruleLhs r,Set.singleton r))
uniqueFuns :: (Ord c,Ord t) => Grammar c t -> Grammar c t
uniqueFuns cfg = Grammar {cfgStartCat = cfgStartCat cfg
,cfgExternalCats = cfgExternalCats cfg
,cfgRules = Map.fromList (snd (mapAccumL uniqueFunSet Set.empty (Map.toList (cfgRules cfg))))
}
uniqueFuns :: [Rule c t] -> [Rule c t]
uniqueFuns = snd . mapAccumL uniqueFun Set.empty
where
uniqueFunSet funs (cat,rules) =
let (funs',rules') = mapAccumL uniqueFun funs (Set.toList rules)
in (funs',(cat,Set.fromList rules'))
uniqueFun funs (Rule cat items (CFObj fun args)) = (Set.insert fun' funs,Rule cat items (CFObj fun' args))
where
fun' = head [fun'|suffix<-"":map show ([2..]::[Int]),