From e53a28a3a850a7faf1ed9be219e24a3bcf7e0fec Mon Sep 17 00:00:00 2001
From: aarne <aarne@cs.chalmers.se>
Date: Tue, 3 Jul 2007 07:11:30 +0000
Subject: [PATCH] generalized MakeOverload to TreeSelections

---
 src/GF/Shell.hs                               |  2 +-
 .../{MakeOverload.hs => TreeSelections.hs}    | 26 +++++++++++--------
 2 files changed, 16 insertions(+), 12 deletions(-)
 rename src/GF/UseGrammar/{MakeOverload.hs => TreeSelections.hs} (74%)

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/TreeSelections.hs
similarity index 74%
rename from src/GF/UseGrammar/MakeOverload.hs
rename to src/GF/UseGrammar/TreeSelections.hs
index 1d574d001..9bf2711be 100644
--- a/src/GF/UseGrammar/MakeOverload.hs
+++ b/src/GF/UseGrammar/TreeSelections.hs
@@ -1,6 +1,6 @@
 ----------------------------------------------------------------------
 -- |
--- Module      : MakeOverload
+-- Module      : TreeSelections
 -- Maintainer  : AR
 -- Stability   : (stable)
 -- Portability : (portable)
@@ -8,7 +8,11 @@
 -- choose shallowest trees, and remove an overload resolution prefix
 -----------------------------------------------------------------------------
 
-module GF.UseGrammar.MakeOverload where
+module GF.UseGrammar.TreeSelections (
+
+  getOverloadResults, smallestTrs, sizeTr, depthTr
+
+  ) where
 
 import GF.Grammar.Abstract
 import GF.Grammar.Macros
@@ -23,9 +27,10 @@ import Data.List
 -- 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 . map mkOverload 
+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 
@@ -48,12 +53,10 @@ getOverloadResults = smallestTrs . map mkOverload
 --   mkS presentTense (mkCl (mkNP he_Pron) love_V2 that_NP)
 --
 
-
-smallestTrs :: [Tr a] -> [Tr a]
-smallestTrs ts = map fst $ filter ((==mx) . snd) tds where
+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
-  size = sizeTr -- depthTr
 
 depthTr :: Tr a -> Int
 depthTr (Tr (_, ts)) = case ts of
@@ -63,11 +66,12 @@ depthTr (Tr (_, ts)) = case ts of
 sizeTr :: Tr a -> Int
 sizeTr (Tr (_, ts)) = 1 + sum (map sizeTr ts)
 
--- format: ovrld123_mkNP
+-- remove from each constant a prefix starting with "pref", up to first "_"
+-- example format: ovrld123_mkNP
 
-mkOverload :: Tree -> Tree
-mkOverload = mapTr (changeAtom overAtom) where
+mkOverload :: String -> Tree -> Tree
+mkOverload pref = mapTr (changeAtom overAtom) where
   overAtom a = case a of
-    AtC (m, IC f) | take 5 f == "ovrld" -> 
+    AtC (m, IC f) | isPrefixOf pref f ->
       AtC (m, IC (tail (dropWhile (/='_') f)))
     _ -> a