From 3d2ce9216dee57f9639e7727dba7626c8ca1dd65 Mon Sep 17 00:00:00 2001 From: krasimir Date: Fri, 30 May 2008 07:23:00 +0000 Subject: [PATCH] don't need SyntaxTree anymore. Use PGF.Data.Exp directly --- src-3.0/PGF/Parsing/FCFG.hs | 29 +----- src-3.0/PGF/Parsing/FCFG/Utilities.hs | 126 +++++--------------------- 2 files changed, 22 insertions(+), 133 deletions(-) diff --git a/src-3.0/PGF/Parsing/FCFG.hs b/src-3.0/PGF/Parsing/FCFG.hs index 64421a0c4..81fc6a3e4 100644 --- a/src-3.0/PGF/Parsing/FCFG.hs +++ b/src-3.0/PGF/Parsing/FCFG.hs @@ -43,36 +43,9 @@ parseFCF strategy pinfo startCat inString = finalEdges = [makeFinalEdge cat i j | cat <- startCats] forests = chart2forests chart (const False) finalEdges filteredForests = forests >>= applyProfileToForest - trees = nubsort $ filteredForests >>= forest2trees - return $ map tree2term trees + return $ nubsort $ filteredForests >>= forest2exps where parseFCF :: String -> Err (FCFParser) parseFCF "bottomup" = Ok $ parse "b" parseFCF "topdown" = Ok $ parse "t" parseFCF strat = Bad $ "FCFG parsing strategy not defined: " ++ strat - ----------------------------------------------------------------------- --- parse trees to GFCC terms - -tree2term :: SyntaxTree CId -> Exp -tree2term (TNode f ts) = tree (AC f) (map tree2term ts) -tree2term (TString s) = tree (AS s) [] -tree2term (TInt n) = tree (AI n) [] -tree2term (TFloat f) = tree (AF f) [] -tree2term (TMeta) = exp0 - ----------------------------------------------------------------------- --- conversion and unification of forests - --- simplest implementation -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] diff --git a/src-3.0/PGF/Parsing/FCFG/Utilities.hs b/src-3.0/PGF/Parsing/FCFG/Utilities.hs index f28311bdd..b33d5ccaa 100644 --- a/src-3.0/PGF/Parsing/FCFG/Utilities.hs +++ b/src-3.0/PGF/Parsing/FCFG/Utilities.hs @@ -18,7 +18,8 @@ import Control.Monad import Data.Array import Data.List (groupBy) -import GF.Data.SortedList +import PGF.CId +import PGF.Data import GF.Data.Assoc import GF.Data.Utilities (sameLength, foldMerge, splitBy) @@ -98,12 +99,6 @@ groupSyntaxNodes (SString s:xs) = (SString s) : groupSyntaxNodes xs groupSyntaxNodes (SInt n:xs) = (SInt n) : groupSyntaxNodes xs groupSyntaxNodes (SFloat f:xs) = (SFloat f) : groupSyntaxNodes xs --- better(?) representation of forests: --- data Forest n = F (SMap n (SList [Forest n])) Bool --- == --- type Forest n = GeneralTrie n (SList [Forest n]) Bool --- (the Bool == isMeta) - -- ** syntax forests data SyntaxForest n = FMeta @@ -149,67 +144,6 @@ unifyForests (FFloat f1) (FFloat f2) | f1 == f2 = return $ FFloat f1 unifyForests _ _ = fail "forest unification failure" -{- måste tänka mer på detta: -compactForests :: Ord n => [SyntaxForest n] -> SList (SyntaxForest n) -compactForests = map joinForests . groupBy eqNames . sortForests - where eqNames f g = forestName f == forestName g - sortForests = foldMerge mergeForests [] . map return - mergeForests [] gs = gs - mergeForests fs [] = fs - mergeForests fs@(f:fs') gs@(g:gs') - = case forestName f `compare` forestName g of - LT -> f : mergeForests fs' gs - GT -> g : mergeForests fs gs' - EQ -> f : g : mergeForests fs' gs' - joinForests fs = case forestName (head fs) of - Nothing -> FMeta - Just name -> FNode name $ - compactDaughters $ - concat [ fss | FNode _ fss <- fs ] - compactDaughters fss = case head fss of - [] -> [[]] - [_] -> map return $ compactForests $ concat fss - _ -> nubsort fss --} - --- ** syntax trees - -data SyntaxTree n = TMeta - | TNode n [SyntaxTree n] - | TString String - | TInt Integer - | TFloat Double - deriving (Eq, Ord, Show) - -instance Functor SyntaxTree where - fmap f (TNode n trees) = TNode (f n) $ map (fmap f) trees - fmap _ (TString s) = TString s - fmap _ (TInt n) = TInt n - fmap _ (TFloat f) = TFloat f - fmap _ (TMeta) = TMeta - -treeName :: SyntaxTree n -> Maybe n -treeName (TNode n _) = Just n -treeName (TMeta) = Nothing - -unifyManyTrees :: (Monad m, Eq n) => [SyntaxTree n] -> m (SyntaxTree n) -unifyManyTrees = foldM unifyTrees TMeta - --- | two trees can be unified, if either is 'TMeta', --- or both have the same parent, and their children can be unified -unifyTrees :: (Monad m, Eq n) => SyntaxTree n -> SyntaxTree n -> m (SyntaxTree n) -unifyTrees TMeta tree = return tree -unifyTrees tree TMeta = return tree -unifyTrees (TNode name1 children1) (TNode name2 children2) - | name1 == name2 && sameLength children1 children2 - = liftM (TNode name1) $ zipWithM unifyTrees children1 children2 -unifyTrees (TString s1) (TString s2) - | s1 == s2 = return (TString s1) -unifyTrees (TInt n1) (TInt n2) - | n1 == n2 = return (TInt n1) -unifyTrees (TFloat f1) (TFloat f2) - | f1 == f2 = return (TFloat f1) -unifyTrees _ _ = fail "tree unification failure" -- ** conversions between representations @@ -217,11 +151,8 @@ chart2forests :: (Ord n, Ord e) => SyntaxChart n e -- ^ The complete chart -> (e -> Bool) -- ^ When is an edge 'FMeta'? -> [e] -- ^ The starting edges - -> SList (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 - --- simplest implementation - + -> [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] @@ -234,38 +165,23 @@ chart2forests chart isMeta = concatMap (edge2forests []) item2forest edges (SInt n) = FInt n item2forest edges (SFloat f) = FFloat f -{- -before AR inserted peb's patch 8/7/2007, this was: -chart2forests chart isMeta = concatMap edge2forests - where edge2forests edge = if isMeta edge then [FMeta] - else map item2forest $ chart ? edge - item2forest (SMeta) = FMeta - item2forest (SNode name children) = FNode name $ children >>= mapM edge2forests - item2forest (SString s) = FString s - item2forest (SInt n) = FInt n - item2forest (SFloat f) = FFloat f - --} - -{- --- more intelligent(?) implementation, --- requiring that charts and forests are sorted maps and sorted sets -chart2forests chart isMeta = es2fs - where e2fs e = if isMeta e then [FMeta] else map i2f $ chart ? e - es2fs es = if null metas then fs else FMeta : fs - where (metas, nonMetas) = splitBy isMeta es - fs = map i2f $ unionMap (<++>) $ map (chart ?) nonMetas - i2f (name, children) = FNode name $ - case head children of - [] -> [[]] - [_] -> map return $ es2fs $ concat children - _ -> children >>= mapM e2fs --} +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 n -> SList (SyntaxTree n) -forest2trees (FNode n forests) = map (TNode n) $ forests >>= mapM forest2trees -forest2trees (FString s) = [TString s] -forest2trees (FInt n) = [TInt n] -forest2trees (FFloat f) = [TFloat f] -forest2trees (FMeta) = [TMeta] +forest2exps :: SyntaxForest CId -> [Exp] +forest2exps (FNode n forests) = map (DTr [] (AC n)) $ forests >>= mapM forest2exps +forest2exps (FString s) = [DTr [] (AS s) []] +forest2exps (FInt n) = [DTr [] (AI n) []] +forest2exps (FFloat f) = [DTr [] (AF f) []] +forest2exps (FMeta) = [DTr [] (AM 0) []]