From 08c9a2ab8cf7b77a5c0392f5f8e9643e39c89c5b Mon Sep 17 00:00:00 2001
From: aarne <unknown>
Date: Tue, 9 Dec 2003 16:39:24 +0000
Subject: Introduced output of stripped format gfcm.

---
 src/GF/Compile/ShellState.hs | 23 +++++++++++++++++++++++
 1 file changed, 23 insertions(+)

(limited to 'src/GF/Compile/ShellState.hs')

diff --git a/src/GF/Compile/ShellState.hs b/src/GF/Compile/ShellState.hs
index 27d88f6fb..d0232b97e 100644
--- a/src/GF/Compile/ShellState.hs
+++ b/src/GF/Compile/ShellState.hs
@@ -8,6 +8,7 @@ import MMacros
 
 import Look
 import LookAbs
+import ModDeps
 import qualified Modules as M
 import qualified Grammar as G
 import qualified PrGrammar as P
@@ -19,6 +20,8 @@ import Option
 import Ident
 import Arch (ModTime)
 
+import List (nub,nubBy)
+
 -- AR 11/11/2001 -- 17/6/2003 (for modules) ---- unfinished
 
 -- multilingual state with grammars and options
@@ -169,6 +172,26 @@ filterAbstracts abstr cgr = M.MGrammar [m | m <- ms, needed m] where
     Just _ -> a : []
     _ -> []
 
+
+purgeShellState :: ShellState -> ShellState
+purgeShellState sh = ShSt {
+  abstract   = abstract sh,
+  concrete   = concrete sh,
+  concretes  = [(a,i) | (a,i) <- concretes sh, elem i needed],
+  canModules = M.MGrammar $ purge $ M.modules $ canModules sh,
+  srcModules = M.emptyMGrammar,
+  cfs        = cfs sh,
+  morphos    = morphos sh,
+  gloptions  = gloptions sh,
+  readFiles  = [],
+  absCats    = absCats sh,
+  statistics = statistics sh
+  }
+ where
+   needed = nub $ concatMap (requiredCanModules (canModules sh)) acncs
+   purge = nubBy (\x y -> fst x == fst y) . filter (flip elem needed . fst)
+   acncs = maybe [] singleton (abstract sh) ++ map snd (concretes sh)
+
 -- form just one state grammar, if unique, from a canonical grammar
 
 grammar2stateGrammar :: Options -> CanonGrammar -> Err StateGrammar 
-- 
cgit v1.2.3