[ruledevelopments are now operators on hypothesis, extended logging
martin.hofmann@uni-bamberg.de**20091008142415] hunk ./src/Data/HypoSpace.hs 5
-    bestHypos, propagateHSp, countHypos,
+    bestHypos, replaceHypos, countHypos,
hunk ./src/Data/HypoSpace.hs 22
+import Data.List (delete)
+import qualified Data.Foldable as F
hunk ./src/Data/HypoSpace.hs 49
-bestHypos = hypos . snd . H.getMin . heap
+bestHypos =  snd . H.getMin . heap
hunk ./src/Data/HypoSpace.hs 52
--- Propagate a Rule modification over the whole search space
-propagateHSp :: CovrRule -> [(CovrRules,[Call])] -> HSpace -> HSpace
-propagateHSp cr sucs hsp = 
-    (uncurry  pushHypos) . swap . (first $ develHs cr sucs) $ popHypos hsp 
+-- Replace a rule by many rules
+replaceHypos :: Hypo -> Hypos -> HSpace -> HSpace
+replaceHypos h hs hsp =  uncurry  pushHypos . swap . (repl h hs) . popHypos $ hsp
hunk ./src/Data/HypoSpace.hs 57
-    -- develHs =  \c sucs hs -> concatMap (\h -> mapMaybe (\s -> developH c s h) sucs) hs
-    develHs = ((=<<) .) . flip . (mapMaybe .) . flip . developH
+    repl h hs = first $ ((F.toList hs) ++) . (delete h)
hunk ./src/Data/Hypotheses.hs 4
-    Hypo, 
-    hypo,
+    Hypo,  Hypos,
+    hypo, -- hypos, 
hunk ./src/Data/Hypotheses.hs 8
-    Hypos, hypos,  
hunk ./src/Data/Hypotheses.hs 42
-data Hypo  = HH { open :: !(Set CovrRule)
-                , clsd :: !(Map Name Rules) -- function name and names of dependent functions
-                , callings :: !CallDep
+data Hypo  = HH { open :: (CovrRules)
+                , clsd :: (Map Name Rules) -- function name and names of dependent functions
+                , callings :: CallDep
hunk ./src/Data/Hypotheses.hs 46
-               deriving(Eq, Ord)
+               deriving(Eq, Ord, Show)
+               
hunk ./src/Data/Hypotheses.hs 49
---closed h = foldl1 (S.union) (M.elems.clsd h)
hunk ./src/Data/Hypotheses.hs 50
---    (==) (HH o1 c1 _) (HH o2 c2 _) = and [o1 == o2, c1 == c2]
---    
+--    (==) a@(HH o1 c1 d1) b@(HH o2 c2 d2) =  and [o1 == o2, c1 == c2]
+-- 
+
+        
+        
hunk ./src/Data/Hypotheses.hs 61
-instance Show Hypo where
-    show = show.pretty
+
hunk ./src/Data/Hypotheses.hs 100
+        Hypo ->          -- the hypothese to develop
hunk ./src/Data/Hypotheses.hs 102
-        ,[Call]) ->      -- a list of Calls 
-        Hypo ->          -- the hypothese to develop 
+        ,[Call]) ->      -- a list of Calls  
hunk ./src/Data/Hypotheses.hs 104
-developH rf (rfs,calls) h = do 
+developH rf h (rfs,calls) = do 
hunk ./src/Data/Hypotheses.hs 139
-type Hypos = S.Set Hypo 
+type Hypos = [Hypo] 
hunk ./src/Data/Hypotheses.hs 149
-hypos :: [Hypo] -> Hypos
-hypos = S.fromList
+--hypos :: [Hypo] -> Hypos
+--hypos = S.fromList
+
+
hunk ./src/Data/IOData.hs 198
-    { name  :: !Name      -- ^ the name of the function/rule
-    , crul  :: !Rule      -- ^ the covering rule itself
-    , covr  :: ![Int]     -- ^ the indices of covered I/O examples (stored in a IOData)
+    { name  :: Name      -- ^ the name of the function/rule
+    , crul  :: Rule      -- ^ the covering rule itself
+    , covr  :: [Int]     -- ^ the indices of covered I/O examples (stored in a IOData)
hunk ./src/Data/IOData.hs 204
-type CovrRules = Set CovrRule
+   
+type CovrRules = S.Set CovrRule
hunk ./src/Data/IgorMonad.hs 179
-propagate :: CovrRule -> [(CovrRules,[Call])] -> IM ()  
-propagate  = (modifyHS .) . propagateHSp
+propagate :: Hypo -> Hypos -> IM ()  
+propagate  = (modifyHS .) . replaceHypos
hunk ./src/RuleDevelopment.hs 16
+import Data.Maybe (mapMaybe)
hunk ./src/RuleDevelopment.hs 18
-advanceRule :: CallDep -> CovrRule -> IM [(CovrRules,[Call])]
-advanceRule cd rf = do 
-    folds <- ifIsSet inEnhanced (foldUProp rf) []
-    if not $ null folds then return folds
-      else do parts <- partition rf
-              subfs <- callSubfunction rf
-              mtchs <- introduceMatchings cd rf
-              return $ parts ++ subfs ++ mtchs
+advanceRule :: Hypo -> CovrRule -> IM Hypos
+advanceRule h r = do
+    llogNO $ linebreak <> text "Advancing" <^> pretty r <$> 
+             text "of" <$> pretty h
+             
+             
+    mtchs <- (introduceMatchings (callings h) r)
+    let mtchhs = mapMaybe (developH r h) mtchs             
+    folds <- (ifIsSet inEnhanced (foldUProp r) [])
+    let foldhs = mapMaybe (developH r h) folds             
+    parts <- (partition r)
+    let parths = mapMaybe (developH r h) parts             
+    calls <- (callSubfunction r)
+    let callhs = mapMaybe (developH r h) calls
+        
+    llogNO $ text "MTCH:" <^> text "Advancements:" <$> pretty mtchs <^>
+             text "Hypotheses  :" <$> pretty mtchhs
+        
+    llogNO $ text "FOLD:" <^> text "Advancements:" <$> pretty folds <^>
+             text "Hypotheses  :" <$> pretty foldhs
+        
+    llogNO $ text "PART:" <^> text "Advancements:" <$> pretty parts <^>
+             text "Hypotheses  :" <$> pretty parths
+        
+    llogNO $ text "CALL:" <^> text "Advancements:" <$> pretty calls <^>
+             text "Hypotheses  :" <$> pretty callhs
hunk ./src/RuleDevelopment.hs 45
- 
+    return . concat $ [mtchhs, foldhs, parths,callhs]
hunk ./src/SynthesisEngine.hs 22
+import Data.Maybe (isJust, fromJust)
hunk ./src/SynthesisEngine.hs 86
-    candidatehypos <- currentBestHypos  
-    candidaterules <- chooseCandidateRules candidatehypos 
+    besthypos  <- currentBestHypos
+    candidates <- chooseCandidateHypo besthypos >>= return . chooseCandidateRule
hunk ./src/SynthesisEngine.hs 89
-    nocandidates <- stopWhenNoCandidateRules candidaterules 
+    let nocandidates = not. isJust $ candidates
hunk ./src/SynthesisEngine.hs 92
-    llogIN $ text "Candidate Hypos:" <^> pretty candidatehypos
-    llogNO $ text "Candidate Rules:" <^> pretty candidaterules 
hunk ./src/SynthesisEngine.hs 97
-      then stopWith candidatehypos
-      else chooseOneRule candidaterules >>=
-           uncurry applyAdvacements >> 
-           enterLoop
+      then stopWith besthypos
+      else uncurry applyAdvacements  (fromJust candidates) >> enterLoop
hunk ./src/SynthesisEngine.hs 106
-       return $ map allBindings (S.toList hs)
-
-stopWhenNoCandidateRules :: [(CallDep,CovrRule)] -> IM Bool
-stopWhenNoCandidateRules = return . null
+       return $ map allBindings  hs
hunk ./src/SynthesisEngine.hs 115
-chooseCandidateRules :: Hypos -> IM [(CallDep,CovrRule)]
-chooseCandidateRules hs =
-    return $  concatMap collect (S.toList hs)
-    where
-    collect h = map ((,) (callings h)) (S.toList $ open h)   
---
---    return . (\h -> (callings h, open h)) . S.findMin
-----    return . S.fold collect S.empty  
-----    where   
-----    collect = S.union . open
+chooseCandidateHypo :: (Monad m)=> Hypos -> (m Hypo)
+chooseCandidateHypo = headM 
hunk ./src/SynthesisEngine.hs 118
-chooseOneRule :: [(CallDep,CovrRule)] -> IM (CallDep,CovrRule)
-chooseOneRule = return .  minimumBy (compare `on` snd)
-  
-applyAdvacements :: CallDep -> CovrRule -> IM ()
-applyAdvacements cd rf = do
-    advancements <- advanceRule cd rf
+chooseCandidateRule :: (Monad m) => Hypo -> (m (Hypo,CovrRule))
+chooseCandidateRule hs =  liftM ((,) hs) (headM . S.toList . open $ hs) 
hunk ./src/SynthesisEngine.hs 121
-    llogNO $ linebreak <> text "Advancing" <^> pretty rf 
-    llogNO $ text "resulted in" <+> int (length advancements) <+> 
-             text "different successor hypotheses."
-    llogDE $ text "Advancements:" <+> pretty advancements
-    
-    propagate rf advancements
+headM l = if null l then fail "empty list" else return . head $ l
+  
+applyAdvacements :: Hypo -> CovrRule -> IM ()
+applyAdvacements h r = advanceRule h r >>= propagate h 