diff options
| author | aarne <aarne@cs.chalmers.se> | 2006-09-16 18:42:46 +0000 |
|---|---|---|
| committer | aarne <aarne@cs.chalmers.se> | 2006-09-16 18:42:46 +0000 |
| commit | 927ad7b1355a3b72d30970cac808792f848551a6 (patch) | |
| tree | 7d58fcad9db47000abf973f8aeab7707a7f677e0 /src/GF/Compile/ShellState.hs | |
| parent | 3917291e92ae5070fc9ec0ea8d37f77a68f243ba (diff) | |
bug fixes in multigrammar handling and GFCC generation
Diffstat (limited to 'src/GF/Compile/ShellState.hs')
| -rw-r--r-- | src/GF/Compile/ShellState.hs | 10 |
1 files changed, 7 insertions, 3 deletions
diff --git a/src/GF/Compile/ShellState.hs b/src/GF/Compile/ShellState.hs index 07ddaa97a..aabb11e34 100644 --- a/src/GF/Compile/ShellState.hs +++ b/src/GF/Compile/ShellState.hs @@ -85,7 +85,7 @@ type Treebank = Map.Map String [String] -- string, trees actualConcretes :: ShellState -> [((Ident,Ident),Bool)] actualConcretes sh = nub [((c,c),b) | Just a <- [abstract sh], - c <- concretesOfAbstract sh a, + ((c,_),_) <- concretes sh, ----concretesOfAbstract sh a, let b = True ----- ] @@ -233,7 +233,10 @@ updateShellState opts ign mcnc sh ((_,sgr,gr),rts) = do let oldConcrs = map (snd . fst) (concretes sh) newConcrs = maybe [] (M.allConcretes gr) abstr0 toRetain (c,v) = notElem c newConcrs - let concrs = nub $ newConcrs ++ oldConcrs + let complete m = case M.lookupModule gr m of + Ok mo -> not $ isIncompleteCanon (m,mo) + _ -> False + let concrs = filter complete $ nub $ newConcrs ++ oldConcrs concr0 = ifNull Nothing (return . head) concrs notInrts f = notElem f $ map fst rts subcgr = unSubelimCanon cgr @@ -317,7 +320,7 @@ purgeShellState sh = ShSt { abstract = abstr, concrete = concrete sh, concretes = concrs, - canModules = M.MGrammar $ purge $ M.modules $ canModules sh, + canModules = M.MGrammar $ filter complete $ purge $ M.modules $ canModules sh, srcModules = M.emptyMGrammar, cfs = cfs sh, abstracts = maybe [] (\a -> [(a,map (snd . fst) concrs)]) abstr, @@ -341,6 +344,7 @@ purgeShellState sh = ShSt { needed = nub $ concatMap (requiredCanModules isSingle (canModules sh)) acncs purge = nubBy (\x y -> fst x == fst y) . filter (flip elem needed . fst) acncs = maybe [] singleton abstr ++ map (snd . fst) (actualConcretes sh) + complete = not . isIncompleteCanon changeMain :: Maybe Ident -> ShellState -> Err ShellState changeMain Nothing (ShSt _ _ cs ms ss cfs old_pis mcfgs fcfgs cfgs pinfos mos tbs pbs os rs acs s trs) = |