[a first implementation of the synthesis loop
martin.hofmann@uni-bamberg.de**20081127103701] hunk ./src/IgorMonad.hs 5
-import Logging
-import Control.Monad.Identity
hunk ./src/IgorMonad.hs 7
+import Data.IOData
+import qualified Data.HypoSpace as HS (bestHypos)
hunk ./src/IgorMonad.hs 10
+import Data.Hypotheses (Hypos, open, clsd)
+import qualified Data.Hypotheses as H (map, null,toList)
+import Data.Rules (Rules)
+import qualified Data.Set as S (null, findMin)
+import qualified Data.Map as M (toList)
+import Data.Initialiser
+import Advancement
hunk ./src/IgorMonad.hs 22
---type FunFrag = (Name,Rules)
---type FunFrags = [Name Rules]
+type FunFrag = (Name,Rules)
+type FunFrags = [(Name, Rules)]
hunk ./src/IgorMonad.hs 25
---synthesise :: Q [Dec] -> Q [Dec] -> Q [Dec] 
---synthesise tgtsQ bgksQ = do
---    tgts <- toRules tgtsQ --  [(Name,Rules)]
---    bgks <- toRules bgksQ
---      tnms <- return $ map fst tgts
---      let igordata = --initIgor $ tgts ++ bgks
---      runIM (synthesiseTargets tnms) igordata
+synthesise :: Q [Dec] -> Q [Dec] -> Q [Dec] 
+synthesise tgtsQ bgksQ = do
+    tgts <- liftM decs2rules tgtsQ --  [(Name,Rules)]
+    bgks <- liftM decs2rules bgksQ
+    tnms <- return $ map fst tgts
+    let igordata = setupIgor.initIOData $ tgts ++ bgks
+    return $ rules2decs $ runIM (synthesiseTargets tnms) igordata
hunk ./src/IgorMonad.hs 34
--- synthesiseTargets :: [Name] -> IM [(Name,Rules)]
--- synthesiseTargets = mapM synthesiseTarget
+synthesiseTargets :: [Name] -> IM [(Name,Rules)]
+synthesiseTargets n = liftM concat $ mapM synthesiseTarget n
hunk ./src/IgorMonad.hs 37
--- synthesiseTarget :: Name -> IM [(Name,Rules)]
--- synthesiseTarget n =  setTarget n >> bestHypos >>= closeHypos
+synthesiseTarget :: Name -> IM [(Name,Rules)]
+synthesiseTarget n =  setTarget n >> bestHypos >>= closeHypos
hunk ./src/IgorMonad.hs 41
-setTarget n = 
-    -- flush Searchspace, 
-    -- antiunify Rules with name 'n' 
-    --and set them as initial Hypo
-    return ()
+setTarget n = do
+    iod <- gets iodata
+    put $ initIgor iod n
hunk ./src/IgorMonad.hs 45
--- bestHypos = gets searchSpace >>= bestHypos
+bestHypos :: IM Hypos
+bestHypos = liftM HS.bestHypos $ gets searchSpace
hunk ./src/IgorMonad.hs 48
--- closeHypo hs =  do
---    let rules = map open hs
---        if null rules
---          then return hs
---          else -- advanceRule.chooseOne rules >> return bestHypos
+closeHypos :: Hypos -> IM [(Name,Rules)]
+closeHypos hs =  do
+    let rules = H.map open hs
+    if S.null rules
+      then return $ M.toList.clsd.chooseOneHypo $ H.toList hs
+      else advanceRule.chooseOneRule rules >> bestHypos >>= closeHypos
+    where
+    chooseOneHypo = head
+    chooseOneRule = S.findMin