[bugfix for looping main algorithm
martin.hofmann@uni-bamberg.de**20081208123524
 Several bugfixes for index-out-of bounds error and looping code due to wrong stopping conditions and empty instance declarations for Ord in CallDependencies (Gr) and Terms.Class (Pat,Exp)
] hunk ./src/Data/CallDependencies.hs 45
-instance (Eq a, Eq b)   => Eq (Gr a b)
-instance (Ord a, Ord b) => Ord (Gr a b)
+
+instance (Eq a, Eq b)   => Eq (Gr a b) where
+    (==) _ _  = True
+instance (Ord a, Ord b) => Ord (Gr a b) where
+    compare  _ _  = EQ
hunk ./src/Data/Fragments.hs 24
-import qualified Data.Set as S (empty, fromList, toList, fold, map,size, null, insert, delete, union)
+import qualified Data.Set as S (member, empty, fromList, toList, fold, map,size, null, insert, delete, union)
hunk ./src/Data/Fragments.hs 44
-isOpen = P.null.opos
+isOpen = not.P.null.opos
hunk ./src/Data/HypoSpace.hs 14
-import Data.Rules (RatingData, Rateable(..))
-import qualified Data.Rules as R 
hunk ./src/Data/HypoSpace.hs 15
-import Data.Fragments (RuleFrag, RuleFrags)
+
+import Data.Fragments (RuleFrag, RuleFrags, ruleFrags)
hunk ./src/Data/HypoSpace.hs 20
-import Data.Hypotheses (Hypo, Hypos, open, develop, Call)
+import Data.Hypotheses (Hypo, Hypos, hypos, open, develop, Call)
+
+import Data.Rules (RatingData, Rateable(..))
hunk ./src/Data/HypoSpace.hs 26
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, mapMaybe, maybeToList, catMaybes)
hunk ./src/Data/HypoSpace.hs 31
-import Debug.Trace
+
+import Data.Bimap (Bimap)
+import qualified Data.Bimap as B
hunk ./src/Data/HypoSpace.hs 36
+
+import qualified Data.Set as S
+
hunk ./src/Data/HypoSpace.hs 46
-
-
-
-
+    
hunk ./src/Data/HypoSpace.hs 53
-    { rateHyposMap :: (M.Map RatingData Hypos) -- 
-    , ruleHyposMap :: (M.Map RuleFrag Hypos)
-    , hypoRateMap  :: (M.Map Hypo RatingData)
+    { hypoCount    :: !Integer
+    , rateIdsMap   :: !(M.Map RatingData [Integer])  
+    , ruleIdsMap   :: !(M.Map RuleFrag [Integer])
+    , hypoIdBimap  :: !(Bimap Hypo Integer)
hunk ./src/Data/HypoSpace.hs 59
+incrementHypoCount :: HSpace -> HSpace
+incrementHypoCount hsp =
+    let c = hypoCount hsp
+    in hsp{hypoCount = c+1}
+
+getById :: (Monad m) => Integer -> HSpace -> m Hypo
+getById i = (B.lookupR i).hypoIdBimap
+
+getByHypo :: (Monad m) => Hypo -> HSpace -> m Integer
+getByHypo h = (B.lookup h).hypoIdBimap
+
+getByIds is hsp = mapMaybe(flip getById hsp) is
+
+getByRule :: RuleFrag -> HSpace -> [Hypo]   
+getByRule r hsp = 
+    let ids = case M.lookup r (ruleIdsMap hsp) of
+                Just i -> i
+                Nothing -> []
+    in mapMaybe ((flip getById) hsp) ids
+    
+getByRate :: RatingData -> HSpace -> [Hypo]   
+getByRate r hsp = 
+    let ids = case M.lookup r (rateIdsMap hsp) of
+                Just i -> i
+                Nothing -> []
+    in mapMaybe ((flip getById) hsp) ids
hunk ./src/Data/HypoSpace.hs 86
-alterRateHyposMap :: (Maybe Hypos -> Maybe Hypos)
-                     -> Maybe RatingData
+alterRateIdsMap :: (Maybe [Integer] -> Maybe [Integer])
+                     -> Hypo
hunk ./src/Data/HypoSpace.hs 90
-alterRateHyposMap f r hsp@(HSpace m _ _ )  = 
-    case r of
-        Just r' -> hsp{rateHyposMap = M.alter f r' m}
-        Nothing -> hsp
+alterRateIdsMap f h hsp  = 
+    let rhm = rateIdsMap hsp in
+    hsp{rateIdsMap = M.alter f (rate h) rhm}
hunk ./src/Data/HypoSpace.hs 94
-alterRuleHyposMap :: (Maybe Hypos -> Maybe Hypos)   -- ^alter with function
-                     -> RuleFrags                   -- ^at each ruleFrag (position/key)
-                     -> HSpace                      -- ^in HypoSpace
-                     -> HSpace                      -- ^yielding resulting HypoSpace
-alterRuleHyposMap fun frgs hsp@(HSpace _ m _ )  = 
-    hsp{ruleHyposMap = foldl' (flip (M.alter fun)) m (F.toList frgs)}
+alterRuleIdsMap :: (Maybe [Integer] -> Maybe [Integer])   -- ^alter with function
+                     -> Hypo                              -- ^at each ruleFrag in Hypo
+                     -> HSpace                            -- ^in HypoSpace
+                     -> HSpace                            -- ^yielding resulting HypoSpace
+alterRuleIdsMap fun h hsp  = 
+    let rim  = ruleIdsMap hsp 
+        frgs = F.toList.open $ h in
+    hsp{ruleIdsMap = foldl' (flip (M.alter fun)) rim frgs}
hunk ./src/Data/HypoSpace.hs 103
-alterHypoRateMap :: (Hypo -> M.Map Hypo RatingData 
-                    -> M.Map Hypo RatingData)
+alterHypoIdBimap :: (Hypo -> Bimap Hypo Integer -> Bimap Hypo Integer)
hunk ./src/Data/HypoSpace.hs 107
-alterHypoRateMap f h hsp@(HSpace _ _ m )  = 
-    let hsp' = hsp{hypoRateMap = f h m} in 
-    trace ("alterhypoRate" ++ show hsp') $  hsp'
+alterHypoIdBimap f h hsp  = 
+    let him = hypoIdBimap hsp
+    in  him `seq` hsp{hypoIdBimap = f h him} 
hunk ./src/Data/HypoSpace.hs 114
-    { rateHyposMap = M.empty
-    , ruleHyposMap = M.empty
-    , hypoRateMap  = M.empty
+    { hypoCount   = 0
+    , rateIdsMap  = M.empty
+    , ruleIdsMap  = M.empty
+    , hypoIdBimap = B.empty
hunk ./src/Data/HypoSpace.hs 119
-    
+ 
hunk ./src/Data/HypoSpace.hs 132
+    where
+    iD = hypoCount hsp
+mbInsert i is = 
+    case is of
+        Just is' -> Just $ i:is'
+        Nothing  -> Just $ [i] 
+
hunk ./src/Data/HypoSpace.hs 148
+    where
+    iD = getByHypo h hsp
+    mbDelete _ Nothing   = Nothing
+    mbDelete Nothing is  = is 
+    mbDelete (Just i) (Just is) = 
+        let is' =  filter (/= i) is
+        in if null is' 
+             then Nothing
+             else Just is'
hunk ./src/Data/HypoSpace.hs 176
-        case M.lookup ro (ruleHyposMap hsp) of
-            Just hs -> H.toList hs 
+        case M.lookup ro (ruleIdsMap hsp) of
+            Just hs -> mapMaybe (flip getById hsp) hs 
hunk ./src/Data/HypoSpace.hs 182
-bestHypos         = snd . M.findMin . rateHyposMap 
+bestHypos = hypos.((snd . M.findMin . rateIdsMap) >>= getByIds)
hunk ./src/Data/HypoSpace.hs 199
-    show hsp = showString "HSpace {\n\trateHyposMap =" .
-               shows (rateHyposMap hsp) .
-               showString "\n\truleHyposMap =" .
-               showAsSet (M.toList (ruleHyposMap hsp)) .
-               showString "\n\thypoRateMap =" .
-               showAsSet (M.toList (hypoRateMap hsp)) $
+    show hsp = showString "HSpace {\n\trateIDsMap =" .
+               shows (rateIdsMap hsp) .
+               showString "\n\truleIdsMap =" .
+               showAsSet (M.toList (ruleIdsMap hsp)) .
+               showString "\n\tidRateMap =" .
+               showAsSet (B.toList (hypoIdBimap hsp)) $
hunk ./src/Data/Hypotheses.hs 5
-    hypo, develop,
+    hypo,
hunk ./src/Data/Hypotheses.hs 8
-    Hypos, empty, singleton, null,
-    merge, insert, delete, replace,
+    Hypos, hypos,  empty, singleton, null,
+    merge, insert, delete, replace, 
+    develop, shrink, extend, modify,
hunk ./src/Data/Hypotheses.hs 41
+
hunk ./src/Data/Hypotheses.hs 51
-    deriving(Eq, Ord)
hunk ./src/Data/Hypotheses.hs 52
+instance Eq Hypo where
+    (==) (HH o1 c1 _) (HH o2 c2 _) = and [o1 == o2, c1 == c2]
+    
+instance Ord Hypo where
+    compare(HH o1 c1 _) (HH o2 c2 _) = compare (compare o1 o2)(compare c1 c2)
hunk ./src/Data/Hypotheses.hs 109
-extend rf (HH open clsd clls) 
-    | F.isOpen rf  = HH (F.insert rf open) clsd clls
-    | otherwise  = HH open (M.alter (R.insertM (frag rf)) (name rf) clsd) clls
+extend rf h@(HH os cs _ ) 
+    | F.isOpen rf  = h{open = F.insert rf os}
+    | otherwise    = h{clsd = M.alter (R.insertM (frag rf)) (name rf) cs}
hunk ./src/Data/Hypotheses.hs 115
-shrink rf (HH open clsd clls) 
-    | F.isOpen rf  = HH (F.delete rf open) clsd clls
-    | otherwise  = HH open (M.alter (R.deleteM (frag rf)) (name rf) clsd) clls
+shrink rf h@(HH os cs _ ) 
+    | F.isOpen rf  = h{open = F.delete rf os}
+    | otherwise    = h{clsd = M.alter (R.deleteM (frag rf)) (name rf) cs}
hunk ./src/Data/Hypotheses.hs 125
-modify rold newrs h =  shrink rold $ F.fold extend h newrs 
+modify rold newrs h =     
+    let shrnk = shrink rold h in
+    F.fold extend shrnk newrs 
+     
hunk ./src/Data/Hypotheses.hs 142
+hypos hs = HHs $ S.fromList hs
+
hunk ./src/Data/Rules.hs 105
-insertM  r rs   = rs >>= \rs' -> return $ insert r rs'
+insertM  r rs   = 
+    case rs of
+        (Just rs') -> return $ insert r rs'
+        Nothing    -> return $ insert r empty
hunk ./src/IgorMonad.hs 6
-import Data.IgorData 
+import Data.IgorData (initIgor, propagate, coverRules, iodata, searchSpace, setupIgor, Igor) 
hunk ./src/IgorMonad.hs 80
-      else do -- advanceRule (chooseOneRule openrules) >> bestHypos >>= stopWith -- >>= closeHypos
-              advanceRule (chooseOneRule openrules) 
-              best <- bestHypos 
-              trace ("CurrentBEST: " ++ show best ) $ closeHypos best
+      else do advanceRule (chooseOneRule openrules) >> bestHypos >>= closeHypos
+--              advanceRule (chooseOneRule openrules) 
+--              best <- bestHypos 
+--              trace ("CurrentBEST: " ++ show best ) $ closeHypos best
hunk ./src/IgorMonad.hs 96
-    modify $! propagate $! (rf,rfs,[])
+    modify $ propagate $ (rf,rfs,[])
hunk ./src/Terms/Class.hs 18
-import Language.Haskell.TH ( Dec (FunD)
-                           , Clause (Clause)
-                           , Body (NormalB)
-                           , Exp (VarE, ConE, LitE, ListE, TupE, InfixE, AppE, CondE)
-                           , Pat (VarP, ConP, LitP, ListP, TupP, InfixP) 
-                           , Q(..)
-                           , Name, mkName)
+--import Language.Haskell.TH ( Dec (FunD)
+--                           , Clause (Clause)
+--                           , Body (NormalB)
+--                           , Exp (VarE, ConE, LitE, ListE, TupE, InfixE, AppE, CondE)
+--                           , Pat (VarP, ConP, LitP, ListP, TupP, InfixP) 
+--                           , Q(..)
+--                           , Name, mkName)
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax
hunk ./src/Terms/Class.hs 101
--- Think about a better ordering relation than lexocographic which does not 
--- return wrong result with maps (e.g. when using Size)
--- 
-instance Ord Exp where
-    compare = ( \l r -> compare (show l) (show r) )
-    (<)     = ( \l r -> (<) (show l) (show r) )
-    (<=)    = ( \l r -> (<=) (show l) (show r) )
-    (>=)    = ( \l r -> (>=) (show l) (show r) )
-    (>)     = ( \l r -> (>) (show l) (show r) )
-             
-instance Ord Pat where
-    compare = ( \l r -> compare (show l) (show r) )
-    (<)     = ( \l r -> (<) (show l) (show r) )
-    (<=)    = ( \l r -> (<=) (show l) (show r) )
-    (>=)    = ( \l r -> (>=) (show l) (show r) )
-    (>)     = ( \l r -> (>) (show l) (show r) )
hunk ./src/Terms/Class.hs 102
+deriving instance Ord Range
+deriving instance Ord Match
+deriving instance Ord Dec
+deriving instance Ord Type
+deriving instance Ord Lit
+deriving instance Ord Stmt
+deriving instance Ord Foreign
+deriving instance Ord FunDep
+deriving instance Ord Con
+deriving instance Ord Clause
+deriving instance Ord Body
+deriving instance Ord Guard
+deriving instance Ord Strict
+deriving instance Ord Safety
+deriving instance Ord Callconv
+deriving instance Ord Pat
+deriving instance Ord Exp
hunk ./src/Terms/Unifier.hs 14
-import Terms.Class
+import Terms.Class (unfoldAppE, subtermOf, Term)