"Committed_by_peb"

2005-03-21 13:17:44 +00:00
parent aef9430eb0
commit 96a08c9df4
22 changed files with 1775 additions and 19 deletions
--- a/src/GF/CFGM/PrintCFGrammar.hs
+++ b/src/GF/CFGM/PrintCFGrammar.hs
@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
-- > CVS $Date: 2005/03/21 13:54:24 $ 
+-- > CVS $Date: 2005/03/21 14:17:44 $ 
 -- > CVS $Author: peb $
-- > CVS $Revision: 1.9 $
+-- > CVS $Revision: 1.10 $
 --
 -- Handles printing a CFGrammar in CFGM format.
 -----------------------------------------------------------------------------
@@ -20,12 +20,11 @@ import Ident
 import GFC
 import Modules
 import qualified GF.Conversion.ConvertGrammar as Cnv
-import qualified GF.Parsing.PrintParser as Prt
+import qualified GF.Printing.PrintParser as Prt
 import qualified GF.Conversion.CFGrammar as CFGrammar
 import qualified GF.Conversion.GrammarTypes as GT
 import qualified AbsCFG
 import qualified GF.Parsing.Parser as Parser
-import qualified GF.Parsing.PrintParser as PrintParser
 import ErrM
 import qualified Option

--- a/src/GF/Data/Assoc.hs
+++ b/src/GF/Data/Assoc.hs
@@ -0,0 +1,131 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Assoc
+-- Maintainer  : Peter Ljunglöf
+-- Stability   : Stable
+-- Portability : Haskell 98
+--
+-- > CVS $Date: 2005/03/21 14:17:39 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.1 $
+--
+-- Association lists, or finite maps,
+-- including sets as maps with result type @()@.
+-- function names stolen from module @Array@.
+-- /O(log n)/ key lookup
+-----------------------------------------------------------------------------
+
+module GF.Data.Assoc ( Assoc,
+	       Set,
+	       listAssoc,
+	       listSet,
+	       accumAssoc,
+	       aAssocs,
+	       aElems,
+	       assocMap,
+	       lookupAssoc,
+	       lookupWith,
+	       (?),
+	       (?=)
+	     ) where
+
+import GF.Data.SortedList 
+
+infixl 9 ?, ?=
+
+-- | a set is a finite map with empty values
+type Set a = Assoc a ()
+
+-- | creating a finite map from a sorted key-value list 
+listAssoc   :: Ord a => SList (a, b) -> Assoc a b
+
+-- | creating a set from a sorted list
+listSet     :: Ord a => SList a -> Set a
+
+-- | building a finite map from a list of keys and 'b's, 
+-- and a function that combines a sorted list of 'b's into a value
+accumAssoc :: (Ord a, Ord c) => (SList c -> b) -> [(a, c)] -> Assoc a b
+
+-- | all key-value pairs from an association list
+aAssocs :: Ord a => Assoc a b -> SList (a, b)
+
+-- | all keys from an association list
+aElems  :: Ord a => Assoc a b -> SList a
+
+-- fmap :: Ord a => (b -> b') -> Assoc a b -> Assoc a b'
+
+-- | mapping values to other values.
+-- the mapping function can take the key as information
+assocMap :: Ord a => (a -> b -> b') -> Assoc a b -> Assoc a b'
+
+-- | monadic lookup function,
+-- returning failure if the key does not exist
+lookupAssoc :: (Ord a, Monad m) => Assoc a b -> a -> m b
+
+-- | if the key does not exist, 
+-- the first argument is returned
+lookupWith :: Ord a => b -> Assoc a b -> a -> b
+
+-- | if the values are monadic, we can return the value type
+(?) :: (Ord a, Monad m) => Assoc a (m b) -> a -> m b
+
+-- | checking wheter the map contains a given key 
+(?=) :: Ord a => Assoc a b -> a -> Bool
+
+
+------------------------------------------------------------
+
+data Assoc a b = ANil | ANode (Assoc a b) a b (Assoc a b)
+		 deriving (Eq, Show)
+
+listAssoc as = assoc
+  where (assoc, [])     = sl2bst (length as) as
+	sl2bst 0 xs     = (ANil, xs)
+	sl2bst 1 (x:xs) = (ANode ANil (fst x) (snd x) ANil, xs)
+	sl2bst n xs     = (ANode left (fst x) (snd x) right, zs)
+          where llen    = (n-1) `div` 2
+                rlen    = n - 1 - llen
+                (left, x:ys) = sl2bst llen xs
+                (right, zs)  = sl2bst rlen ys
+
+listSet as = listAssoc (zip as (repeat ()))
+
+accumAssoc join = listAssoc . map (mapSnd join) . groupPairs . nubsort
+    where mapSnd f (a, b) = (a, f b)
+
+aAssocs as = prs as []
+    where prs ANil = id
+	  prs (ANode left a b right) = prs left . ((a,b) :) . prs right
+
+aElems = map fst . aAssocs
+
+
+instance Ord a => Functor (Assoc a) where
+    fmap f = assocMap (const f)
+
+assocMap f ANil = ANil
+assocMap f (ANode left a b right) = ANode (assocMap f left) a (f a b) (assocMap f right)
+
+
+lookupAssoc ANil _ = fail "key not found"
+lookupAssoc (ANode left a b right) a' = case compare a a' of
+					  GT -> lookupAssoc left  a'
+					  LT -> lookupAssoc right a'
+					  EQ -> return b
+
+lookupWith z ANil _ = z
+lookupWith z (ANode left a b right) a' = case compare a a' of
+					   GT -> lookupWith z left  a'
+					   LT -> lookupWith z right a'
+					   EQ -> b
+
+(?) = lookupWith (fail "key not found")
+
+(?=) = \assoc -> maybe False (const True) . lookupAssoc assoc 
+
+
+
+
+
+
+
--- a/src/GF/Data/BacktrackM.hs
+++ b/src/GF/Data/BacktrackM.hs
@@ -0,0 +1,123 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : BacktrackM
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/03/21 14:17:39 $
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.1 $
+--
+-- Backtracking state monad, with r/o environment
+-----------------------------------------------------------------------------
+
+
+module GF.Data.BacktrackM ( -- * the backtracking state monad
+		    BacktrackM,
+		    -- * controlling the monad
+		    failure,
+		    (|||),
+		    -- * handling the state & environment
+		    readEnv,
+		    readState,
+		    writeState,
+		    -- * monad specific utilities
+		    member,
+		    -- * running the monad
+		    runBM,
+		    solutions,
+		    finalStates
+		  ) where
+
+import Monad
+
+------------------------------------------------------------
+-- type declarations
+
+-- * controlling the monad
+
+failure :: BacktrackM e s a
+(|||)   :: BacktrackM e s a -> BacktrackM e s a -> BacktrackM e s a
+
+instance MonadPlus (BacktrackM e s) where
+    mzero = failure
+    mplus = (|||)
+
+-- * handling the state & environment
+
+readEnv    :: BacktrackM e s e
+readState  :: BacktrackM e s s
+writeState :: s -> BacktrackM e s ()
+
+-- * monad specific utilities
+
+member :: [a] -> BacktrackM e s a
+member = msum . map return 
+
+-- * running the monad
+
+runBM       :: BacktrackM e s a  -> e -> s -> [(s, a)]
+
+solutions   :: BacktrackM e s a  -> e -> s -> [a]
+solutions   bm e s = map snd $ runBM bm e s 
+
+finalStates :: BacktrackM e s () -> e -> s -> [s]
+finalStates bm e s = map fst $ runBM bm e s
+
+
+{-
+----------------------------------------------------------------------
+-- implementation as lists of successes
+
+newtype BacktrackM e s a = BM (e -> s -> [(s, a)])
+
+runBM       (BM m) = m
+
+readEnv      = BM (\e s -> [(s, e)])
+readState    = BM (\e s -> [(s, s)])
+writeState s = BM (\e _ -> [(s, ())])
+
+failure       = BM (\e s -> [])
+BM m ||| BM n = BM (\e s -> m e s ++ n e s)
+
+instance Monad (BacktrackM e s) where
+    return a   = BM (\e s -> [(s, a)])
+    BM m >>= k = BM (\e s -> concat [ n e s' | (s', a) <- m e s, let BM n = k a ])
+    fail _     = failure
+-}
+
+----------------------------------------------------------------------
+-- Combining endomorphisms and continuations
+-- a la Ralf Hinze
+
+newtype Backtr a = B (forall b . (a -> b -> b) -> b -> b)
+
+instance Monad Backtr where
+    return a  = B (\c f -> c a f)
+    B m >>= k = B (\c f -> m (\a -> unBacktr (k a) c) f)
+        where unBacktr (B m) = m
+
+failureB     = B (\c f -> f)
+B m |||| B n = B (\c f -> m c (n c f))
+
+runB (B m) = m (:) []
+
+-- BacktrackM = state monad transformer over the backtracking monad
+
+newtype BacktrackM e s a = BM (e -> s -> Backtr (s, a))
+
+runBM (BM m) e s = runB (m e s)
+
+readEnv      = BM (\e s -> return (s, e))
+readState    = BM (\e s -> return (s, s))
+writeState s = BM (\e _ -> return (s, ()))
+
+failure = BM (\e s -> failureB)
+BM m ||| BM n = BM (\e s -> m e s |||| n e s)
+
+instance Monad (BacktrackM e s) where
+    return a   = BM (\e s -> return (s, a))
+    BM m >>= k = BM (\e s -> do (s', a) <- m e s 
+		                unBM (k a) e s')
+	where unBM (BM m) = m
--- a/src/GF/Data/RedBlackSet.hs
+++ b/src/GF/Data/RedBlackSet.hs
@@ -0,0 +1,150 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : RedBlackSet
+-- Maintainer  : Peter Ljunglöf
+-- Stability   : Stable
+-- Portability : Haskell 98
+--
+-- > CVS $Date: 2005/03/21 14:17:39 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.1 $
+--
+-- Modified version of Okasaki's red-black trees
+-- incorporating sets and set-valued maps
+----------------------------------------------------------------------
+
+module GF.Data.RedBlackSet ( -- * Red-black sets
+		     RedBlackSet,
+		     rbEmpty,
+		     rbList,
+		     rbElem,
+		     rbLookup,
+		     rbInsert,
+		     rbMap,
+		     rbOrdMap,
+		     -- * Red-black finite maps
+		     RedBlackMap,
+		     rbmEmpty,
+		     rbmList,
+		     rbmElem,
+		     rbmLookup,
+		     rbmInsert,
+		     rbmOrdMap
+		   ) where
+
+--------------------------------------------------------------------------------
+-- sets
+
+data Color = R | B   deriving (Eq, Show)
+data RedBlackSet a = E | T Color (RedBlackSet a) a (RedBlackSet a)
+		     deriving (Eq, Show)
+
+rbBalance B (T R (T R a x b) y c) z d = T R (T B a x b) y (T B c z d)
+rbBalance B (T R a x (T R b y c)) z d = T R (T B a x b) y (T B c z d)
+rbBalance B a x (T R (T R b y c) z d) = T R (T B a x b) y (T B c z d)
+rbBalance B a x (T R b y (T R c z d)) = T R (T B a x b) y (T B c z d)
+rbBalance color a x b = T color a x b
+
+rbBlack (T _ a x b) = T B a x b
+
+-- | the empty set
+rbEmpty :: RedBlackSet a
+rbEmpty = E
+
+-- | the elements of a set as a sorted list
+rbList :: RedBlackSet a -> [a]
+rbList tree = rbl tree []
+  where rbl E = id
+	rbl (T _ left a right) = rbl right . (a:) . rbl left
+
+-- | checking for containment
+rbElem :: Ord a => a -> RedBlackSet a -> Bool
+rbElem _ E = False
+rbElem a (T _ left a' right)
+    = case compare a a' of
+        LT -> rbElem a left
+	GT -> rbElem a right
+	EQ -> True
+
+-- | looking up a key in a set of keys and values
+rbLookup :: Ord k => k -> RedBlackSet (k, a) -> Maybe a
+rbLookup _ E = Nothing
+rbLookup a (T _ left (a',b) right)
+    = case compare a a' of
+        LT -> rbLookup a left
+	GT -> rbLookup a right
+	EQ -> Just b
+
+-- | inserting a new element.
+-- returns 'Nothing' if the element is already contained
+rbInsert :: Ord a => a -> RedBlackSet a -> Maybe (RedBlackSet a)
+rbInsert value tree = fmap rbBlack (rbins tree)
+  where rbins E = Just (T R E value E)
+	rbins (T color left value' right)
+	    = case compare value value' of
+                LT -> do left' <- rbins left
+			 return (rbBalance color left' value' right)
+		GT -> do right' <- rbins right
+			 return (rbBalance color left value' right')
+		EQ -> Nothing
+
+-- | mapping each value of a key-value set 
+rbMap :: (a -> b) -> RedBlackSet (k, a) -> RedBlackSet (k, b)
+rbMap f E = E
+rbMap f (T color left (key, value) right) 
+    = T color (rbMap f left) (key, f value) (rbMap f right)
+
+-- | mapping each element to another type.
+-- /observe/ that the mapping function needs to preserve 
+-- the order between objects
+rbOrdMap :: (a -> b) -> RedBlackSet a -> RedBlackSet b
+rbOrdMap f E = E
+rbOrdMap f (T color left value right) 
+    = T color (rbOrdMap f left) (f value) (rbOrdMap f right)
+
+----------------------------------------------------------------------
+-- finite maps
+
+type RedBlackMap k a = RedBlackSet (k, RedBlackSet a)
+
+-- | the empty map
+rbmEmpty :: RedBlackMap k a
+rbmEmpty = E
+
+-- | converting a map to a key-value list, sorted on the keys,
+-- and for each key, a sorted list of values
+rbmList :: RedBlackMap k a -> [(k, [a])]
+rbmList tree = [ (k, rbList sub) | (k, sub) <- rbList tree ]
+
+-- | checking whether a key-value pair is contained in the map
+rbmElem :: (Ord k, Ord a) => k -> a -> RedBlackMap k a -> Bool
+rbmElem key value = maybe False (rbElem value) . rbLookup key 
+
+-- | looking up a key, returning a (sorted) list of all matching values
+rbmLookup :: Ord k => k -> RedBlackMap k a -> [a]
+rbmLookup key = maybe [] rbList . rbLookup key 
+
+-- | inserting a key-value pair.
+-- returns 'Nothing' if the pair is already contained in the map
+rbmInsert :: (Ord k, Ord a) => k -> a -> RedBlackMap k a -> Maybe (RedBlackMap k a)
+rbmInsert key value tree = fmap rbBlack (rbins tree)
+  where rbins E = Just (T R E (key, T B E value E) E)
+	rbins (T color left item@(key', vtree) right)
+	    = case compare key key' of
+                LT -> do left' <- rbins left
+			 return (rbBalance color left' item right)
+		GT -> do right' <- rbins right
+			 return (rbBalance color left item right')
+		EQ -> do vtree' <- rbInsert value vtree
+			 return (T color left (key', vtree') right)
+
+-- | mapping each value to another type.
+-- /observe/ that the mapping function needs to preserve
+-- order between objects
+rbmOrdMap :: (a -> b) -> RedBlackMap k a -> RedBlackMap k b
+rbmOrdMap f E = E
+rbmOrdMap f (T color left (key, tree) right) 
+    = T color (rbmOrdMap f left) (key, rbOrdMap f tree) (rbmOrdMap f right)
+
+
+
--- a/src/GF/Data/SortedList.hs
+++ b/src/GF/Data/SortedList.hs
@@ -0,0 +1,108 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : SortedList
+-- Maintainer  : Peter Ljunglöf
+-- Stability   : stable
+-- Portability : portable
+--
+-- > CVS $Date: 2005/03/21 14:17:39 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.1 $
+--
+-- Sets as sorted lists
+--
+--    * /O(n)/   union, difference and intersection 
+--
+--    * /O(n log n)/ creating a set from a list (=sorting)
+--
+--    * /O(n^2)/ fixed point iteration
+-----------------------------------------------------------------------------
+
+module GF.Data.SortedList ( SList, 
+		    nubsort, union, 
+		    (<++>), (<\\>), (<**>), 
+		    limit,
+		    hasCommonElements, subset, 
+		    groupPairs, groupUnion
+		  ) where
+
+import List (groupBy)
+
+-- | The list must be sorted and contain no duplicates.
+type SList a = [a]
+
+-- | Group a set of key-value pairs into
+-- a set of unique keys with sets of values
+groupPairs :: Ord a => SList (a, b) -> SList (a, SList b)
+groupPairs = map mapFst . groupBy eqFst
+    where mapFst as = (fst (head as), map snd as)
+	  eqFst a b = fst a == fst b
+
+-- | Group a set of key-(sets-of-values) pairs into
+-- a set of unique keys with sets of values
+groupUnion :: (Ord a, Ord b) => SList (a, SList b) -> SList (a, SList b)
+groupUnion = map unionSnd . groupPairs
+    where unionSnd (a, bs) = (a, union bs)
+
+-- | True is the two sets has common elements
+hasCommonElements :: Ord a => SList a -> SList a -> Bool
+hasCommonElements as bs = not (null (as <**> bs))
+
+-- | True if the first argument is a subset of the second argument
+subset :: Ord a => SList a -> SList a -> Bool
+xs `subset` ys = null (xs <\\> ys)
+
+-- | Create a set from any list.
+-- This function can also be used as an alternative to @nub@ in @List.hs@
+nubsort :: Ord a => [a] -> SList a
+nubsort = union . map return
+
+-- | The union of a list of sets
+union :: Ord a => [SList a] -> SList a
+union []   = []
+union [as] = as
+union abs  = let (as, bs) = split abs in union as <++> union bs
+	      where split (a:b:abs) = let (as, bs) = split abs in (a:as, b:bs)
+		    split as        = (as, [])
+
+-- | The union of two sets
+(<++>) :: Ord a => SList a -> SList a -> SList a 
+[] <++> bs = bs
+as <++> [] = as
+as@(a:as') <++> bs@(b:bs') = case compare a b of
+			       LT -> a : (as' <++> bs)
+			       GT -> b : (as  <++> bs')
+			       EQ -> a : (as' <++> bs')
+
+-- | The difference of two sets
+(<\\>) :: Ord a => SList a -> SList a -> SList a 
+[] <\\> bs = []
+as <\\> [] = as
+as@(a:as') <\\> bs@(b:bs') = case compare a b of
+			       LT -> a : (as' <\\> bs)
+			       GT ->     (as  <\\> bs')
+			       EQ ->     (as' <\\> bs')
+
+-- | The intersection of two sets
+(<**>) :: Ord a => SList a -> SList a -> SList a
+[] <**> bs = []
+as <**> [] = []
+as@(a:as') <**> bs@(b:bs') = case compare a b of
+			       LT ->     (as' <**> bs)
+			       GT ->     (as  <**> bs')
+			       EQ -> a : (as' <**> bs')
+
+-- | A fixed point iteration 
+limit :: Ord a => (a -> SList a)  -- ^ The iterator function
+      -> SList a                  -- ^ The initial set
+      -> SList a                  -- ^ The result of the iteration
+limit more start = limit' start start
+    where limit' chart agenda | null new' = chart
+			      | otherwise = limit' (chart <++> new') new'
+	      where new = union (map more agenda)
+		    new'= new <\\> chart
+
+
+
+
+
--- a/src/GF/Parsing/CFParserGeneral.hs
+++ b/src/GF/Parsing/CFParserGeneral.hs
@@ -0,0 +1,85 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : CFParserGeneral
+-- Maintainer  : Peter Ljunglöf
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/03/21 14:17:41 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.1 $
+--
+-- Several implementations of CFG chart parsing
+-----------------------------------------------------------------------------
+
+module GF.Parsing.CFParserGeneral (parse,
+			Strategy
+		       ) where
+
+import Tracing
+
+import GF.Parsing.Parser
+import GF.Conversion.CFGrammar
+import GF.Parsing.GeneralChart 
+import GF.Data.Assoc
+
+parse :: (Ord n, Ord c, Ord t) => Strategy -> CFParser n c t
+parse strategy grammar start = extract . process strategy grammar start
+
+type Strategy = (Bool, Bool) -- (isBottomup, isTopdown)
+
+extract :: [Item n (Symbol c t)] -> [Edge (Rule n c t)]
+extract edges =
+    edges'
+    where edges' = [ Edge j k (Rule cat (reverse found) name) |
+		     Edge j k (Cat cat, found, [], Just name) <- edges ]
+
+process :: (Ord n, Ord c, Ord t) => Strategy -> PInfo n c t -> 
+	   [c] -> Input t -> [Item n (Symbol c t)]
+process (isBottomup, isTopdown) grammar start
+    = trace ("CFParserGeneral" ++ 
+	     (if isBottomup then " BU" else "") ++ 
+	     (if isTopdown  then " TD" else "")) $
+      buildChart keyof [predict, combine] . axioms 
+    where axioms input = initial ++ scan input
+
+          scan input = map (fmap mkEdge) (inputEdges input)
+	  mkEdge tok = (Tok tok, [], [], Nothing)
+
+          -- the combine rule
+          combine chart (Edge j k (next, _, [], _))
+	      = [ edge `forwardTo` k | edge <- chartLookup chart (Active next j) ]
+          combine chart edge@(Edge _ j (_, _, next:_, _))
+	      = [ edge `forwardTo` k | Edge _ k _ <- chartLookup chart (Passive next j) ]
+
+          -- initial predictions
+          initial = [ loopingEdge 0 rule | cat <- start, rule <- tdRuleLookup ? cat ]
+
+          -- predictions
+          predict chart (Edge j k (next, _, [], _)) | isBottomup 
+	      = [ loopingEdge j rule `forwardTo` k | rule <- bottomupRules grammar ? next ]
+	      -- - - - - - - - - -   ^^^^^^^^^^^^^ Kilbury prediction: move dot forward
+	  predict chart (Edge _ k (_, _, Cat cat:_, _))
+	      = [ loopingEdge k rule | rule <- tdRuleLookup ? cat ]
+	  predict _ _ = []
+
+          tdRuleLookup | isTopdown  = topdownRules grammar
+		       | isBottomup = emptyLeftcornerRules grammar
+
+-- internal representation of parse items
+
+type Item   n s = Edge (s, [s], [s], Maybe n)
+type IChart n s = Chart (Item n s) (IKey s)
+data IKey     s = Active  s Int
+		| Passive s Int
+		  deriving (Eq, Ord, Show)
+
+keyof (Edge _ j (_, _, next:_, _)) = Active next j
+keyof (Edge j _ (cat, _, [], _))   = Passive cat j
+
+forwardTo (Edge i j (cat, found, next:tofind, name)) k = Edge i k (cat, next:found, tofind, name)
+
+loopingEdge k (Rule cat tofind name) = Edge k k (Cat cat, [], tofind, Just name)
+
+
+
--- a/src/GF/Parsing/CFParserIncremental.hs
+++ b/src/GF/Parsing/CFParserIncremental.hs
@@ -0,0 +1,143 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : CFParserIncremental
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/03/21 14:17:41 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.1 $
+--
+-- Incremental chart parsing for context-free grammars
+-----------------------------------------------------------------------------
+
+ 
+
+module GF.Parsing.CFParserIncremental (parse,
+			    Strategy) where
+
+import Tracing
+import GF.Printing.PrintParser
+
+-- haskell modules:
+import Array
+-- gf modules:
+import GF.Data.SortedList
+import GF.Data.Assoc
+import Operations
+-- parser modules:
+import GF.Parsing.Parser
+import GF.Conversion.CFGrammar
+import GF.Parsing.IncrementalChart
+
+
+type Strategy = ((Bool, Bool), (Bool, Bool)) -- (predict:(BU, TD), filter:(BU, TD))
+
+parse :: (Ord n, Ord c, Ord t, Show t) => 
+	 Strategy -> CFParser n c t
+parse ((isPredictBU, isPredictTD), (isFilterBU, isFilterTD)) grammar start input =
+    trace2 "CFParserIncremental" 
+	       ((if isPredictBU then "BU-predict " else "") ++
+		(if isPredictTD then "TD-predict " else "") ++
+		(if isFilterBU  then "BU-filter " else "") ++
+		(if isFilterTD  then "TD-filter " else "")) $
+    trace2 "input" (show (inputTo input)) $
+    finalEdges
+    where finalEdges = [ Edge j k (Rule cat (reverse found) name) |
+			 (k, state) <- 
+			   tracePrt "#passiveChart"
+			   (prt . map (length . (?Passive) . snd)) $
+			   tracePrt "#activeChart" 
+			   (prt . map (length . concatMap snd . aAssocs . snd)) $
+			   assocs finalChart,
+			 Item j (Rule cat _Nil name) found <- state ? Passive ]
+
+	  finalChart = buildChart keyof rules axioms $ inputBounds input
+
+          axioms 0 = --tracePrt ("axioms 0") (prtSep "\n") $
+		     union $ map (tdInfer 0) start
+	  axioms k = --tracePrt ("axioms "++show k) (prtSep "\n") $
+		     union [ buInfer j k (Tok token) |
+			     (token, js) <- aAssocs (inputTo input ! k), j <- js ]
+
+          rules k (Item j (Rule cat [] _) _)
+	      = buInfer j k (Cat cat)
+          rules k (Item j rule@(Rule _ (Cat next:_) _) found) 
+	      = tdInfer k next <++> 
+	        -- hack for empty rules:
+		[ Item j (forward rule) (Cat next:found) | 
+		  emptyCategories grammar ?= next ]
+	  rules _ _ = []
+
+          buInfer j k next = --tracePrt ("buInfer "++show(j,k)++" "++prt next) (prtSep "\n") $
+			     buPredict j k next <++> buCombine j k next 
+          tdInfer   k next = tdPredict   k next
+
+	  -- the combine rule
+          buCombine j k next
+	      | j == k    = [] -- hack for empty rules
+	      | otherwise = [ Item i (forward rule) (next:found) | 
+			      Item i rule found <- (finalChart ! j) ? Active next ]
+
+	  -- kilbury bottom-up prediction
+          buPredict j k next
+	      = [ Item j rule [next] | isPredictBU,
+		  rule <- map forward $ --tracePrt ("buRules "++prt next) (prtSep "\n") $
+		                        bottomupRules grammar ? next,
+		  buFilter rule k, 
+		  tdFilter rule j k ]
+
+	  -- top-down prediction
+          tdPredict k cat
+	      = [ Item k rule [] | isPredictTD || isFilterTD,
+		  rule <- topdownRules grammar ? cat,
+		  buFilter rule k ] <++>
+		-- hack for empty rules:
+		[ Item k rule [] | isPredictBU,
+		  rule <- emptyLeftcornerRules grammar ? cat ]
+
+          -- bottom up filtering: input symbol k can begin the given symbol list (first set)
+	  -- leftcornerTokens DOESN'T WORK WITH EMPTY RULES!!!
+	  buFilter (Rule _ (Cat cat:_) _) k | isFilterBU
+	      = k < snd (inputBounds input) && 
+		hasCommonElements (leftcornerTokens grammar ? cat) 
+				      (aElems (inputFrom input ! k))
+	  buFilter _ _ = True
+
+          -- top down filtering: 'cat' is reachable by an active edge ending in node j < k
+          tdFilter (Rule cat _ _) j k | isFilterTD && j < k
+					  = (tdFilters ! j) ?= cat
+	  tdFilter _ _ _ = True
+
+	  tdFilters    = listArray (inputBounds input) $ 
+			 map (listSet . limit leftCats . activeCats) [0..]
+	  activeCats j = [ next | Active (Cat next) <- aElems (finalChart ! j) ]
+	  leftCats cat = [ left | Rule _cat (Cat left:_) _ <- topdownRules grammar ? cat ]
+
+
+-- type declarations, items & keys
+data Item n c t = Item Int (Rule n c t) [Symbol c t]
+		  deriving (Eq, Ord, Show)
+
+data IKey   c t = Active (Symbol c t) | Passive
+		  deriving (Eq, Ord, Show)
+
+keyof :: Item n c t -> IKey c t
+keyof (Item _ (Rule _ (next:_) _) _) = Active next
+keyof (Item _ (Rule _ [] _) _)       = Passive
+
+forward :: Rule n c t -> Rule n c t 
+forward (Rule cat (_:rest) name) = Rule cat rest name
+
+
+instance (Print n, Print c, Print t) => Print (Item n c t) where
+    prt (Item k (Rule cat rhs name) syms) 
+	= "<" ++show k++ ": "++prt name++". "++
+	  prt cat++" -> "++prt rhs++" / "++prt syms++">"
+
+instance (Print c, Print t) => Print (IKey c t) where
+    prt (Active sym) = "?" ++ prt sym
+    prt (Passive) = "!"
+
+
--- a/src/GF/Parsing/GeneralChart.hs
+++ b/src/GF/Parsing/GeneralChart.hs
@@ -0,0 +1,85 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : GeneralChart
+-- Maintainer  : Peter Ljunglöf
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/03/21 14:17:42 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.1 $
+--
+-- Simple implementation of deductive chart parsing
+-----------------------------------------------------------------------------
+
+
+module GF.Parsing.GeneralChart (-- * Type definition
+		     Chart,
+		     -- * Main functions
+		     chartLookup,
+		     buildChart,
+		     -- * Probably not needed
+		     emptyChart,
+		     chartMember,
+		     chartInsert,
+		     chartList,
+		     addToChart
+		    ) where
+
+-- import Trace 
+
+import GF.Data.RedBlackSet
+
+-- main functions
+
+chartLookup :: (Ord item, Ord key) => Chart item key -> key -> [item]
+buildChart  :: (Ord item, Ord key) => (item -> key) -> 
+	       [Chart item key -> item -> [item]] -> [item] -> [item]
+
+buildChart keyof rules axioms     = chartList (addItems axioms emptyChart)
+    where addItems []             = id
+	  addItems (item:items)   = addItems items . addItem item
+
+          -- addItem item | trace ("+ "++show item++"\n") False = undefined
+          addItem item            = addToChart item (keyof item) 
+				    (\chart -> foldr (consequence item) chart rules)
+
+          consequence item rule chart = addItems (rule chart item) chart
+
+-- probably not needed
+
+emptyChart  :: (Ord item, Ord key) => Chart item key
+chartMember :: (Ord item, Ord key) => Chart item key -> item -> key -> Bool
+chartInsert :: (Ord item, Ord key) => Chart item key -> item -> key -> Maybe (Chart item key)
+chartList   :: (Ord item, Ord key) => Chart item key -> [item]
+addToChart  :: (Ord item, Ord key) => item -> key -> (Chart item key -> Chart item key) -> Chart item key -> Chart item key
+
+addToChart item key after chart = maybe chart after (chartInsert chart item key)
+
+
+--------------------------------------------------------------------------------
+-- key charts as red/black trees
+
+newtype Chart         item key = KC (RedBlackMap key item)
+    deriving Show
+
+emptyChart                     = KC rbmEmpty
+chartMember (KC tree) item key = rbmElem key item tree
+chartInsert (KC tree) item key = fmap KC (rbmInsert key item tree)
+chartLookup (KC tree)      key = rbmLookup key tree
+chartList   (KC tree)          = concatMap snd (rbmList tree)
+--------------------------------------------------------------------------------}
+
+
+{--------------------------------------------------------------------------------
+-- key charts as unsorted association lists -- OBSOLETE!
+
+newtype Chart          item key = SC [(key, item)]
+
+emptyChart = SC []
+chartMember (SC chart) item key = (key,item) `elem` chart
+chartInsert (SC chart) item key = if (key,item) `elem` chart then Nothing else Just (SC ((key,item):chart))
+chartLookup (SC chart)      key = [ item | (key',item) <- chart, key == key' ]
+chartList   (SC chart)          = map snd chart
+--------------------------------------------------------------------------------}
+
--- a/src/GF/Parsing/IncrementalChart.hs
+++ b/src/GF/Parsing/IncrementalChart.hs
@@ -0,0 +1,49 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : IncrementalChart
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/03/21 14:17:42 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.1 $
+--
+-- Implementation of /incremental/ deductive parsing,
+-- i.e. parsing one word at the time.
+-----------------------------------------------------------------------------
+
+
+module GF.Parsing.IncrementalChart (-- * Type definitions
+			 IncrementalChart,
+			 -- * Functions
+			 buildChart,
+			 chartList
+			) where
+
+import Array
+import GF.Data.SortedList
+import GF.Data.Assoc
+
+buildChart :: (Ord item, Ord key) => (item -> key) -> 
+	      (Int -> item -> SList item) -> 
+	      (Int ->         SList item) -> 
+	      (Int, Int) -> IncrementalChart item key
+
+chartList :: (Ord item, Ord key) => (Int -> item -> edge) -> IncrementalChart item key -> [edge]
+
+type IncrementalChart item key = Array Int (Assoc key (SList item))
+
+----------
+
+buildChart keyof rules axioms bounds = finalChartArray
+    where buildState k     = limit (rules k) $ axioms k
+	  finalChartList   = map buildState [fst bounds .. snd bounds]
+	  finalChartArray  = listArray bounds $ map stateAssoc finalChartList
+	  stateAssoc state = accumAssoc id [ (keyof item, item) | item <- state ]
+
+chartList combine chart = [ combine k item | 
+			    (k, state) <- assocs chart, 
+			    item <- concatMap snd $ aAssocs state ]
+
+
--- a/src/GF/Parsing/MCFParserBasic.hs
+++ b/src/GF/Parsing/MCFParserBasic.hs
@@ -0,0 +1,156 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : MCFParserBasic
+-- Maintainer  : Peter Ljunglöf
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/03/21 14:17:42 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.1 $
+--
+-- Simplest possible implementation of MCFG chart parsing
+-----------------------------------------------------------------------------
+
+module GF.Parsing.MCFParserBasic (parse
+		      ) where
+
+import Tracing
+
+import Ix
+import GF.Parsing.Parser
+import GF.Conversion.MCFGrammar
+import GF.Parsing.GeneralChart 
+import GF.Data.Assoc
+import GF.Data.SortedList
+import GF.Printing.PrintParser
+
+
+parse :: (Ord n, Ord c, Ord l, Ord t,
+	  Print n, Print c, Print l, Print t) => 
+	 MCFParser n c l t
+parse grammar start = edges2chart . extract . process grammar 
+
+
+extract :: [Item n c l t] -> [(n, MEdge c l, [MEdge c l])]
+extract items = tracePrt "#passives" (prt.length) $
+		--trace2 "passives" (prtAfter "\n" [ i | i@(PItem _) <- items ]) $
+		[ item | PItem item <- items ]
+
+
+process :: (Ord n, Ord c, Ord l, Ord t, 
+	    Print n, Print c, Print l, Print t) => 
+	   Grammar n c l t -> Input t -> [Item n c l t]
+process grammar input = buildChart keyof rules axioms
+    where axioms = initial
+	  rules  = [combine, scan, predict]
+
+          -- axioms
+	  initial = traceItems "axiom" [] $
+		    [ nextLin name tofind (addNull cat) (map addNull args) |
+		      Rule cat args tofind name <- grammar ]
+
+	  addNull a = (a, [])
+
+	  -- predict 
+	  predict chart i1@(Item name tofind rho (Lin lbl []) (cat, found0) children)
+	      = traceItems "predict" [i1] 
+		[ nextLin name tofind (cat, found) children | 
+		  let found = insertRow lbl rho found0 ]
+	  predict _ _ = []
+
+          -- combine 
+	  combine chart active@(Item _ _ _ (Lin _ (Cat(cat,_,_):_)) _ _)
+	      = do passive <- chartLookup chart (Passive cat)
+		   combineItems active passive
+	  combine chart passive@(PItem (_, (cat, _), _))
+	      = do active <- chartLookup chart (Active cat)
+		   combineItems active passive
+	  combine _ _ = []
+
+          combineItems i1@(Item name tofind rho0 (Lin lbl (Cat(_,lbl',nr):rest)) found children0)
+		       i2@(PItem (_, found', _))
+	      = traceItems "combine" [i1,i2]
+		[ Item name tofind rho (Lin lbl rest) found children |
+		  rho1 <- lookupLbl lbl' found',
+		  let rho = concatRange rho0 rho1,
+		  children <- updateChild nr children0 (snd found') ]
+
+          -- scan
+	  scan chart i1@(Item name tofind rho0 (Lin lbl (Tok tok:rest)) found children)
+	      = traceItems "scan" [i1]
+		[ Item name tofind rho (Lin lbl rest) found children |
+		  let rho = concatRange rho0 (rangeOfToken tok) ]
+	  scan _ _ = []
+
+          -- utilities
+          rangeOfToken tok = makeRange $ inputToken input ? tok
+
+          zeroRange = makeRange $ map (\i -> (i,i)) $ range $ inputBounds input
+
+          nextLin name [] found children = PItem (name, found, children)
+          nextLin name (lin : tofind) found children 
+	      = Item name tofind zeroRange lin found children 
+
+lookupLbl a = map snd . filter (\b -> a == fst b) . snd
+updateChild nr children found = updateIndex nr children $
+				\child -> if null (snd child)
+					     then [ (fst child, found) ]
+					     else [ child | snd child == found ]
+
+insertRow lbl rho [] = [(lbl, rho)]
+insertRow lbl rho rows'@(row@(lbl', rho') : rows)
+    = case compare lbl lbl' of
+        LT -> row : insertRow lbl rho rows
+	GT -> (lbl, rho) : rows'
+	EQ -> (lbl, unionRange rho rho') : rows
+
+
+-- internal representation of parse items
+
+data Item n c l t
+    = Item n [Lin c l t] -- tofind
+      Range (Lin c l t) -- current row
+      (MEdge c l) -- found rows
+      [MEdge c l] -- found children
+    | PItem (n, MEdge c l, [MEdge c l])
+    deriving (Eq, Ord, Show)
+
+data IKey c = Passive c | Active c | AnyItem
+		deriving (Eq, Ord, Show)
+
+keyof (PItem (_, (cat, _), _)) = Passive cat
+keyof (Item _ _ _ (Lin _ (Cat(cat,_,_):_)) _ _) = Active cat
+keyof _ = AnyItem
+
+
+-- tracing
+
+--type TraceItem = Item String String Char String
+traceItems :: (Print n, Print l, Print c, Print t) =>
+	      String -> [Item n c l t] -> [Item n c l t] -> [Item n c l t] 
+traceItems rule trigs items
+    | null items || True = items
+    | otherwise = trace ("\n" ++ rule ++ ":" ++ 
+			 unlines [ "\t" ++ prt i | i <- trigs ] ++ "=>" ++
+			 unlines [ "\t" ++ prt i | i <- items ]) items
+
+-- pretty-printing
+
+instance (Print n, Print c, Print l, Print t) => Print (Item n c l t) where
+    prt (Item name tofind rho lin (cat, found) children)
+	= prt name ++ ". " ++ prt cat ++ prtRhs (map fst children) ++ 
+	  "   { " ++ prt rho ++ prt lin ++ " ; " ++
+	  concat [ prt lbl ++ "=" ++ prt ln ++ " " | 
+		   Lin lbl ln <- tofind ] ++ "; " ++
+	  concat [ prt lbl ++ "=" ++ prt rho ++ " " | 
+		   (lbl, rho) <- found ] ++ "}   " ++
+	  concat [ "[ " ++ concat [ prt lbl ++ "=" ++ prt rho ++ " " | 
+				    (lbl,rho) <- child ] ++ "]   " | 
+		   child <- map snd children ]
+    prt (PItem (name, edge, edges)) 
+	= prt name ++ ". " ++ prt edge ++ prtRhs edges
+
+prtRhs [] = ""
+prtRhs rhs = " -> " ++ prtSep " " rhs
+
--- a/src/GF/Parsing/ParseCF.hs
+++ b/src/GF/Parsing/ParseCF.hs
@@ -0,0 +1,82 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : ParseCF
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/03/21 14:17:42 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.1 $
+--
+-- Chart parsing of grammars in CF format
+-----------------------------------------------------------------------------
+
+module GF.Parsing.ParseCF (parse, alternatives) where
+
+import Tracing
+import GF.Printing.PrintParser
+import GF.Printing.PrintSimplifiedTerm
+
+import GF.Data.SortedList (nubsort)
+import GF.Data.Assoc
+import qualified CF
+import qualified CFIdent as CFI
+import GF.Parsing.Parser
+import GF.Conversion.CFGrammar
+import qualified GF.Parsing.ParseCFG as P
+
+type Token    = CFI.CFTok
+type Name     = CFI.CFFun
+type Category = CFI.CFCat
+
+alternatives :: [(String, [String])]
+alternatives = [ ("gb",  ["G","GB","_gen","_genBU"]),
+		 ("gt",  ["GT","_genTD"]),
+		 ("ibn", ["","I","B","IB","IBN","_inc","BU","_incBU"]),
+		 ("ibb", ["BB","IBB","BU_BUF","_incBU_BUF"]),
+		 ("ibt", ["BT","IBT","BU_TDF","_incBU_TDF"]),
+		 ("iba", ["BA","IBA","BU_BTF","BU_TBF","_incBU_BTF","_incBU_TBF"]),
+		 ("itn", ["T","IT","ITN","TD","_incTD"]),
+		 ("itb", ["TB","ITB","TD_BUF","_incTD_BUF"])
+	       ]
+
+parse :: String -> CF.CF -> Category -> CF.CFParser
+parse = buildParser . P.parse 
+
+buildParser :: CFParser Name Category Token -> CF.CF -> Category -> CF.CFParser
+buildParser parser cf start tokens = trace "ParseCF" $
+				     (parseResults, parseInformation)
+    where parseInformation = prtSep "\n" trees
+	  parseResults     = {-take maxTake-} [ (tree2cfTree t, []) | t <- trees ]
+	  theInput = input tokens
+	  edges    = tracePrt "#edges" (prt.length) $
+		     parser pInf [start] theInput
+	  chart    = tracePrt "#chart" (prt . map (length.snd) . aAssocs) $
+		     edges2chart theInput $ map (fmap addCategory) edges
+	  forests  = tracePrt "#forests" (prt.length) $
+		     chart2forests chart (const False) $ 
+		     uncurry Edge (inputBounds theInput) start
+	  trees    = tracePrt "#trees" (prt.length) $
+		     concatMap forest2trees forests
+	  pInf     = pInfo $ cf2grammar cf (nubsort tokens)
+	  
+
+addCategory (Rule cat rhs name) = Rule cat rhs (name, cat)
+
+tree2cfTree (TNode (name, cat) trees) = CF.CFTree (name, (cat, map tree2cfTree trees))
+
+cf2grammar :: CF.CF -> [Token] -> Grammar Name Category Token
+cf2grammar cf tokens = [ Rule cat rhs name |
+			 (name, (cat, rhs0)) <- cfRules, 
+			 rhs <- mapM item2symbol rhs0 ] 
+    where cfRules = concatMap (CF.predefRules (CF.predefOfCF cf)) tokens ++ 
+		    CF.rulesOfCF cf 
+	  item2symbol (CF.CFNonterm cat) = [Cat cat]
+	  item2symbol item = map Tok $ filter (CF.matchCFTerm item) tokens
+
+-- maxTake :: Int
+-- maxTake = 500
+-- maxTake = maxBound
+
+
--- a/src/GF/Parsing/ParseCFG.hs
+++ b/src/GF/Parsing/ParseCFG.hs
@@ -0,0 +1,43 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : ParseCFG
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/03/21 14:17:42 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.1 $
+--
+-- Main parsing module for context-free grammars
+-----------------------------------------------------------------------------
+
+
+module GF.Parsing.ParseCFG (parse) where
+
+import Char (toLower)
+import GF.Parsing.Parser
+import GF.Conversion.CFGrammar
+import qualified GF.Parsing.CFParserGeneral as PGen
+import qualified GF.Parsing.CFParserIncremental as PInc
+
+
+parse :: (Ord n, Ord c, Ord t, Show t) => 
+	 String -> CFParser n c t
+parse = decodeParser . map toLower
+
+decodeParser ['g',s]   = PGen.parse (decodeStrategy s)
+decodeParser ['i',s,f] = PInc.parse (decodeStrategy s, decodeFilter f)
+decodeParser _ = decodeParser "ibn"
+
+decodeStrategy 'b' = (True, False)
+decodeStrategy 't' = (False, True)
+
+decodeFilter 'a' = (True, True)
+decodeFilter 'b' = (True, False)
+decodeFilter 't' = (False, True)
+decodeFilter 'n' = (False, False)
+
+
+
+
--- a/src/GF/Parsing/ParseGFC.hs
+++ b/src/GF/Parsing/ParseGFC.hs
@@ -0,0 +1,177 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : ParseGFC
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/03/21 14:17:43 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.1 $
+--
+-- The main parsing module, parsing GFC grammars
+-- by translating to simpler formats, such as PMCFG and CFG
+----------------------------------------------------------------------
+
+module GF.Parsing.ParseGFC (newParser) where
+
+import Tracing 
+import GF.Printing.PrintParser
+import qualified PrGrammar
+
+-- Haskell modules
+import Monad
+-- import Ratio ((%))
+-- GF modules
+import qualified Grammar as GF
+import Values
+import qualified Macros 
+import qualified Modules as Mods
+import qualified AbsGFC
+import qualified Ident
+import qualified ShellState as SS
+import Operations
+import GF.Data.SortedList 
+-- Conversion and parser modules
+import GF.Data.Assoc
+import GF.Parsing.Parser
+-- import ConvertGrammar
+import GF.Conversion.GrammarTypes
+import qualified GF.Conversion.MCFGrammar as M
+import qualified GF.Conversion.CFGrammar as C
+import qualified GF.Parsing.ParseMCFG as PM
+import qualified GF.Parsing.ParseCFG as PC
+--import MCFRange
+
+newParser :: String -> SS.StateGrammar -> GF.Cat -> String -> Err [GF.Term]
+
+-- parsing via MCFG
+newParser (m:strategy) gr (_, startCat) inString 
+    | m=='m' || m=='M' = trace2 "Parser" "MCFG" $ Ok terms
+    where terms    = map (ptree2term abstract) trees
+	  trees    = --tracePrt "trees" (prtBefore "\n") $
+		     tracePrt "#trees" (prt . length) $
+		     concatMap forest2trees forests
+	  forests  = --tracePrt "forests" (prtBefore "\n") $
+		     tracePrt "#forests" (prt . length) $
+		     concatMap (chart2forests chart isMeta) finalEdges
+	  isMeta = null . snd
+	  finalEdges = tracePrt "finalEdges" (prtBefore "\n") $
+		       filter isFinalEdge $ aElems chart
+-- 		       nubsort [ (cat, [(lbl, E.makeRange [(i,j)])]) | 
+-- 				 let (i, j) = inputBounds inTokens,
+-- 				 E.Rule cat _ [E.Lin lbl _] _ <- pInf,
+-- 				 isStartCat cat ]
+	  isFinalEdge (cat, rows) 
+	      = isStartCat cat && 
+		inputBounds inTokens `elem` concat [ rho | (_, M.Rng rho) <- rows ]
+	  chart    = --tracePrt "chart" (prtBefore "\n" . aAssocs) $
+		     tracePrt "#chart" (prt . map (length.snd) . aAssocs) $
+		     PM.parse strategy pInf starters inTokens
+	  inTokens = input $ map AbsGFC.KS $ words inString
+	  pInf     = -- tracePrt "avg rec" (\gr -> show (sum [ length rec | E.Rule _ _ rec _ <- gr ] % length gr)) $
+		     mcfPInfo $ SS.statePInfo gr
+	  starters = tracePrt "startCats" prt $
+		     filter isStartCat $ nubsort [ cat | M.Rule cat _ _ _ <- pInf ]
+	  isStartCat (MCFCat cat _) = cat == startCat
+	  abstract = tracePrt "abstract module" PrGrammar.prt $
+		     SS.absId gr
+
+-- parsing via CFG
+newParser (c:strategy) gr (_, startCat) inString 
+    | c=='c' || c=='C' = trace2 "Parser" "CFG" $ Ok terms
+    where terms    = -- tracePrt "terms" (unlines . map PrGrammar.prt) $
+		     map (ptree2term abstract) trees
+	  trees    = tracePrt "#trees" (prt . length) $
+		     --tracePrt "trees" (prtSep "\n") $
+		     concatMap forest2trees forests
+	  forests  = tracePrt "$cfForests" (prt) $ -- . length) $
+		     tracePrt "forests" (unlines . map prt) $
+		     concatMap convertFromCFForest cfForests
+	  cfForests= tracePrt "cfForests" (unlines . map prt) $
+		     concatMap (chart2forests chart (const False)) finalEdges
+	  finalEdges = tracePrt "finalChartEdges" prt $
+		       map (uncurry Edge (inputBounds inTokens)) starters
+	  chart    = --tracePrt "finalChartEdges" (prt . (? finalEdge)) $
+		     tracePrt "#chart" (prt . map (length.snd) . aAssocs) $
+		     C.edges2chart inTokens edges
+	  edges    = --tracePrt "finalEdges" 
+		     --(prt . filter (\(Edge i j _) -> (i,j)==inputBounds inTokens)) $
+		     tracePrt "#edges" (prt . length) $
+		     PC.parse strategy pInf starters inTokens
+	  inTokens = input $ map AbsGFC.KS $ words inString
+	  pInf     = cfPInfo $ SS.statePInfo gr
+	  starters = tracePrt "startCats" prt $
+		     filter isStartCat $ map fst $ aAssocs $ C.topdownRules pInf
+	  isStartCat (CFCat (MCFCat cat _) _) = cat == startCat
+	  abstract = tracePrt "abstract module" PrGrammar.prt $
+		     SS.absId gr
+		     --ifNull (Ident.identC "ABS") last $ 
+		     --[i | (i, Mods.ModMod m) <- Mods.modules (SS.grammar gr), Mods.isModAbs m]
+
+newParser "" gr start inString = newParser "c" gr start inString
+
+newParser opt gr (_,cat) _ = 
+  Bad ("new-parser '" ++ opt ++ "' not defined yet")
+
+ptree2term :: Ident.Ident -> ParseTree Name -> GF.Term
+ptree2term a (TNode f ts) = Macros.mkApp (Macros.qq (a,f)) (map (ptree2term a) ts)
+ptree2term a (TMeta)      = GF.Meta (GF.MetaSymb 0)
+
+----------------------------------------------------------------------
+-- conversion and unification of forests
+
+convertFromCFForest :: ParseForest CFName -> [ParseForest Name]
+convertFromCFForest (FNode (CFName name profile) children) 
+    | isCoercion name = concat chForests
+    | otherwise       = [ FNode name chForests | not (null chForests) ]
+    where chForests   = concat [ mapM (checkProfile forests) profile |
+				 forests0 <- children,
+				 forests <- mapM convertFromCFForest forests0 ]
+	  checkProfile forests = unifyManyForests . map (forests !!)
+				 -- foldM unifyForests FMeta . map (forests !!)
+
+isCoercion Ident.IW = True
+isCoercion _        = False
+
+unifyManyForests :: Eq n => [ParseForest n] -> [ParseForest n]
+unifyManyForests [] = [FMeta]
+unifyManyForests [f] = [f]
+unifyManyForests (f:g:fs) = do h <- unifyForests f g
+			       unifyManyForests (h:fs)
+
+unifyForests :: Eq n => ParseForest n -> ParseForest n -> [ParseForest n]
+unifyForests FMeta  forest = [forest]
+unifyForests forest FMeta  = [forest]
+unifyForests (FNode name1 children1) (FNode name2 children2)
+    = [ FNode name1 children | name1 == name2, not (null children) ]
+    where children = [ forests | forests1 <- children1, forests2 <- children2,
+		       forests <- zipWithM unifyForests forests1 forests2 ]
+
+
+
+{-
+----------------------------------------------------------------------
+-- conversion and unification for parse trees instead of forests
+
+convertFromCFTree :: ParseTree CFName -> [ParseTree Name]
+convertFromCFTree (TNode (CFName name profile) children0) 
+    = [ TNode name children |
+	children1 <- mapM convertFromCFTree children0,
+	children <- mapM (checkProfile children1) profile ]
+    where checkProfile trees = unifyManyTrees . map (trees !!)
+
+unifyManyTrees :: Eq n => [ParseTree n] -> [ParseTree n]
+unifyManyTrees [] = [TMeta]
+unifyManyTrees [f] = [f]
+unifyManyTrees (f:g:fs) = do h <- unifyTrees f g
+			     unifyManyTrees (h:fs)
+
+unifyTrees TMeta tree = [tree]
+unifyTrees tree TMeta = [tree]
+unifyTrees (TNode name1 children1) (TNode name2 children2)
+    = [ TNode name1 children | name1 == name2, 
+	children <- zipWithM unifyTrees children1 children2 ]
+
+-}
+
--- a/src/GF/Parsing/ParseMCFG.hs
+++ b/src/GF/Parsing/ParseMCFG.hs
@@ -0,0 +1,37 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : ParseMCFG
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/03/21 14:17:43 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.1 $
+--
+-- Main module for MCFG parsing
+-----------------------------------------------------------------------------
+
+
+module GF.Parsing.ParseMCFG (parse) where
+
+import Char (toLower)
+import GF.Parsing.Parser
+import GF.Conversion.MCFGrammar
+import qualified GF.Parsing.MCFParserBasic as PBas
+import GF.Printing.PrintParser
+---- import qualified MCFParserBasic2 as PBas2 -- file not found AR
+
+
+parse :: (Ord n, Ord c, Ord l, Ord t,
+	  Print n, Print c, Print l, Print t) => 
+	 String -> MCFParser n c l t
+parse str = decodeParser (map toLower str)
+
+decodeParser "b"  = PBas.parse
+---- decodeParser "c"  = PBas2.parse
+decodeParser _    = decodeParser "c"
+
+
+
+
--- a/src/GF/Parsing/Parser.hs
+++ b/src/GF/Parsing/Parser.hs
@@ -0,0 +1,187 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Parser
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/03/21 14:17:43 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.1 $
+--
+-- Basic type declarations and functions to be used when parsing
+-----------------------------------------------------------------------------
+
+
+module GF.Parsing.Parser ( -- * Symbols
+		Symbol(..), symbol, mapSymbol,
+		-- * Edges
+		Edge(..),
+		-- * Parser input
+		Input(..), makeInput, input, inputMany,
+		-- * charts, parse forests & trees
+		ParseChart, ParseForest(..), ParseTree(..),
+		chart2forests, forest2trees
+	      ) where
+
+-- haskell modules:
+import Monad
+import Array
+-- gf modules:
+import GF.Data.SortedList
+import GF.Data.Assoc
+-- parsing modules:
+import GF.Printing.PrintParser
+
+------------------------------------------------------------
+-- symbols
+
+data Symbol c t = Cat c | Tok t
+		  deriving (Eq, Ord, Show)
+
+symbol    :: (c -> a) -> (t -> a) -> Symbol c t -> a
+mapSymbol :: (c -> d) -> (t -> u) -> Symbol c t -> Symbol d u
+
+----------
+
+symbol fc ft (Cat cat) = fc cat
+symbol fc ft (Tok tok) = ft tok
+
+mapSymbol fc ft = symbol (Cat . fc) (Tok . ft)
+
+
+------------------------------------------------------------
+-- edges
+
+data Edge s = Edge Int Int s
+	      deriving (Eq, Ord, Show)
+
+instance Functor Edge where
+    fmap f (Edge i j s) = Edge i j (f s)
+
+
+------------------------------------------------------------
+-- parser input 
+
+data Input t = MkInput { inputEdges  :: [Edge t],
+			 inputBounds :: (Int, Int),
+			 inputFrom   :: Array Int (Assoc t [Int]),
+			 inputTo     :: Array Int (Assoc t [Int]),
+			 inputToken  :: Assoc t [(Int, Int)]
+		       }
+
+makeInput :: Ord t => [Edge t] -> Input t
+input     :: Ord t =>  [t]     -> Input t
+inputMany :: Ord t => [[t]]    -> Input t
+
+----------
+
+makeInput inEdges  | null inEdges = input []
+		   | otherwise    = MkInput inEdges inBounds inFrom inTo inToken
+    where inBounds = foldr1 minmax [ (i, j) | Edge i j _ <- inEdges ]
+	      where minmax (a, b) (a', b') = (min a a', max b b')
+	  inFrom   = fmap (accumAssoc id) $ accumArray (<++>) [] inBounds $
+		     [ (i, [(tok, j)]) | Edge i j tok <- inEdges ]
+	  inTo     = fmap (accumAssoc id) $ accumArray (<++>) [] inBounds
+		     [ (j, [(tok, i)]) | Edge i j tok <- inEdges ]
+	  inToken  = accumAssoc id [ (tok, (i, j)) | Edge i j tok <- inEdges ]
+
+input toks         = MkInput inEdges inBounds inFrom inTo inToken
+    where inEdges  = zipWith3 Edge [0..] [1..] toks
+	  inBounds = (0, length toks)
+	  inFrom   = listArray inBounds $
+		     [ listAssoc [(tok, [j])] | (tok, j) <- zip toks [1..] ] ++ [ listAssoc [] ]
+	  inTo     = listArray inBounds $
+		     [ listAssoc [] ] ++ [ listAssoc [(tok, [i])] | (tok, i) <- zip toks [0..] ]
+	  inToken  = accumAssoc id [ (tok, (i, j)) | Edge i j tok <- inEdges ]
+
+inputMany toks     = MkInput inEdges inBounds inFrom inTo inToken
+    where inEdges  = [ Edge i j t | (i, j, ts) <- zip3 [0..] [1..] toks, t <- ts ]
+	  inBounds = (0, length toks)
+	  inFrom   = listArray inBounds $
+		     [ listAssoc [ (t, [j]) | t <- nubsort ts ] | (ts, j) <- zip toks [1..] ]
+		     ++ [ listAssoc [] ]
+	  inTo     = listArray inBounds $
+		     [ listAssoc [] ] ++ 
+		     [ listAssoc [ (t, [i]) | t <- nubsort ts ] | (ts, i) <- zip toks [0..] ]
+	  inToken  = accumAssoc id [ (tok, (i, j)) | Edge i j tok <- inEdges ]
+
+
+------------------------------------------------------------
+-- charts, parse forests & trees
+
+type ParseChart n e = Assoc e [(n, [[e]])]
+
+data ParseForest n = FNode n [[ParseForest n]] | FMeta 
+		     deriving (Eq, Ord, Show)
+
+data ParseTree n = TNode n [ParseTree n] | TMeta 
+		   deriving (Eq, Ord, Show)
+
+chart2forests :: Ord e => ParseChart n e -> (e -> Bool) -> e -> [ParseForest n]
+
+--filterCoercions :: (n -> Bool) -> ParseForest n -> [ParseForest n]
+
+forest2trees :: ParseForest n -> [ParseTree n]
+
+instance Functor ParseTree where
+    fmap f (TNode n trees) = TNode (f n) $ map (fmap f) trees
+    fmap f (TMeta) = TMeta 
+	     
+instance Functor ParseForest where
+    fmap f (FNode n forests) = FNode (f n) $ map (map (fmap f)) forests
+    fmap f (FMeta) = FMeta 
+
+----------
+
+chart2forests chart isMeta = edge2forests
+    where item2forest (name, children) = FNode name $
+					 do edges <- children
+					    mapM edge2forests edges 
+          edge2forests edge 
+	      | isMeta     edge = [FMeta]
+	      | otherwise       = filter checkForest $ map item2forest $ chart ? edge
+	  checkForest (FNode _ children) = not (null children)
+
+-- filterCoercions _ (FMeta) = [FMeta]
+-- filterCoercions isCoercion (FNode s forests) 
+--     | isCoercion s = do [forest] <- forests ; filterCoercions isCoercion forest
+--     | otherwise    = FNode s $ do children <- forests ; mapM (filterCoercions isCoercion)
+
+forest2trees (FNode s forests) = map (TNode s) $ forests >>= mapM forest2trees
+forest2trees (FMeta) = [TMeta]
+
+
+
+------------------------------------------------------------
+-- pretty-printing
+
+instance (Print c, Print t) => Print (Symbol c t) where
+    prt = symbol prt (simpleShow.prt)
+    prtList = prtSep " "
+
+simpleShow :: String -> String
+simpleShow s = "\"" ++ concatMap mkEsc s ++ "\""
+    where
+    mkEsc :: Char -> String
+    mkEsc c = case c of
+		     _ | elem c "\\\"" -> '\\' : [c]
+		     '\n' -> "\\n"
+		     '\t' -> "\\t"
+		     _ -> [c]
+
+instance (Print s) => Print (Edge s) where
+    prt (Edge i j s) = "[" ++ show i ++ "-" ++ show j ++ ": " ++ prt s ++ "]"
+    prtList = prtSep ""
+
+instance (Print s) => Print (ParseTree s) where
+    prt (TNode s trees) = prt s ++ "^{" ++ prtSep " " trees ++ "}"
+    prt (TMeta) = "?"
+    prtList = prtAfter "\n"
+
+instance (Print s) => Print (ParseForest s) where
+    prt (FNode s forests) = prt s ++ "^{" ++ prtSep " | " (map (prtSep " ") forests) ++ "}"
+    prt (FMeta) = "?"
+    prtList = prtAfter "\n"
+
+
--- a/src/GF/Printing/PrintParser.hs
+++ b/src/GF/Printing/PrintParser.hs
@@ -0,0 +1,79 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : PrintParser
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/03/21 14:17:44 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.1 $
+--
+-- Pretty-printing of parser objects
+-----------------------------------------------------------------------------
+
+module GF.Printing.PrintParser (Print(..),
+		    prtBefore, prtAfter, prtSep, 
+		    prtBeforeAfter,
+		    prIO
+		   ) where
+
+-- haskell modules:
+import List (intersperse)
+-- gf modules:
+import Operations (Err(..))
+import Ident (Ident(..))
+import qualified PrintGFC as P
+
+------------------------------------------------------------
+
+prtBefore :: Print a => String -> [a] -> String
+prtBefore before = prtBeforeAfter before ""
+
+prtAfter :: Print a => String -> [a] -> String
+prtAfter after = prtBeforeAfter "" after
+
+prtSep :: Print a => String -> [a] -> String
+prtSep sep = concat . intersperse sep . map prt
+
+prtBeforeAfter :: Print a => String -> String -> [a] -> String
+prtBeforeAfter before after as = concat [ before ++ prt a ++ after | a <- as ]
+
+prIO :: Print a => a -> IO ()
+prIO = putStr . prt
+
+class Print a where
+    prt :: a -> String
+    prtList :: [a] -> String
+    prtList as = "[" ++ prtSep "," as ++ "]"
+
+instance Print a => Print [a] where
+    prt = prtList
+
+instance (Print a, Print b) => Print (a, b) where
+    prt (a, b) = "(" ++ prt a ++ "," ++ prt b ++ ")"
+
+instance (Print a, Print b, Print c) => Print (a, b, c) where
+    prt (a, b, c) = "(" ++ prt a ++ "," ++ prt b ++ "," ++ prt c ++ ")"
+
+instance (Print a, Print b, Print c, Print d) => Print (a, b, c, d) where
+    prt (a, b, c, d) = "(" ++ prt a ++ "," ++ prt b ++ "," ++ prt c ++ "," ++ prt d ++ ")"
+
+instance Print Char where
+    prt = return
+    prtList = id
+
+instance Print Int where
+    prt = show
+
+instance Print Integer where
+    prt = show
+
+instance Print a => Print (Err a) where
+    prt (Ok a) = prt a
+    prt (Bad str) = str
+
+instance Print Ident where
+    prt ident = str
+	where str = P.printTree ident
+
--- a/src/GF/Printing/PrintSimplifiedTerm.hs
+++ b/src/GF/Printing/PrintSimplifiedTerm.hs
@@ -0,0 +1,122 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : PrintSimplifiedTerm
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/03/21 14:17:44 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.1 $
+--
+-- Instances for printing terms in a simplified format
+-----------------------------------------------------------------------------
+
+
+module GF.Printing.PrintSimplifiedTerm () where
+
+import AbsGFC
+import CF
+import CFIdent
+import GF.Printing.PrintParser
+
+instance Print Term where
+    prt (Arg arg)         = prt arg
+    prt (con `Con` [])    = prt con
+    prt (con `Con` terms) = prt con ++ "(" ++ prtSep ", " terms ++ ")"
+    prt (LI ident)        = prt ident
+    prt (R record)        = "{" ++ prtSep ";" record ++ "}"
+    prt (term `P` lbl)    = prt term ++ "." ++ prt lbl
+    prt (T _ table)       = "table{" ++ prtSep ";" table ++ "}"
+    prt (term `S` sel)    = prt term ++ "!" ++ prt sel
+    prt (FV terms)        = "variants{" ++ prtSep "|" terms ++ "}"
+    prt (term `C` term')  = prt term ++ "  " ++ prt term'
+    prt (K tokn)          = show (prt tokn)
+    prt (E)               = show ""
+
+instance Print Patt where
+    prt (con `PC` [])     = prt con
+    prt (con `PC` pats)   = prt con ++ "(" ++ prtSep "," pats ++ ")"
+    prt (PV ident)        = prt ident
+    prt (PW)              = "_"
+    prt (PR record)       = "{" ++ prtSep ";" record ++ "}"
+
+instance Print Label where
+    prt (L ident)          = prt ident
+    prt (LV nr)            = "$" ++ show nr
+
+instance Print Tokn where
+    prt (KS str)          = str
+    prt tokn@(KP _ _)     = show tokn
+
+instance Print ArgVar where
+    prt (A cat argNr)     = prt cat ++ "#" ++ show argNr
+
+instance Print CIdent where
+    prt (CIQ _ ident)     = prt ident
+
+instance Print Case where
+    prt (pats `Cas` term) = prtSep "|" pats ++ "=>" ++ prt term
+
+instance Print Assign where
+    prt (lbl `Ass` term)  = prt lbl ++ "=" ++ prt term
+
+instance Print PattAssign where
+    prt (lbl `PAss` pat)  = prt lbl ++ "=" ++ prt pat
+
+instance Print Atom where
+    prt (AC c) = prt c
+    prt (AD c) = "<" ++ prt c ++ ">"
+    prt (AV i) = "$" ++ prt i
+    prt (AM n) = "?" ++ show n
+    prt (AS s) = show s
+    prt (AI n) = show n
+    prt (AT s) = show s
+
+instance Print CType where
+    prt (RecType rtype) = "{" ++ prtSep ";" rtype ++ "}"
+    prt (Table ptype vtype) = "(" ++ prt ptype ++ "=>" ++ prt vtype ++ ")"
+    prt (Cn cn) = prt cn
+    prt (TStr) = "Str"
+
+instance Print Labelling where
+    prt (lbl `Lbg` ctype) = prt lbl ++ ":" ++ prt ctype
+
+instance Print CFItem where
+    prt (CFTerm regexp) = prt regexp
+    prt (CFNonterm cat) = prt cat
+
+instance Print RegExp where
+    prt (RegAlts words) = "("++prtSep "|" words ++ ")"
+    prt (RegSpec tok) = prt tok
+
+instance Print CFTok where
+    prt (TS str) = str
+    prt tok = show tok
+
+instance Print CFCat where
+    prt (CFCat (cid,lbl)) = prt cid ++ "-" ++ prt lbl
+
+instance Print CFFun where 
+    prt (CFFun fun) = prt (fst fun)
+
+sizeCT :: CType -> Int
+sizeCT (RecType rt) = 1 + sum [ sizeCT t | _ `Lbg` t <- rt ]
+sizeCT (Table pt vt) = 1 + sizeCT pt + sizeCT vt
+sizeCT (Cn cn) = 1
+sizeCT (TStr) = 1
+
+sizeT :: Term -> Int
+sizeT (_ `Con` ts) = 2 + sum (map sizeT ts)
+sizeT (R rec) = 1 + sum [ sizeT t | _ `Ass` t <- rec ]
+sizeT (t `P` _) = 1 + sizeT t
+sizeT (T _ tbl) = 1 + sum [ sum (map sizeP ps) + sizeT t | ps `Cas` t <- tbl ]
+sizeT (t `S` s) = 1 + sizeT t + sizeT s
+sizeT (t `C` t') = 1 + sizeT t + sizeT t'
+sizeT (FV ts) = 1 + sum (map sizeT ts)
+sizeT _ = 1
+
+sizeP :: Patt -> Int
+sizeP (con `PC` pats) = 2 + sum (map sizeP pats)
+sizeP (PR record)     = 1 + sum [ sizeP p | _ `PAss` p <- record ]
+sizeP _ = 1
--- a/src/GF/Speech/PrGSL.hs
+++ b/src/GF/Speech/PrGSL.hs
@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
-- > CVS $Date: 2005/03/21 13:54:44 $ 
+-- > CVS $Date: 2005/03/21 14:17:44 $ 
 -- > CVS $Author: peb $
-- > CVS $Revision: 1.12 $
+-- > CVS $Revision: 1.13 $
 --
 -- This module prints a CFG as a Nuance GSL 2.0 grammar.
 --
@@ -22,7 +22,7 @@ import Ident
 import GF.Conversion.CFGrammar
 import GF.Parsing.Parser (Symbol(..))
 import GF.Conversion.GrammarTypes
-import GF.Parsing.PrintParser
+import GF.Printing.PrintParser
 import Option

 import Data.Char (toUpper,toLower)
--- a/src/GF/Speech/PrJSGF.hs
+++ b/src/GF/Speech/PrJSGF.hs
@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
-- > CVS $Date: 2005/03/21 13:54:44 $ 
+-- > CVS $Date: 2005/03/21 14:17:44 $ 
 -- > CVS $Author: peb $
-- > CVS $Revision: 1.6 $
+-- > CVS $Revision: 1.7 $
 --
 -- This module prints a CFG as a JSGF grammar.
 --
@@ -24,7 +24,7 @@ import Ident
 import GF.Conversion.CFGrammar
 import GF.Parsing.Parser (Symbol(..))
 import GF.Conversion.GrammarTypes
-import GF.Parsing.PrintParser
+import GF.Printing.PrintParser
 import Option

 jsgfPrinter :: Ident -- ^ Grammar name
--- a/src/GF/Speech/SRG.hs
+++ b/src/GF/Speech/SRG.hs
@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
-- > CVS $Date: 2005/03/21 13:54:44 $ 
+-- > CVS $Date: 2005/03/21 14:17:44 $ 
 -- > CVS $Author: peb $
-- > CVS $Revision: 1.8 $
+-- > CVS $Revision: 1.9 $
 --
 -- Representation of, conversion to, and utilities for 
 -- printing of a general Speech Recognition Grammar. 
@@ -24,7 +24,7 @@ import Ident
 import GF.Conversion.CFGrammar
 import GF.Parsing.Parser (Symbol(..))
 import GF.Conversion.GrammarTypes
-import GF.Parsing.PrintParser
+import GF.Printing.PrintParser
 import TransformCFG
 import Option

--- a/src/GF/Speech/TransformCFG.hs
+++ b/src/GF/Speech/TransformCFG.hs
@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
-- > CVS $Date: 2005/03/21 13:54:44 $ 
+-- > CVS $Date: 2005/03/21 14:17:45 $ 
 -- > CVS $Author: peb $
-- > CVS $Revision: 1.6 $
+-- > CVS $Revision: 1.7 $
 --
 --  This module does some useful transformations on CFGs.
 --
@@ -20,7 +20,7 @@ import Ident
 import GF.Conversion.CFGrammar
 import GF.Parsing.Parser (Symbol(..))
 import GF.Conversion.GrammarTypes
-import GF.Parsing.PrintParser
+import GF.Printing.PrintParser

 import Data.FiniteMap
 import Data.List
--- a/src/GF/UseGrammar/Custom.hs
+++ b/src/GF/UseGrammar/Custom.hs
@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
-- > CVS $Date: 2005/03/21 13:54:44 $ 
+-- > CVS $Date: 2005/03/21 14:17:45 $ 
 -- > CVS $Author: peb $
-- > CVS $Revision: 1.45 $
+-- > CVS $Revision: 1.46 $
 --
 -- A database for customizable GF shell commands. 
 --
@@ -74,7 +74,7 @@ import qualified GF.Parsing.ParseCF as PCF
 -- grammar conversions -- peb 19/4-04
 -- see also customGrammarPrinter
 import qualified GF.Conversion.ConvertGrammar as Cnv
-import qualified GF.Parsing.PrintParser as Prt
+import qualified GF.Printing.PrintParser as Prt

 import GFC
 import qualified MkGFC as MC