diff options
| author | aarne <unknown> | 2004-09-24 08:46:03 +0000 |
|---|---|---|
| committer | aarne <unknown> | 2004-09-24 08:46:03 +0000 |
| commit | 33ea630d4d431045c13e96c51e953ce0bafb4f0f (patch) | |
| tree | fbac8eb1c4b9c2344e4ddfcd8a281e859aaf7f42 /src/GF/CF | |
| parent | 2c60a2d82a0d7b90924e7dbbcacf36afb8549d17 (diff) | |
bug fixes in parsing etc; improved ImperC
Diffstat (limited to 'src/GF/CF')
| -rw-r--r-- | src/GF/CF/CanonToCF.hs | 13 |
1 files changed, 8 insertions, 5 deletions
diff --git a/src/GF/CF/CanonToCF.hs b/src/GF/CF/CanonToCF.hs index 915e11db2..58674e189 100644 --- a/src/GF/CF/CanonToCF.hs +++ b/src/GF/CF/CanonToCF.hs @@ -6,6 +6,7 @@ import Operations import Option import Ident import AbsGFC +import LookAbs (allBindCatsOf) import GFC import Values (isPredefCat,cPredefAbs) import PrGrammar @@ -31,9 +32,10 @@ canon2cf opts gr c = tracePrt "#size of CF" (err id (show.length.rulesOfCF)) $ d let cncs = [m | (n, M.ModMod m) <- M.modules gr, elem n ms] let mms = [(a, tree2list (M.jments m)) | m <- cncs] rules0 <- liftM concat $ mapM (uncurry (cnc2cfCond opts)) mms + let bindcats = map snd $ allBindCatsOf gr let rules = filter (not . isCircularCF) rules0 ---- temporarily here let grules = groupCFRules rules - let predef = mkCFPredef opts grules + let predef = mkCFPredef opts bindcats grules return $ CF predef cnc2cfCond :: Options -> Ident -> [(Ident,Info)] -> Err [CFRule] @@ -151,17 +153,18 @@ term2CFItems m t = errIn "forming cf items" $ case t of _ -> prtBad "cannot extract record field from" arg cIQ c = if isPredefCat c then CIQ cPredefAbs c else CIQ m c -mkCFPredef :: Options -> [CFRuleGroup] -> ([CFRuleGroup],CFPredef) -mkCFPredef opts rules = (ruls, \s -> preds0 s ++ look s) where +mkCFPredef :: Options -> [Ident] -> [CFRuleGroup] -> ([CFRuleGroup],CFPredef) +mkCFPredef opts binds rules = (ruls, \s -> preds0 s ++ look s) where (ruls,preds) = if oElem lexerByNeed opts -- option -cflexer then predefLexer rules else (rules,emptyTrie) preds0 s = [(cat, metaCFFun) | TM _ _ <- [s], cat <- cats] ++ - [(cat, varCFFun x) | TV x <- [s], cat <- catVarCF : cats] ++ + [(cat, varCFFun x) | TV x <- [s], cat <- catVarCF : bindcats] ++ [(cfCatString, stringCFFun t) | TL t <- [s]] ++ [(cfCatInt, intCFFun t) | TI t <- [s]] - cats = map fst rules + cats = nub [c | (_,rs) <- rules, (_,(_,its)) <- rs, CFNonterm c <- its] + bindcats = [c | c <- cats, elem (cfCat2Ident c) binds] look = concatMap snd . map (trieLookup preds) . wordsCFTok --- for TC tokens --- TODO: integrate with morphology |