From 4d1809ef2d824eb6e80fc1bf1d0f5e0aaf23ec16 Mon Sep 17 00:00:00 2001 From: krasimir Date: Thu, 29 May 2008 11:20:40 +0000 Subject: [PATCH] Simplify the Input type. Remove Edge and use only Range type --- GF.cabal | 2 - src-3.0/GF/Formalism/Utilities.hs | 91 ++++++++++++------------------- src-3.0/GF/Parsing/FCFG/Active.hs | 11 ++-- src-3.0/GF/Parsing/FCFG/PInfo.hs | 1 - src-3.0/GF/Parsing/FCFG/Range.hs | 50 ----------------- 5 files changed, 40 insertions(+), 115 deletions(-) delete mode 100644 src-3.0/GF/Parsing/FCFG/Range.hs diff --git a/GF.cabal b/GF.cabal index 7dc2e39ee..ed2fadda6 100644 --- a/GF.cabal +++ b/GF.cabal @@ -46,7 +46,6 @@ library GF.Data.Assoc GF.Infra.PrintClass GF.Formalism.Utilities - GF.Parsing.FCFG.Range GF.Formalism.FCFG GF.Parsing.FCFG.PInfo GF.Parsing.FCFG.Active @@ -101,7 +100,6 @@ executable gf3 GF.GFCC.Raw.ParGFCCRaw GF.GFCC.Raw.PrintGFCCRaw GF.Formalism.Utilities - GF.Parsing.FCFG.Range GF.Formalism.FCFG GF.Parsing.FCFG.PInfo GF.GFCC.DataGFCC 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 -data Edge s = Edge Int Int s - deriving (Eq, Ord, Show) +type RangeRec = [Range] -instance Functor Edge where - fmap f (Edge i j s) = Edge i j (f s) +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'] + +minRange :: Range -> Int +minRange (Range i j) = i + +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 +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 ] -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 ] +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) = "(?)"