Simplify the Input type. Remove Edge and use only Range type

4 files changed, 41 insertions, 114 deletions

diff --git a/src-3.0/GF/Formalism/Utilities.hs b/src-3.0/GF/Formalism/Utilities.hs
index 37e9d1577..de54e98a4 100644
--- a/src-3.0/GF/Formalism/Utilities.hs
+++ b/src-3.0/GF/Formalism/Utilities.hs
@@ -24,64 +24,49 @@ import GF.Data.Utilities (sameLength, foldMerge, splitBy)
 
 import GF.Infra.PrintClass
 
+
 ------------------------------------------------------------
--- * edges
+-- ranges as single pairs
+
+type RangeRec = [Range]
+
+data Range = Range {-# UNPACK #-} !Int {-# UNPACK #-} !Int
+	   | EmptyRange
+             deriving (Eq, Ord)
+
+makeRange :: Int -> Int -> Range
+makeRange = Range 
+
+concatRange :: Range -> Range -> [Range]
+concatRange EmptyRange  rng          = return rng
+concatRange rng         EmptyRange   = return rng
+concatRange (Range i j) (Range j' k) = [Range i k | j==j']
 
-data Edge s = Edge Int Int s
-	      deriving (Eq, Ord, Show)
+minRange :: Range -> Int
+minRange (Range i j) = i
 
-instance Functor Edge where
-    fmap f (Edge i j s) = Edge i j (f s)
+maxRange :: Range -> Int
+maxRange (Range i j) = j
 
 
 ------------------------------------------------------------
 -- * representaions of input tokens
 
-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)]
+data Input t = MkInput { inputBounds :: (Int, Int),
+			 inputToken  :: Assoc t [Range]
 		       }
 
-makeInput :: Ord t => [Edge t] -> Input t
-input     :: Ord t =>  [t]     -> Input t
-inputMany :: Ord t => [[t]]    -> Input t
-
-instance Show t => Show (Input t) where
-    show input = "makeInput " ++ show (inputEdges input)
-
-----------
-
-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 ]
+input     :: Ord t => [t] -> Input t
+input toks = MkInput inBounds inToken
+  where
+    inBounds = (0, length toks)
+    inToken  = accumAssoc id [ (tok, makeRange i j) | (i,j,tok) <- zip3 [0..] [1..] toks ]
+
+inputMany :: Ord t => [[t]] -> Input t
+inputMany toks = MkInput inBounds inToken
+  where
+    inBounds = (0, length toks)
+    inToken  = accumAssoc id [ (tok, makeRange i j) | (i,j,ts) <- zip3 [0..] [1..] toks, tok <- ts ]
 
 
 ------------------------------------------------------------
@@ -287,19 +272,13 @@ forest2trees (FInt    n) = [TInt    n]
 forest2trees (FFloat  f) = [TFloat  f]
 forest2trees (FMeta)     = [TMeta]
 
-----------------------------------------------------------------------
--- * profiles
-
-
 ------------------------------------------------------------
 -- pretty-printing
 
-instance Print t => Print (Input t) where
-    prt input = "input " ++ prt (inputEdges input)
+instance Print Range where
+    prt (Range i j)  = "(" ++ show i ++ "-" ++ show j ++ ")"
+    prt (EmptyRange) = "(?)"
 
-instance (Print s) => Print (Edge s) where
-    prt (Edge i j s) = "[" ++ show i ++ "-" ++ show j ++ ": " ++ prt s ++ "]"
-    prtList = prtSep ""
 
 instance (Print s) => Print (SyntaxTree s) where
     prt (TNode s trees)
diff --git a/src-3.0/GF/Parsing/FCFG/Active.hs b/src-3.0/GF/Parsing/FCFG/Active.hs
index 498054eee..9d4a0ac0c 100644
--- a/src-3.0/GF/Parsing/FCFG/Active.hs
+++ b/src-3.0/GF/Parsing/FCFG/Active.hs
@@ -20,7 +20,6 @@ import GF.Formalism.Utilities
 
 import GF.Infra.PrintClass
 
-import GF.Parsing.FCFG.Range
 import GF.Parsing.FCFG.PInfo
 
 import Control.Monad (guard)
@@ -69,8 +68,8 @@ process strategy pinfo toks ((c,item):items) chart = process strategy pinfo toks
 	     			found' -> let items = do rng  <- concatRange rng (found' !! r)
 	     			                         return (c, Active found rng lbl (ppos+1) node)
 	     			          in process strategy pinfo toks items chart
-	     FSymTok tok   -> let items = do (i,j) <- inputToken toks ? tok
-	                                     rng' <- concatRange rng (makeRange i j)
+	     FSymTok tok   -> let items = do t_rng <- inputToken toks ? tok
+	                                     rng' <- concatRange rng t_rng
 	                                     return (cat, Active found rng' lbl (ppos+1) node)
                               in process strategy pinfo toks items chart
       | otherwise =
@@ -143,7 +142,7 @@ xchart2syntaxchart (XChart actives finals) pinfo =
 
 literals :: FCFPInfo -> Input FToken -> [(FCat,Item)]
 literals pinfo toks =
-  [let (c,node) = lexer t in (c,Final [makeRange i j] node) | Edge i j t <- inputEdges toks, not (t `elem` grammarToks pinfo)]
+  [let (c,node) = lexer t in (c,Final [rng] node) | (t,rngs) <- aAssocs (inputToken toks), rng <- rngs, not (t `elem` grammarToks pinfo)]
   where
     lexer t =
       case reads t of
@@ -172,8 +171,8 @@ initialBU pinfo toks =
     do (tok,rngs) <- aAssocs (inputToken toks)
        ruleid <- leftcornerTokens pinfo ? tok
        let FRule _ _ _ cat _ = allRules pinfo ! ruleid
-       (i,j) <- rngs
-       return (cat,Active [] (makeRange i j) 0 1 (emptyChildren ruleid pinfo))
+       rng <- rngs
+       return (cat,Active [] rng 0 1 (emptyChildren ruleid pinfo))
     ++
     do ruleid <- epsilonRules pinfo
        let FRule _ _ _ cat _ = allRules pinfo ! ruleid
diff --git a/src-3.0/GF/Parsing/FCFG/PInfo.hs b/src-3.0/GF/Parsing/FCFG/PInfo.hs
index dc934c1e5..08d40df85 100644
--- a/src-3.0/GF/Parsing/FCFG/PInfo.hs
+++ b/src-3.0/GF/Parsing/FCFG/PInfo.hs
@@ -14,7 +14,6 @@ import GF.Formalism.Utilities
 import GF.Formalism.FCFG
 import GF.Data.SortedList
 import GF.Data.Assoc
-import GF.Parsing.FCFG.Range
 import GF.GFCC.CId
 
 import Data.Array
diff --git a/src-3.0/GF/Parsing/FCFG/Range.hs b/src-3.0/GF/Parsing/FCFG/Range.hs
deleted file mode 100644
index 24674f58b..000000000
--- a/src-3.0/GF/Parsing/FCFG/Range.hs
+++ /dev/null
@@ -1,50 +0,0 @@
----------------------------------------------------------------------
--- |
--- Maintainer  : Krasimir Angelov
--- Stability   : (stable)
--- Portability : (portable)
---
--- Definitions of ranges, and operations on ranges
------------------------------------------------------------------------------
-
-module GF.Parsing.FCFG.Range
-    ( RangeRec, Range(..), makeRange, concatRange, rangeEdge, edgeRange, minRange, maxRange,
-    ) where
-
-
--- GF modules
-import GF.Formalism.Utilities
-import GF.Infra.PrintClass
-
-------------------------------------------------------------
--- ranges as single pairs
-
-type RangeRec = [Range]
-
-data Range = Range {-# UNPACK #-} !Int {-# UNPACK #-} !Int
-	   | EmptyRange
-             deriving (Eq, Ord)
-
-makeRange :: Int -> Int -> Range
-makeRange = Range 
-
-concatRange :: Range -> Range -> [Range]
-concatRange EmptyRange  rng          = return rng
-concatRange rng         EmptyRange   = return rng
-concatRange (Range i j) (Range j' k) = [Range i k | j==j']
-
-rangeEdge :: a -> Range -> Edge a
-rangeEdge a (Range i j) = Edge i j a
-
-edgeRange :: Edge a -> Range
-edgeRange (Edge i j _) = Range i j
-
-minRange :: Range -> Int
-minRange (Range i j) = i
-
-maxRange :: Range -> Int
-maxRange (Range i j) = j
-
-instance Print Range where
-    prt (Range i j)  = "(" ++ show i ++ "-" ++ show j ++ ")"
-    prt (EmptyRange) = "(?)"