From e0071bc69c1fef54d5a99db6d43dc00375850f09 Mon Sep 17 00:00:00 2001 From: aarne Date: Tue, 3 Jul 2007 07:11:30 +0000 Subject: generalized MakeOverload to TreeSelections --- src/GF/Shell.hs | 2 +- src/GF/UseGrammar/MakeOverload.hs | 73 ----------------------------------- src/GF/UseGrammar/TreeSelections.hs | 77 +++++++++++++++++++++++++++++++++++++ 3 files changed, 78 insertions(+), 74 deletions(-) delete mode 100644 src/GF/UseGrammar/MakeOverload.hs create mode 100644 src/GF/UseGrammar/TreeSelections.hs (limited to 'src') diff --git a/src/GF/Shell.hs b/src/GF/Shell.hs index 139a2ab07..e0b01f18f 100644 --- a/src/GF/Shell.hs +++ b/src/GF/Shell.hs @@ -30,7 +30,7 @@ import GF.Grammar.Values import GF.UseGrammar.GetTree import GF.UseGrammar.Generate (generateAll) ---- should be in API import GF.UseGrammar.Treebank -import GF.UseGrammar.MakeOverload (getOverloadResults) +import GF.UseGrammar.TreeSelections (getOverloadResults) import GF.Shell.ShellCommands diff --git a/src/GF/UseGrammar/MakeOverload.hs b/src/GF/UseGrammar/MakeOverload.hs deleted file mode 100644 index 1d574d001..000000000 --- a/src/GF/UseGrammar/MakeOverload.hs +++ /dev/null @@ -1,73 +0,0 @@ ----------------------------------------------------------------------- --- | --- Module : MakeOverload --- Maintainer : AR --- Stability : (stable) --- Portability : (portable) --- --- choose shallowest trees, and remove an overload resolution prefix ------------------------------------------------------------------------------ - -module GF.UseGrammar.MakeOverload where - -import GF.Grammar.Abstract -import GF.Grammar.Macros - -import GF.Data.Operations -import GF.Data.Zipper -import Data.List - --- AR 2/7/2007 --- The top-level function takes a set of trees (typically parses) --- and returns the list of those trees that have the minimum size. --- In addition, the overload prefix "ovrld123_", is removed --- from each constructor in which it appears. This is used for --- showing the library API constructors in a parsable grammar. - -getOverloadResults :: [Tree] -> [Tree] -getOverloadResults = smallestTrs . map mkOverload - --- NB: this does not always give the desired result, since --- some genuine alternatives may be deeper: now we will exclude the --- latter of --- --- mkCl this_NP love_V2 (mkNP that_NP here_Adv) --- mkCl this_NP (mkVP (mkVP love_V2 that_NP) here_Adv) --- --- A perfect method would know the definitional equivalences of constructors. --- --- Notice also that size is a better measure than depth, because: --- 1. Global depth does not exclude the latter of --- --- mkCl (mkNP he_Pron) love_V2 that_NP --- mkCl (mkNP he_Pron) (mkVP love_V2 that_NP) --- --- 2. Length is needed to exclude the latter of --- --- mkS (mkCl (mkNP he_Pron) love_V2 that_NP) --- mkS presentTense (mkCl (mkNP he_Pron) love_V2 that_NP) --- - - -smallestTrs :: [Tr a] -> [Tr a] -smallestTrs ts = map fst $ filter ((==mx) . snd) tds where - tds = [(t, size t) | t <- ts] - mx = minimum $ map snd tds - size = sizeTr -- depthTr - -depthTr :: Tr a -> Int -depthTr (Tr (_, ts)) = case ts of - [] -> 1 - _ -> 1 + (maximum $ map depthTr ts) - -sizeTr :: Tr a -> Int -sizeTr (Tr (_, ts)) = 1 + sum (map sizeTr ts) - --- format: ovrld123_mkNP - -mkOverload :: Tree -> Tree -mkOverload = mapTr (changeAtom overAtom) where - overAtom a = case a of - AtC (m, IC f) | take 5 f == "ovrld" -> - AtC (m, IC (tail (dropWhile (/='_') f))) - _ -> a diff --git a/src/GF/UseGrammar/TreeSelections.hs b/src/GF/UseGrammar/TreeSelections.hs new file mode 100644 index 000000000..9bf2711be --- /dev/null +++ b/src/GF/UseGrammar/TreeSelections.hs @@ -0,0 +1,77 @@ +---------------------------------------------------------------------- +-- | +-- Module : TreeSelections +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- choose shallowest trees, and remove an overload resolution prefix +----------------------------------------------------------------------------- + +module GF.UseGrammar.TreeSelections ( + + getOverloadResults, smallestTrs, sizeTr, depthTr + + ) where + +import GF.Grammar.Abstract +import GF.Grammar.Macros + +import GF.Data.Operations +import GF.Data.Zipper +import Data.List + +-- AR 2/7/2007 +-- The top-level function takes a set of trees (typically parses) +-- and returns the list of those trees that have the minimum size. +-- In addition, the overload prefix "ovrld123_", is removed +-- from each constructor in which it appears. This is used for +-- showing the library API constructors in a parsable grammar. +-- TODO: access the generic functions smallestTrs, sizeTr, depthTr from shell + +getOverloadResults :: [Tree] -> [Tree] +getOverloadResults = smallestTrs sizeTr . map (mkOverload "ovrld") + +-- NB: this does not always give the desired result, since +-- some genuine alternatives may be deeper: now we will exclude the +-- latter of +-- +-- mkCl this_NP love_V2 (mkNP that_NP here_Adv) +-- mkCl this_NP (mkVP (mkVP love_V2 that_NP) here_Adv) +-- +-- A perfect method would know the definitional equivalences of constructors. +-- +-- Notice also that size is a better measure than depth, because: +-- 1. Global depth does not exclude the latter of +-- +-- mkCl (mkNP he_Pron) love_V2 that_NP +-- mkCl (mkNP he_Pron) (mkVP love_V2 that_NP) +-- +-- 2. Length is needed to exclude the latter of +-- +-- mkS (mkCl (mkNP he_Pron) love_V2 that_NP) +-- mkS presentTense (mkCl (mkNP he_Pron) love_V2 that_NP) +-- + +smallestTrs :: (Tr a -> Int) -> [Tr a] -> [Tr a] +smallestTrs size ts = map fst $ filter ((==mx) . snd) tds where + tds = [(t, size t) | t <- ts] + mx = minimum $ map snd tds + +depthTr :: Tr a -> Int +depthTr (Tr (_, ts)) = case ts of + [] -> 1 + _ -> 1 + (maximum $ map depthTr ts) + +sizeTr :: Tr a -> Int +sizeTr (Tr (_, ts)) = 1 + sum (map sizeTr ts) + +-- remove from each constant a prefix starting with "pref", up to first "_" +-- example format: ovrld123_mkNP + +mkOverload :: String -> Tree -> Tree +mkOverload pref = mapTr (changeAtom overAtom) where + overAtom a = case a of + AtC (m, IC f) | isPrefixOf pref f -> + AtC (m, IC (tail (dropWhile (/='_') f))) + _ -> a -- cgit v1.2.3