summaryrefslogtreecommitdiff
path: root/src/runtime/haskell/PGF/Parsing/FCFG/Utilities.hs
diff options
context:
space:
mode:
authorkrasimir <krasimir@chalmers.se>2009-12-14 10:54:22 +0000
committerkrasimir <krasimir@chalmers.se>2009-12-14 10:54:22 +0000
commitc036459214852ca01868f5da81408f49b22a49e9 (patch)
tree72a767680911cba272a033b07fc750c0d4f1d0d3 /src/runtime/haskell/PGF/Parsing/FCFG/Utilities.hs
parentfaa638d6fc5dbc47d5e3ef3d4da42449005c3a0d (diff)
remove the old parsing code and the -erasing=on flag
Diffstat (limited to 'src/runtime/haskell/PGF/Parsing/FCFG/Utilities.hs')
-rw-r--r--src/runtime/haskell/PGF/Parsing/FCFG/Utilities.hs188
1 files changed, 0 insertions, 188 deletions
diff --git a/src/runtime/haskell/PGF/Parsing/FCFG/Utilities.hs b/src/runtime/haskell/PGF/Parsing/FCFG/Utilities.hs
deleted file mode 100644
index dc0b2dc4a..000000000
--- a/src/runtime/haskell/PGF/Parsing/FCFG/Utilities.hs
+++ /dev/null
@@ -1,188 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Maintainer : PL
--- Stability : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/05/13 12:40:19 $
--- > CVS $Author: peb $
--- > CVS $Revision: 1.6 $
---
--- Basic type declarations and functions for grammar formalisms
------------------------------------------------------------------------------
-
-
-module PGF.Parsing.FCFG.Utilities where
-
-import Control.Monad
-import Data.Array
-import Data.List (groupBy)
-
-import PGF.CId
-import PGF.Data
-import PGF.Tree
-import GF.Data.Assoc
-import GF.Data.Utilities (sameLength, foldMerge, splitBy)
-
-
-------------------------------------------------------------
--- ranges as single pairs
-
-type RangeRec = [Range]
-
-data Range = Range {-# UNPACK #-} !Int {-# UNPACK #-} !Int
- | EmptyRange
- deriving (Eq, Ord, Show)
-
-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 { inputBounds :: (Int, Int),
- inputToken :: Assoc t [Range]
- }
-
-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 ]
-
-
-------------------------------------------------------------
--- * representations of syntactical analyses
-
--- ** charts as finite maps over edges
-
--- | The values of the chart, a list of key-daughters pairs,
--- has unique keys. In essence, it is a map from 'n' to daughters.
--- The daughters should be a set (not necessarily sorted) of rhs's.
-type SyntaxChart n e = Assoc e [SyntaxNode n [e]]
-
-data SyntaxNode n e = SMeta
- | SNode n [e]
- | SString String
- | SInt Integer
- | SFloat Double
- deriving (Eq,Ord,Show)
-
-groupSyntaxNodes :: Ord n => [SyntaxNode n e] -> [SyntaxNode n [e]]
-groupSyntaxNodes [] = []
-groupSyntaxNodes (SNode n0 es0:xs) = (SNode n0 (es0:ess)) : groupSyntaxNodes xs'
- where
- (ess,xs') = span xs
-
- span [] = ([],[])
- span xs@(SNode n es:xs')
- | n0 == n = let (ess,xs) = span xs' in (es:ess,xs)
- | otherwise = ([],xs)
-groupSyntaxNodes (SString s:xs) = (SString s) : groupSyntaxNodes xs
-groupSyntaxNodes (SInt n:xs) = (SInt n) : groupSyntaxNodes xs
-groupSyntaxNodes (SFloat f:xs) = (SFloat f) : groupSyntaxNodes xs
-
--- ** syntax forests
-
-data SyntaxForest n = FMeta
- | FNode n [[SyntaxForest n]]
- -- ^ The outer list should be a set (not necessarily sorted)
- -- of possible alternatives. Ie. the outer list
- -- is a disjunctive node, and the inner lists
- -- are (conjunctive) concatenative nodes
- | FString String
- | FInt Integer
- | FFloat Double
- deriving (Eq, Ord, Show)
-
-instance Functor SyntaxForest where
- fmap f (FNode n forests) = FNode (f n) $ map (map (fmap f)) forests
- fmap _ (FString s) = FString s
- fmap _ (FInt n) = FInt n
- fmap _ (FFloat f) = FFloat f
- fmap _ (FMeta) = FMeta
-
-forestName :: SyntaxForest n -> Maybe n
-forestName (FNode n _) = Just n
-forestName _ = Nothing
-
-unifyManyForests :: (Monad m, Eq n) => [SyntaxForest n] -> m (SyntaxForest n)
-unifyManyForests = foldM unifyForests FMeta
-
--- | two forests can be unified, if either is 'FMeta', or both have the same parent,
--- and all children can be unified
-unifyForests :: (Monad m, Eq n) => SyntaxForest n -> SyntaxForest n -> m (SyntaxForest n)
-unifyForests FMeta forest = return forest
-unifyForests forest FMeta = return forest
-unifyForests (FNode name1 children1) (FNode name2 children2)
- | name1 == name2 && not (null children) = return $ FNode name1 children
- where children = [ forests | forests1 <- children1, forests2 <- children2,
- sameLength forests1 forests2,
- forests <- zipWithM unifyForests forests1 forests2 ]
-unifyForests (FString s1) (FString s2)
- | s1 == s2 = return $ FString s1
-unifyForests (FInt n1) (FInt n2)
- | n1 == n2 = return $ FInt n1
-unifyForests (FFloat f1) (FFloat f2)
- | f1 == f2 = return $ FFloat f1
-unifyForests _ _ = fail "forest unification failure"
-
-
--- ** conversions between representations
-
-chart2forests :: (Ord n, Ord e) =>
- SyntaxChart n e -- ^ The complete chart
- -> (e -> Bool) -- ^ When is an edge 'FMeta'?
- -> [e] -- ^ The starting edges
- -> [SyntaxForest n] -- ^ The result has unique keys, ie. all 'n' are joined together.
- -- In essence, the result is a map from 'n' to forest daughters
-chart2forests chart isMeta = concatMap (edge2forests [])
- where edge2forests edges edge
- | isMeta edge = [FMeta]
- | edge `elem` edges = []
- | otherwise = map (item2forest (edge:edges)) $ chart ? edge
- item2forest edges (SMeta) = FMeta
- item2forest edges (SNode name children) =
- FNode name $ children >>= mapM (edge2forests edges)
- item2forest edges (SString s) = FString s
- item2forest edges (SInt n) = FInt n
- item2forest edges (SFloat f) = FFloat f
-
-
-applyProfileToForest :: SyntaxForest (CId,[Profile]) -> [SyntaxForest CId]
-applyProfileToForest (FNode (fun,profiles) children)
- | fun == wildCId = concat chForests
- | otherwise = [ FNode fun chForests | not (null chForests) ]
- where chForests = concat [ mapM (unifyManyForests . map (forests !!)) profiles |
- forests0 <- children,
- forests <- mapM applyProfileToForest forests0 ]
-applyProfileToForest (FString s) = [FString s]
-applyProfileToForest (FInt n) = [FInt n]
-applyProfileToForest (FFloat f) = [FFloat f]
-applyProfileToForest (FMeta) = [FMeta]
-
-
-forest2trees :: SyntaxForest CId -> [Tree]
-forest2trees (FNode n forests) = map (Fun n) $ forests >>= mapM forest2trees
-forest2trees (FString s) = [Lit (LStr s)]
-forest2trees (FInt n) = [Lit (LInt n)]
-forest2trees (FFloat f) = [Lit (LFlt f)]
-forest2trees (FMeta) = [Meta 0]