msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

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

Browse Source
This commit is contained in:
krasimir
2008-05-29 11:20:40 +00:00
parent bc578a0871
commit 4d1809ef2d
5 changed files with 40 additions and 115 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
GF.cabal
View File

@@ -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

91
src-3.0/GF/Formalism/Utilities.hs
View File

@@ -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)

11
src-3.0/GF/Parsing/FCFG/Active.hs
View File

@@ -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

1
src-3.0/GF/Parsing/FCFG/PInfo.hs
View File

@@ -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

50
src-3.0/GF/Parsing/FCFG/Range.hs
View File

@@ -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) = "(?)"