[various changes (quite nstructured)
martin.hofmann@uni-bamberg.de**20090123081645
 HypoSpace.hs: 
 	- type ID = Integer -> use IntMap and IntSet for manageing IDs
 Fragments.hs and IOData.hs:
 	- RuleFrag moved to IOData
 	- RuleFrags are now (Set RuleFrag)
 	- adapted functions to operate on (Set RuleFrag)
 	- rm Fragments.hs
 Hypotheses.hs:
 	- BUGFIX in Ord implementation of Hypo -> now derived
 Rules.hs:
 	- Rule should interface Terms, so functions implemented to allow term-like operations on Rules by appropriatly passing to term functions
 Terms.hs:
 	- BUGFIX in positions on Terms, now zero-based
 	- BUGFIX in subterms on Lists, inserted special cases for [] and [x]
 Data-hs:
 	- removed
] hunk ./src/Data/CallDependencies.hs 69
+instance Pretty CallDep where
+	pretty = text.show
hunk ./src/Data/Fragments.hs 1
-
-module Data.Fragments (
-
-       
-    RuleFrag(..), 
-    ruleFrag, asFrag,
-    isOpen,
-    
-    RuleFrags, ruleFrags, insertFs, deleteFs, replaceFs, unionFs,
-    foldFs, mapFs, emptyFs, nullFs, countFs,
-
-    fragsToSet, fragsToList,
-    
-    openPositions, freeVars, hasFreeVars,
-    
-    module Data.Rules
-    
-    )where
-
-import Prelude hiding (map, null)
-import qualified Prelude as P (null,map)
-
-import Data.Rules
-
-import Data.List ( (\\), foldl' )
-
-import Data.Set (Set)
-import qualified Data.Set as S (empty, fromList, toList, map,size, null, insert, delete, union)
-
-import Terms hiding (size)
-
-import Data.Util
-
---------------------------------------------------------------------------------
--- Datatype RuleFragment
---------------------------------------------------------------------------------
-
--- | An open position is defined by an expression (which should be a variable)
---   and a list of 'Position's in a term, which are open. 
---   This only makes sense in combination with a 'Rule'
-type OpenPos = (Exp,[Position])
-
--- 
--- Encapsulating all information of an open/unfinished Rule
-data RuleFrag = RF
-    { name  :: Name      -- ^ the name of the function/rule
-    , frag  :: Rule      -- ^ the rule itself
-    , covr  :: [Int]     -- ^ the indices of covered I/O examples (stored in a IOData)
-    , opos  :: [OpenPos] -- ^ the open positions of this fragment    
-    }
-    deriving(Eq, Ord, Show)
-
-instance Rateable RuleFrag where
-    rate = rate.frag
-
-    
- -- | A rule is open if it is not closed
-isOpen :: RuleFrag -> Bool
-isOpen = not.isClosed
-
--- | A rule is closed if it does not have any open positions
-isClosed = P.null.opos
-
--- | A simple constructor for a RuleFrag
-asFrag :: Name -> Rule -> RuleFrag
-asFrag n r = ruleFrag n r [] []
-
--- | Constructor for a RuleFrag
-ruleFrag :: Name -> Rule -> [Int] -> [OpenPos] -> RuleFrag
-ruleFrag n r c o = RF n r c o    
-
--- |Returns a list with all free variables (as a list of expressions)
---  in the given rule 
-freeVars  :: Rule -> [Exp]
-freeVars  r = 
-    let lhsvars = concatMap getVarNames $ lhs r
-        rhsvars = getVarNames.rhs $ r
-        diff    = (\\) rhsvars lhsvars
-    in P.map VarE diff
-
-hasFreeVars :: Rule -> Bool
-hasFreeVars = not.P.null.freeVars
-
-openPositions :: Rule -> [OpenPos]
-openPositions r = P.map (openPos r) (freeVars r)
-    where
-    openPos r e = (e, getPos (rhs r) e) 
-
---------------------------------------------------------------------------------
--- Datatype RuleFragments
---------------------------------------------------------------------------------
-
-newtype RuleFrags = RFS { unRFS :: Set RuleFrag }
-    deriving(Eq, Ord)
-
-instance Show RuleFrags where
-    show (RFS rfs) = showAsSet (S.toList rfs) $ ""
-    
-    
-ruleFrags = fragsFromList
-
-nullFs :: RuleFrags -> Bool
-nullFs = S.null.unRFS
-
-countFs = S.size.unRFS
-
-emptyFs :: RuleFrags
-emptyFs = RFS $ S.empty
-
-foldFs :: (RuleFrag -> a -> a) -> a -> RuleFrags -> a
-foldFs f i rs = foldl' (flip f) i (fragsToList rs) --S.fold f i (unRFS rs)
-
-mapFs :: (RuleFrag -> RuleFrag) -> RuleFrags -> RuleFrags
-mapFs f rs  = RFS $ (S.map f) (unRFS rs)
-
-unionFs :: RuleFrags -> RuleFrags -> RuleFrags
-unionFs (RFS rs1) (RFS rs2) = RFS $ S.union rs1 rs2
-
-insertFs :: RuleFrag -> RuleFrags -> RuleFrags
-insertFs r rs = RFS $ (S.insert r) $ unRFS rs
-
--- *FIXME* necessary? 
---insertM :: RuleFrag -> Maybe RuleFrags -> Maybe RuleFrags
---insertM  r rs   = rs >>= \rs' -> return $ insert r rs'
-
-deleteFs :: RuleFrag -> RuleFrags -> RuleFrags
-deleteFs r rs = RFS $ (S.delete r) $ unRFS rs
-
--- *FIXME* necessary? 
---deleteM :: RuleFrag -> Maybe RuleFrags -> Maybe RuleFrags
---deleteM r rs = do
---    rs' <- rs
---    d   <- return $ delete r rs'
---    if null d
---      then return d
---      else fail ""
-
-
-replaceFs :: RuleFrag ->  -- ^replace old rule 
-           RuleFrag ->  -- ^by new rule
-           RuleFrags -> -- ^in some rules
-           RuleFrags
-replaceFs r1 r2 = (insertFs r2).(deleteFs r1)
-
--- *FIXME* necessary? 
---replaceM r1 r2 = (insertM r2).(deleteM r2)
- 
--- *FIXME* necessary? 
-fragsFromList :: [RuleFrag] -> RuleFrags
-fragsFromList rs  = RFS $ S.fromList rs
-
--- *FIXME* necessary?
---fromSet :: Set RuleFrag -> RuleFrags
---fromSet rs = RFS rs
-
--- *FIXME* necessary?
-fragsToList = S.toList.unRFS
-fragsToSet = unRFS
+
rmfile ./src/Data/Fragments.hs
hunk ./src/Data/HypoSpace.hs 6
-    bestHypos, propagateHSp,
+    bestHypos, propagateHSp, countHypos,
hunk ./src/Data/HypoSpace.hs 10
-    
hunk ./src/Data/HypoSpace.hs 16
+import Data.IOData
hunk ./src/Data/HypoSpace.hs 18
-
-import qualified Data.Map as M
-import Data.Maybe (mapMaybe)
+import Data.Util 
hunk ./src/Data/HypoSpace.hs 21
-import Data.Util (showAsSet)
+   
hunk ./src/Data/HypoSpace.hs 24
+import qualified Data.Set as S
+
+import qualified Data.IntMap as I
+import qualified Data.Map as M
+import qualified Data.IntSet as IS
+
+import Data.Maybe (mapMaybe, catMaybes)
+
hunk ./src/Data/HypoSpace.hs 35
-
+import Logging
+import Debug.Trace 
hunk ./src/Data/HypoSpace.hs 51
-    { hypoCount    :: !Integer
-    , rateIdsMap   :: !(M.Map RatingData [Integer])  
-    , ruleIdsMap   :: !(M.Map RuleFrag [Integer])
-    , hypoIdBimap  :: !(Bimap Hypo Integer)
+    { hypoCounter  :: ID
+    , rateIdsMap   :: (I.IntMap IDs)  
+    , ruleIdsMap   :: (M.Map RuleFrag IDs)
+    , hypoIdBimap  :: (Bimap Hypo ID)
hunk ./src/Data/HypoSpace.hs 57
+type ID = Int
+type IDs = IS.IntSet
+
+countHypos :: HSpace -> ID
+countHypos = B.size.hypoIdBimap
+
hunk ./src/Data/HypoSpace.hs 65
-    let c = hypoCount hsp
-    in hsp{hypoCount = c+1}
+    let c = hypoCounter hsp
+    in hsp{hypoCounter = c+1}
hunk ./src/Data/HypoSpace.hs 68
-getById :: (Monad m) => Integer -> HSpace -> m Hypo
-getById i = (B.lookupR i).hypoIdBimap
+getById :: (Monad m) => ID -> HSpace -> m Hypo
+getById i hsp = 
+	let h = hsp `seq` B.lookupR i (hypoIdBimap hsp)
+	in h `seq` h
hunk ./src/Data/HypoSpace.hs 73
-getByHypo :: (Monad m) => Hypo -> HSpace -> m Integer
-getByHypo h = (B.lookup h).hypoIdBimap
+getByHypo :: (Monad m) => Hypo -> HSpace -> m ID
+getByHypo h hsp = 
+	let i = hsp `seq` B.lookup h (hypoIdBimap hsp)
+	in i `seq` i
hunk ./src/Data/HypoSpace.hs 95
-alterRateIdsMap :: (Maybe [Integer] -> Maybe [Integer]) 
+alterRateIdsMap :: (Maybe IDs -> Maybe IDs) 
hunk ./src/Data/HypoSpace.hs 105
-    hsp{rateIdsMap = M.alter f (rate h) rhm}
+    hsp{rateIdsMap = I.alter f (rate h) rhm}
hunk ./src/Data/HypoSpace.hs 107
-alterRuleIdsMap :: (Maybe [Integer] -> Maybe [Integer])
+alterRuleIdsMap :: (Maybe IDs -> Maybe IDs)
hunk ./src/Data/HypoSpace.hs 117
-        frgs = fragsToList.open $ h in
+        frgs = S.toList.open $ h in
hunk ./src/Data/HypoSpace.hs 120
-alterHypoIdBimap :: (Hypo -> Bimap Hypo Integer -> Bimap Hypo Integer)
+alterHypoIdBimap :: (Hypo -> Bimap Hypo ID -> Bimap Hypo ID)
hunk ./src/Data/HypoSpace.hs 129
-    in  hsp{hypoIdBimap = f h him} 
+    in  h `seq` hsp{hypoIdBimap = f h him} 
hunk ./src/Data/HypoSpace.hs 134
-    { hypoCount   = 0
-    , rateIdsMap  = M.empty
+    { hypoCounter   = 0
+    , rateIdsMap  = I.empty
hunk ./src/Data/HypoSpace.hs 144
-    initHypo = hypo $ ruleFrags [rf]
+    initHypo = hypo [rf]
hunk ./src/Data/HypoSpace.hs 149
-insert h hsp =  
-    incrementHypoCount $ 
-    alterRateIdsMap  (mbInsert iD)      h $
-    alterHypoIdBimap (flip B.insert iD) h $
-    alterRuleIdsMap  (mbInsert iD)      h $
-    hsp
+insert h hsp 
+	| (B.member h (hypoIdBimap hsp)) = hsp
+	| otherwise 					 =
+--		trace ("INSERT: " ++ " " ++ (show (M.elems (rateIdsMap hsp))) ++ "\n" ++ (show ((B.keysR.hypoIdBimap) hsp))) 
+--	    trace (show (B.member h (hypoIdBimap hsp),B.memberR iD (hypoIdBimap hsp)))
+--	    trace (show ((B.lookup h (hypoIdBimap hsp)):: (Maybe Integer)))
+--	    trace (show h)
+--	    trace (show hsp)
+	    incrementHypoCount $ 
+	    alterRateIdsMap  (mbInsert iD)      h $!
+	    alterRuleIdsMap  (mbInsert iD)      h $!
+	    alterHypoIdBimap (flip B.insert iD) h $!
+	    hsp
hunk ./src/Data/HypoSpace.hs 163
-    iD = hypoCount hsp
+    iD = hypoCounter hsp
hunk ./src/Data/HypoSpace.hs 166
-            Just is' -> Just $ i:is'
-            Nothing  -> Just $ [i] 
+            Just is' -> Just $ IS.insert i is'
+            Nothing  -> Just $ IS.singleton i 
hunk ./src/Data/HypoSpace.hs 171
-delete h hsp = 
-    alterRateIdsMap (mbDelete iD) h $
-    alterRuleIdsMap (mbDelete iD) h $ 
-    alterHypoIdBimap B.delete     h $ 
+delete h hsp =
+	--trace ("DELETE: " ++ " " ++ (show (M.elems (rateIdsMap hsp))) ++ "\n" ++ (show ((B.keysR.hypoIdBimap) hsp)))
+    alterRateIdsMap (mbDelete iD) h $!
+    alterRuleIdsMap (mbDelete iD) h $! 
+    alterHypoIdBimap B.delete     h $!
hunk ./src/Data/HypoSpace.hs 182
-        let is' =  filter (/= i) is
-        in if null is' 
+        let is' =  IS.delete i is
+        in if IS.null is' 
hunk ./src/Data/HypoSpace.hs 187
--- | /O(log n)/, try to replace a 'Hypo', if the second argument is 'Nothing' 
---   the HypoSpace is returned unchanged.       
-replace :: Hypo -> Maybe Hypo -> HSpace -> HSpace       
-replace ho hn = (maybeInsert hn).(delete ho)
-    where 
-    maybeInsert h = 
-        case h of
-            Just h' -> insert h'
-            Nothing -> id
+-- | /O(log n)/, replace a 'Hypo', by a list of 'Hypo's
+replace :: Hypo -> [Hypo] -> HSpace -> HSpace       
+replace ho hn = (\hsp -> foldl' (flip insert) hsp hn) .(delete ho)
hunk ./src/Data/HypoSpace.hs 194
-propagateHSp :: (RuleFrag,RuleFrags,[Call]) -> HSpace -> HSpace
-propagateHSp pdata@(ro,_,_) hsp   =  
-    foldl' (flip devAndRep) hsp affectedHs
+propagateHSp :: RuleFrag -> [(RuleFrags,[Call])] -> HSpace -> HSpace
+propagateHSp ro advs hsp = 
+	--trace ("AFFECTED: " ++ (show (length affectedHs)))
+	foldl' (\sp h -> replace h (develop h) sp) hsp affectedHs
+	--hsp''
hunk ./src/Data/HypoSpace.hs 200
-    devAndRep  = (developH pdata) >>= flip replace  
-    affectedHs = 
-        case M.lookup ro (ruleIdsMap hsp) of
-            Just hs -> mapMaybe (flip getById hsp) hs 
-            Nothing -> []
+    --hsp' = foldl' (flip delete) hsp affectedHs
+    --hsp'' = foldl' (flip insert) hsp' developedHs
+    develop h = catMaybes $ [ developH ro adv h | adv <- advs] 
+    --developedHs = concatMap develop affectedHs
+    affectedHs =
+    	case M.lookup ro (ruleIdsMap hsp) of
+    		Just ids -> mapMaybe (flip getById hsp) (IS.toList ids)
+    		Nothing -> []
hunk ./src/Data/HypoSpace.hs 211
-bestHypos = hypos.((snd . M.findMin . rateIdsMap) >>= getByIds)
+bestHypos  = hypos.((IS.toList . I.findMin . rateIdsMap) >>= getByIds)
+
hunk ./src/Data/HypoSpace.hs 223
-             
-        
-    
hunk ./src/Data/Hypotheses.hs 17
-    module Data.Fragments
+    module Data.Rules
hunk ./src/Data/Hypotheses.hs 34
-import Data.Fragments 
+import Data.Rules
+import Data.IOData
hunk ./src/Data/Hypotheses.hs 45
-data Hypo  = HH { open :: !RuleFrags
+data Hypo  = HH { open :: !(Set RuleFrag)
hunk ./src/Data/Hypotheses.hs 49
+               deriving(Eq, Ord)
hunk ./src/Data/Hypotheses.hs 51
-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)
+--closed h = foldl1 (S.union) (M.elems.clsd h)
+--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 71
-    rate h       = countFs (open h)--F.fold (\r d -> (rate r) + d) 0 (open h)
+    rate h       =  -- S.size (open h) -- count number of open rules
+    			 let clsdrs = foldl' S.union S.empty (map rulesToSet (M.elems (clsd h)))
+    			     openrs = (S.map frag(open h))
+    			 in  S.size $ S.map lhs (S.union clsdrs openrs)
+				 -- total number of rules
+                   
hunk ./src/Data/Hypotheses.hs 88
-hypo :: RuleFrags -> Hypo    
-hypo ro  = HH ro M.empty noCalls
+hypo :: [RuleFrag] -> Hypo
+hypo rs  = foldl' (flip extendH) h rs 
+    where
+    h = HH S.empty M.empty noCalls
hunk ./src/Data/Hypotheses.hs 100
-        (RuleFrag        -- the RuleFrag that was changed
-        ,RuleFrags       -- the RuleFrags rsulting from the change
+        RuleFrag ->      -- the RuleFrag that was changed
+        (RuleFrags       -- the RuleFrags resulting from the change
hunk ./src/Data/Hypotheses.hs 105
-developH (rf,rfs,calls) h = do 
+developH rf (rfs,calls) h = do 
hunk ./src/Data/Hypotheses.hs 117
-    | isOpen rf  = h{open = insertFs rf os}
+    | isOpen rf  = h{open = S.insert rf os}
hunk ./src/Data/Hypotheses.hs 123
-    | isOpen rf  = h{open = deleteFs rf os}
+    | isOpen rf  = h{open = S.delete rf os}
hunk ./src/Data/Hypotheses.hs 134
-    foldFs extendH shrnk newrs 
+    S.fold extendH shrnk newrs 
hunk ./src/Data/IOData.hs 2
-module Data.IOData where
+module Data.IOData (
+
+    RuleFrag, name, frag, opos,
+    isOpen,
+    
+    RuleFrags,
+    
+    IOData, initIOData, getAll, breakup, fuse --, getSpecifics--, coverAll, coverRules 
+
+    
+    )where
hunk ./src/Data/IOData.hs 17
-import Data.Fragments
+import Data.Rules
hunk ./src/Data/IOData.hs 30
-import Data.List (foldl', transpose)
+import Data.Set (Set)
+import qualified Data.Set as S 
+
+import Data.List (nub, foldl', transpose, (\\) )
+
+--------------------------------------------------------------------------------
+-- Datatype RuleFragment
+--------------------------------------------------------------------------------
+
+-- | An open position is defined by an expression (which should be a variable)
+--   and a list of 'Position's in a term, which are open. 
+--   This only makes sense in combination with a 'Rule'
+type OpenPos = (Exp,[Position])
+
+-- 
+-- Encapsulating all information of an open/unfinished Rule
+data RuleFrag = RF
+    { name  :: !Name      -- ^ the name of the function/rule
+    , frag  :: !Rule      -- ^ the rule itself
+    , covr  :: ![Int]     -- ^ the indices of covered I/O examples (stored in a IOData)
+    , opos  :: ![OpenPos] -- ^ the open positions of this fragment    
+    }
+    deriving(Eq, Ord)
+  
+instance Show RuleFrag where
+	show (RF n f c _) =
+		(shows n) . (shows f) . (showString " ") $ show c
+instance Pretty RuleFrag where
+	pretty = text.show
+    
+type RuleFrags = Set RuleFrag
+ 
+instance Rateable RuleFrag where
+    rate = rate.frag
+
+    
+ -- | A rule is open if it is not closed
+isOpen :: RuleFrag -> Bool
+isOpen = not.isClosed
+
+-- | A rule is closed if it does not have any open positions
+isClosed = null.opos
+
+
+-- |Returns a list with all free variables (as a list of expressions)
+--  in the given rule 
+freeVars  :: Rule -> [Exp]
+freeVars  r = 
+    let lhsvars = concatMap getVarNames $ lhs r
+        rhsvars = getVarNames.rhs $ r
+        diff    = (\\) rhsvars lhsvars
+    in map VarE diff
hunk ./src/Data/IOData.hs 83
+hasFreeVars :: Rule -> Bool
+hasFreeVars = not.null.freeVars
+
+openPositions :: Rule -> [OpenPos]
+openPositions r = map (openPos r) (freeVars r)
+    where
+    openPos r e = (e, getPos (rhs r) e)
+    
+--------------------------------------------------------------------------------
+-- Datatype RuleFragment
+--------------------------------------------------------------------------------
hunk ./src/Data/IOData.hs 107
+    deriving (Show)
hunk ./src/Data/IOData.hs 128
- | /O(log n)/ Insert the rules associated with the Name into the IOData, but only if 
- |neither is already in IOData. 
+ | /O(log n)/ Insert the rules associated with the Name into the IOData, but 
+   only if neither is already in IOData. 
hunk ./src/Data/IOData.hs 156
-getAll :: Name -> IOData ->  [Rule]
+getAll :: Name -> IOData ->  [RuleFrag]
hunk ./src/Data/IOData.hs 159
-        Just rs -> rulesToList rs
+        Just rs -> let rl = rulesToList rs
+                   in [RF n (rl !! i) [i] [] | i <- [0.. (length rl) -1] ]
hunk ./src/Data/IOData.hs 162
- 
+
hunk ./src/Data/IOData.hs 164
---  background knowledge (zero based)
--- TODO is really guaranteed that a rule has always the same index?      
-getSpecific :: Name -> IOData -> Int -> Rule
+--  background knowledge (zero based). The position is determined by 
+--  'Data.rules.ruleAtIndex'. Since 'Rules', once stored in IOData, is never 
+--  changed, it is guaranteed, that the index does not change.      
+-- UNSAFE
+getSpecific :: Name -> IOData -> Int -> RuleFrag
hunk ./src/Data/IOData.hs 171
--- |sRetrieve the specified 'Rules' of a function with the provided 'Name' from the 
---  background knowledge (zero based)       
--- TODO is really guaranteed that a rule has always the same index?
-getSpecifics :: Name -> IOData -> [Int] -> [Rule]
+-- |Retrieve the specified 'Rules' of a function with the provided 'Name' from the 
+--  background knowledge (zero based)      . The position is determined by 
+--  'Data.rules.ruleAtIndex'. Since 'Rules', once stored in IOData, is never 
+--  changed, it is guaranteed, that the index does not change.
+-- UNSAFE      
+getSpecifics :: Name -> IOData -> [Int] -> [RuleFrag]
hunk ./src/Data/IOData.hs 178
+ 
+breakup :: IOData -> RuleFrag -> [RuleFrag]
+breakup iod rf = getSpecifics (name rf) iod (covr rf)
+
+fuse :: [RuleFrag] -> RuleFrag
+fuse frags = 
+    if all (==n) names
+      then RF n rule indices opos
+      else error $ "Data.IOData.fuse : Cannot fuse RuleFrags with different names!"
+    where
+    (n:names)    = map name frags 
+    rules        = map frag frags
+    rule         = noLog $ antiunifyRules rules
+    opos         = openPositions rule
+    indices      = nub $ concatMap covr frags
+        
hunk ./src/Data/IOData.hs 203
--- | Create a 'RuleFrag' which covers all 'Rule's in 'IOData' with the given 'Name'
-coverAll :: IOData -> Name -> RuleFrag
-coverAll iod n =
-    let rules = getAll n iod 
-        rule  = noLog $ antiunifyRules rules
-        opos  = openPositions rule
-        is    = [0.. (length rules) - 1]
-    in ruleFrag n rule is opos
-    
--- | Create a 'RuleFrag' which covers all 'Rule's in 'IOData' with the given 
---   'Name' and and index in '[Int]'
-coverRules :: IOData -> Name -> [Int] -> RuleFrag
-coverRules iod n is =
-    let rules = getSpecifics n iod is
-        rule  = noLog $ antiunifyRules rules
-        opos  = openPositions rule
-    in ruleFrag n rule is opos
-    
+       
hunk ./src/Data/IOData.hs 211
+
hunk ./src/Data/IOData.hs 244
-   
+
+
+ 
+    
hunk ./src/Data/IgorMonad.hs 8
-    setTarget, currentBestHypos, getEvidence,
+    setTarget, currentBestHypos, getEvidence, getSearchSpace, 
+    tick, loopCount, hypoCount,
hunk ./src/Data/IgorMonad.hs 19
-import Data.IOData (IOData, getAll, getSpecifics, coverAll, coverRules, initIOData)
+import Data.IOData
hunk ./src/Data/IgorMonad.hs 38
-currentBestHypos = liftM bestHypos $ gets searchSpace
+currentBestHypos = liftM bestHypos $! gets searchSpace
hunk ./src/Data/IgorMonad.hs 43
+getSearchSpace :: IM HSpace
+getSearchSpace = gets searchSpace
hunk ./src/Data/IgorMonad.hs 46
+
+tick :: IM ()
+tick = modify incrLCount
+
+loopCount :: IM Int
+loopCount = gets $ snd.head.loopcount
+
+hypoCount :: IM Int
+hypoCount = gets $ countHypos.searchSpace
+ 
hunk ./src/Data/IgorMonad.hs 62
-setupTarget ( Igor iod _ ) n  = Igor iod $! initHSpace (coverAll iod n)
+setupTarget ( Igor iod _ lc) n  = Igor iod (initHSpace (fuse (getAll n iod))) ((n,0):lc) 
hunk ./src/Data/IgorMonad.hs 68
-initIgor nr = Igor (initIOData nr) emptyHSpace
+initIgor nr = Igor (initIOData nr) emptyHSpace []
hunk ./src/Data/IgorMonad.hs 71
-propagate :: (RuleFrag,RuleFrags,[Call]) -> Igor -> Igor   
-propagate p (Igor iod sp) = Igor iod (propagateHSp p sp)
+propagate :: RuleFrag -> [(RuleFrags,[Call])] -> Igor -> Igor   
+propagate rf adv (Igor iod sp lc) = Igor iod (propagateHSp rf adv sp) lc
+
+incrLCount :: Igor -> Igor
+incrLCount i@(Igor _ _ ((n,lc):lcs)) =
+    i{loopcount = (n,lc+1):lcs}
hunk ./src/Data/Initialiser.hs 8
-    rules2decs, rules2dec, rules2clauses, rule2clauses
+    hypos2decs,rules2decs, rules2dec, rules2clauses, rule2clauses
hunk ./src/Data/Initialiser.hs 17
+import Data.List
hunk ./src/Data/Initialiser.hs 21
-import Data.Fragments (ruleFrag, ruleFrags, openPositions, freeVars)
+--import Data.Rules --Fragments (ruleFrag, ruleFrags, openPositions, freeVars)
hunk ./src/Data/Initialiser.hs 56
---    
+--   
+hypos2decs :: [[(Name,Rules)]] -> [[Dec]]
+hypos2decs hs = map rules2decs hs'
+	where
+	hs' = case hs of
+	 		(x:xs) -> intersperse [(mkName "newHypo",rules[])] hs--x:(rename 1 xs)
+	 		_owise -> hs
+--	rename _ [] = []		
+--	rename i (x:xs) = (renameName i x):(rename (i+1) xs)
+--	renameName
+
hunk ./src/Data/Initialiser.hs 81
-
--------------------------------------------------
--- Testing Data
-------------------------------------------------- 
-printQ q = (runQ q) >>= putStrLn . pprint 
-showQ q = (runQ q) >>= putStrLn . show
-mkVP s = VarP (mkName s)
-mkVE s = VarE (mkName s)
- 
-rev = liftM head [d| rev [] = []
-                     rev [x] = [x]
-                     rev [x,y] = [y,x]
-                     rev [x,y,z] = [z,x,y]
-                     rev [w,x,y,z] = [z,y,x,w] 
-                 |]
-revai = liftM head [d| rev x = x
-                       rev (x1:xs) = (x1:xs)
-                       rev (x1:x2:xs) = (x1:x2:xs)
-                       rev (x1:x2:x3:xs) = (x1:x2:x3:xs)
-                       rev (x1:x2:x3:x4:[]) = (x1:x2:x3:x4:[]) 
-                   |]
-rev0 = rule [ConP '[] []] (ConE '[])
-rev1 = rule [ListP [mkVP "a_6"]] (ListE [mkVE "a_6"])
-rev2 = rule [ListP [mkVP "a_7",mkVP "b_8"]] (ListE [mkVE "b_8",mkVE "a_7"])
-rev3 = rule [ListP [mkVP "a_9",mkVP "b_10",mkVP "c_11"]] (ListE [mkVE "c_11",mkVE "b_10",mkVE "a_9"])
-rev4 = rule [ListP [mkVP "a_12",mkVP "b_13",mkVP "c_14", mkVP "d_15"]] (ListE [mkVE "d_15", mkVE "c_14",mkVE "b_12",mkVE "a_11"])
-
-ep = (mkVP "y1_14")
-revai04 = rule [mkVP "x_14"] (mkVE "y_14")
-fragai04 = ruleFrag (mkName "rev") revai04 [0,1,2,3,4] []
-revai14 = rule [InfixP (mkVP "x1_15") '(:) (mkVP "x_16")] 
-                (InfixE (Just (mkVE "y1_15")) (ConE '(:)) (Just (mkVE "ys_16")))
-fragai14 = ruleFrag (mkName "rev") revai14 [1,2,3,4] []                
-revai24 = rule [InfixP (mkVP "x1_17") '(:) (InfixP (mkVP "x2_18") '(:) (mkVP "xs_19"))]
-               (InfixE (Just (mkVE "y1_17")) (ConE '(:)) (Just (InfixE (Just (mkVE "y2_18")) (ConE '(:)) (Just (mkVE "ys_19")))))
-fragai24 = ruleFrag (mkName "rev") revai24 [2,3,4] []                
-revai34 = rule [InfixP (mkVP "x1_20") '(:) (InfixP (mkVP "x2_21") '(:) (InfixP (mkVP "x3_22") '(:) (mkVP "xs_23")))]
-               (InfixE (Just (mkVE "y1_20")) (ConE '(:)) (Just (InfixE (Just (mkVE "y2_21")) (ConE '(:)) (Just (InfixE (Just (mkVE "y3_22")) (ConE '(:)) (Just (mkVE "ys_23")))))))
-fragai34 = ruleFrag (mkName "rev") revai34 [3,4] []                
-revai44 = rule [InfixP (mkVP "x1_24") '(:) (InfixP (mkVP "x2_25") '(:) (InfixP (mkVP "x3_26") '(:) (InfixP (mkVP "x4_27") '(:) (ConP '[] []))))]
-               (InfixE (Just (mkVE "y1_24")) (ConE '(:)) (Just (InfixE (Just (mkVE "y2_25")) (ConE '(:)) (Just (InfixE (Just (mkVE "y3_26")) (ConE '(:)) (Just (InfixE (Just (mkVE "y4_27")) (ConE '(:)) (Just (ConE '[])))))))))
-fragai44 = ruleFrag (mkName "rev") revai44 [4] []                
-
-fragsempty = ruleFrags []
-fragsai04 = ruleFrags [fragai04]
-fragsai14 = ruleFrags [fragai04,fragai14]
-fragsai24 = ruleFrags [fragai04,fragai14,fragai24]
-fragsai34 = ruleFrags [fragai04,fragai14,fragai24,fragai34]
-fragsai44 = ruleFrags [fragai04,fragai14,fragai24,fragai34,fragai44]
-
-hypor04 = hypo $ ruleFrags [fragai04]
-hypor14 = hypo $ fragsai14 --ruleFrags [fragai04,fragai14]
-hypor24 = hypo $ ruleFrags [fragai04,fragai14,fragai24]
-hypor34 = hypo $ ruleFrags [fragai04,fragai14,fragai24,fragai34]
-hypor44 = hypo $ ruleFrags [fragai04,fragai14,fragai24,fragai34,fragai44]
-
-
-pd0414 = (fragai04,ruleFrags [fragai04,fragai14],[])
-pd1424 = (fragai14,ruleFrags [fragai04,fragai14,fragai24],[])
-pd2434 = (fragai24,ruleFrags [fragai04,fragai14,fragai24,fragai34],[])
-pd3444 = (fragai34,ruleFrags [fragai04,fragai14,fragai24,fragai34,fragai44],[])
-
---revhsp0 = initHSpace hypor04
---revhsp1 = insert hypor24 revhsp0
---revhsp2 = insert hypor34 revhsp1
---revhsp3 = insert hypor44 revhsp2
hunk ./src/Data/Initialiser.hs 82
---test1 = propagate pd1424 $ propagate pd0414 revhsp3
+---------------------------------------------------
+---- Testing Data
+--------------------------------------------------- 
+--printQ q = (runQ q) >>= putStrLn . pprint 
+--showQ q = (runQ q) >>= putStrLn . show
+--mkVP s = VarP (mkName s)
+--mkVE s = VarE (mkName s)
+-- 
+--rev = liftM head [d| rev [] = []
+--                     rev [x] = [x]
+--                     rev [x,y] = [y,x]
+--                     rev [x,y,z] = [z,x,y]
+--                     rev [w,x,y,z] = [z,y,x,w] 
+--                 |]
+--revai = liftM head [d| rev x = x
+--                       rev (x1:xs) = (x1:xs)
+--                       rev (x1:x2:xs) = (x1:x2:xs)
+--                       rev (x1:x2:x3:xs) = (x1:x2:x3:xs)
+--                       rev (x1:x2:x3:x4:[]) = (x1:x2:x3:x4:[]) 
+--                   |]
+--rev0 = rule [ConP '[] []] (ConE '[])
+--rev1 = rule [ListP [mkVP "a_6"]] (ListE [mkVE "a_6"])
+--rev2 = rule [ListP [mkVP "a_7",mkVP "b_8"]] (ListE [mkVE "b_8",mkVE "a_7"])
+--rev3 = rule [ListP [mkVP "a_9",mkVP "b_10",mkVP "c_11"]] (ListE [mkVE "c_11",mkVE "b_10",mkVE "a_9"])
+--rev4 = rule [ListP [mkVP "a_12",mkVP "b_13",mkVP "c_14", mkVP "d_15"]] (ListE [mkVE "d_15", mkVE "c_14",mkVE "b_12",mkVE "a_11"])
+--
+--ep = (mkVP "y1_14")
+--revai04 = rule [mkVP "x_14"] (mkVE "y_14")
+--fragai04 = ruleFrag (mkName "rev") revai04 [0,1,2,3,4] []
+--revai14 = rule [InfixP (mkVP "x1_15") '(:) (mkVP "x_16")] 
+--                (InfixE (Just (mkVE "y1_15")) (ConE '(:)) (Just (mkVE "ys_16")))
+--fragai14 = ruleFrag (mkName "rev") revai14 [1,2,3,4] []                
+--revai24 = rule [InfixP (mkVP "x1_17") '(:) (InfixP (mkVP "x2_18") '(:) (mkVP "xs_19"))]
+--               (InfixE (Just (mkVE "y1_17")) (ConE '(:)) (Just (InfixE (Just (mkVE "y2_18")) (ConE '(:)) (Just (mkVE "ys_19")))))
+--fragai24 = ruleFrag (mkName "rev") revai24 [2,3,4] []                
+--revai34 = rule [InfixP (mkVP "x1_20") '(:) (InfixP (mkVP "x2_21") '(:) (InfixP (mkVP "x3_22") '(:) (mkVP "xs_23")))]
+--               (InfixE (Just (mkVE "y1_20")) (ConE '(:)) (Just (InfixE (Just (mkVE "y2_21")) (ConE '(:)) (Just (InfixE (Just (mkVE "y3_22")) (ConE '(:)) (Just (mkVE "ys_23")))))))
+--fragai34 = ruleFrag (mkName "rev") revai34 [3,4] []                
+--revai44 = rule [InfixP (mkVP "x1_24") '(:) (InfixP (mkVP "x2_25") '(:) (InfixP (mkVP "x3_26") '(:) (InfixP (mkVP "x4_27") '(:) (ConP '[] []))))]
+--               (InfixE (Just (mkVE "y1_24")) (ConE '(:)) (Just (InfixE (Just (mkVE "y2_25")) (ConE '(:)) (Just (InfixE (Just (mkVE "y3_26")) (ConE '(:)) (Just (InfixE (Just (mkVE "y4_27")) (ConE '(:)) (Just (ConE '[])))))))))
+--fragai44 = ruleFrag (mkName "rev") revai44 [4] []                
+--
+--fragsempty = ruleFrags []
+--fragsai04 = ruleFrags [fragai04]
+--fragsai14 = ruleFrags [fragai04,fragai14]
+--fragsai24 = ruleFrags [fragai04,fragai14,fragai24]
+--fragsai34 = ruleFrags [fragai04,fragai14,fragai24,fragai34]
+--fragsai44 = ruleFrags [fragai04,fragai14,fragai24,fragai34,fragai44]
+--
+--hypor04 = hypo $ ruleFrags [fragai04]
+--hypor14 = hypo $ fragsai14 --ruleFrags [fragai04,fragai14]
+--hypor24 = hypo $ ruleFrags [fragai04,fragai14,fragai24]
+--hypor34 = hypo $ ruleFrags [fragai04,fragai14,fragai24,fragai34]
+--hypor44 = hypo $ ruleFrags [fragai04,fragai14,fragai24,fragai34,fragai44]
+--
+--
+--pd0414 = (fragai04,ruleFrags [fragai04,fragai14],[])
+--pd1424 = (fragai14,ruleFrags [fragai04,fragai14,fragai24],[])
+--pd2434 = (fragai24,ruleFrags [fragai04,fragai14,fragai24,fragai34],[])
+--pd3444 = (fragai34,ruleFrags [fragai04,fragai14,fragai24,fragai34,fragai44],[])
+--
+----revhsp0 = initHSpace hypor04
+----revhsp1 = insert hypor24 revhsp0
+----revhsp2 = insert hypor34 revhsp1
+----revhsp3 = insert hypor44 revhsp2
+----
+----test1 = propagate pd1424 $ propagate pd0414 revhsp3
+----
+----hyposrevall = insert hypor44 $ insert hypor34 $ insert hypor24 $ insert hypor14 $  initHSpace hypor04
+--
+--revs = (mkName "rev", rules [rev0,rev1,rev2,rev3,rev4])
+--
+--snoc = liftM head [d| snoc [] w = [w]
+--                      snoc [w] x = [w,x]
+--                      snoc [w,x] y = [w,x,y]
+--                      snoc [w,x,y] z = [w,x,y,z] 
+--                  |]
+--
+--snoc0 = rule [ConP '[] [], mkVP "w_0"](ListE [mkVE "w_0"])
+--snoc1 = rule [ListP [mkVP "w_1"],mkVP "x_2"] (ListE [mkVE "w_1",mkVE "x_2"])
+--snoc2 = rule [ListP [mkVP "w_3",mkVP "x_4"],mkVP "y_5"] (ListE [mkVE "w_3",mkVE "x_4",mkVE "y_5"])
+--snoc3 = rule [ListP [mkVP "w_6",mkVP "x_7",mkVP "y_8"],mkVP "z_9"] (ListE [mkVE "w_6",mkVE "x_7",mkVE "y_8",mkVE "z_9"])
hunk ./src/Data/Initialiser.hs 165
---hyposrevall = insert hypor44 $ insert hypor34 $ insert hypor24 $ insert hypor14 $  initHSpace hypor04
-
-revs = (mkName "rev", rules [rev0,rev1,rev2,rev3,rev4])
-
-snoc = liftM head [d| snoc [] w = [w]
-                      snoc [w] x = [w,x]
-                      snoc [w,x] y = [w,x,y]
-                      snoc [w,x,y] z = [w,x,y,z] 
-                  |]
-
-snoc0 = rule [ConP '[] [], mkVP "w_0"](ListE [mkVE "w_0"])
-snoc1 = rule [ListP [mkVP "w_1"],mkVP "x_2"] (ListE [mkVE "w_1",mkVE "x_2"])
-snoc2 = rule [ListP [mkVP "w_3",mkVP "x_4"],mkVP "y_5"] (ListE [mkVE "w_3",mkVE "x_4",mkVE "y_5"])
-snoc3 = rule [ListP [mkVP "w_6",mkVP "x_7",mkVP "y_8"],mkVP "z_9"] (ListE [mkVE "w_6",mkVE "x_7",mkVE "y_8",mkVE "z_9"])
-
hunk ./src/Data/Rules.hs 6
+    RulePos(..), ruleSubtermAt, lhsSubtermAt, ruleVarPos, compareAtPos,
hunk ./src/Data/Rules.hs 34
-
hunk ./src/Data/Rules.hs 42
---FIXME
---type LHS = PatQ
---type RHS = ExpQ
---
---instance Eq PatQ
---instance Ord PatQ
---instance Show PatQ
---
---instance Eq ExpQ
---instance Ord ExpQ
---instance Show ExpQ
-
-
hunk ./src/Data/Rules.hs 49
+data RulePos = Arg Int Position -- zero-based
+             | Body Position
+             deriving (Show)
+
+instance Pretty RulePos where
+	pretty = text.show
+	             
+-- | Computes all positions in a rule at which is a variable. The first list
+--   contains the variable positions of the first argument, the second of the 
+--   second argument and the last of the right-hand side of the rule.            
+ruleVarPos :: Rule -> [[RulePos]]
+ruleVarPos r =  lside ++ [rside]    
+    where
+    argcount = [0.. (length $ lhs r) -1]
+    lside = map (\i -> map (Arg i) (varpos ((lhs r) !! i)) ) argcount
+    rside = map Body (varpos (rhs r))
+    varpos t =  concat.snd.unzip $ getVarPos t  
+
+
+ruleSubtermAt :: RulePos -> Rule -> Either (Maybe Pat) (Maybe Exp)
+ruleSubtermAt p@(Arg _ _) r = Left $ lhsSubtermAt p r
+ruleSubtermAt p@(Body _) r  = Right $ rhsSubtermAt p r
hunk ./src/Data/Rules.hs 72
+lhsSubtermAt :: RulePos -> Rule -> Maybe Pat
+lhsSubtermAt (Arg i p) r = subtermAt ((lhs r) !! i) p
+lhsSubtermAt _ _ = error $ "Data.Rules.lhsSubtermAt : The given position is" ++ 
+                           "not a position on the left-hand side of the rule"  
+
+rhsSubtermAt :: RulePos -> Rule -> Maybe Exp
+rhsSubtermAt (Body p) r  = subtermAt (rhs r) p
+rhsSubtermAt _ _ = error $ "Data.Rules.rhsSubtermAt : The given position is" ++ 
+                           "not a position on the right-hand side of the rule"
+
+compareAtPos :: RulePos -> Rule -> Rule -> Bool
+compareAtPos p@(Arg _ _ ) r1 r2 =
+    case (lhsSubtermAt p r1,lhsSubtermAt p r2) of
+        (Just t1,Just t2) -> sameAtPos t1 t2 Root
+        _otherwise        -> False
+compareAtPos p@(Body _ ) r1 r2 =
+    case (rhsSubtermAt p r1,rhsSubtermAt p r2) of
+        (Just t1,Just t2) -> sameAtPos t1 t2 Root
+        _otherwise        -> False
hunk ./src/Data/Rules.hs 113
--- | 'Rules' are a collection of 'Rule's with no duplicates
+-- | 'Rules' are an indexed collection of 'Rule's with no duplicates
hunk ./src/Data/Rules.hs 123
+ruleAtIndex :: Int -> Rules -> Rule
+ruleAtIndex  i rs = (rulesToList rs) !! i
+ 
hunk ./src/Data/Util.hs 8
-            $ showString "{"
+            $ showString "{  "
hunk ./src/Data/Util.hs 10
-                 then shows (head l) $ foldr (\s -> showString ", " . shows s) " }" (tail l) 
+                 then shows (head l) $ foldr (\s -> showString " , " . shows s) " }" (tail l) 
hunk ./src/Data/Util.hs 12
-                 
+ 
+showAssoc (l,r) =	showString "\n  " . (shows l) . (showString " ->  ") . (shows r)
+
+showAsPairFlipped (l,r) = showAssoc (r,l)
+                  
hunk ./src/Main.hs 5
-import Data
hunk ./src/Main.hs 12
+import ExampleDefs
+
hunk ./src/Main.hs 20
-
hunk ./src/Main.hs 201
-revexmpls1 = liftM head [d| rev [] = []
-                            rev [x] = [x]
-                            rev [x,y] = [y,x]
-                            rev [x,y,z] = [z,x,y]
-                         |]
-revexmpls2 = liftM head [d| rev [x,y,z] = [z,x,y]
-                            rev [x,y] = [y,x]
-                            rev [x] = [x] 
-                            rev [] = []
-                         |]
-revdef = [d| rev [] = []
-             rev [x] = [x]
-             rev [x,y] = [y,x]
-             rev [x,y,z] = [z,x,y]
-          |]
-initdef = [d| ini [w] = w
-              ini [x,w] = x 
-              ini [y,x,w] = y
-              ini [z,y,x,w] = z
-           |]
-                               
-fundefs =    [d| rev [] = []
-                 rev [x] = [x]
-                 rev [x,y] = [y,x]
-                 rev [x,y,z] = [z,x,y]
-                 ini [w] = w
-                 ini [x,w] = x 
-                 ini [y,x,w] = y
-                 ini [z,y,x,w] = z
-              |]
hunk ./src/Main.hs 202
-testunify :: (Term t, Antiunifieable k v t,Unifieable t) => t -> t -> LM t
-testunify t s = do --setGlobalLogLevel "Test"
-                   setCurrentLogger "Test.testunify"
-                   logIN $ ["Term 1 is ", skip (view t),"Term 2 is ", skip (view s) ]
-                                      
-                   logIN $ ["Unifying Term1 and Term1"]
-                   u1 <- mgu t s
-                   logIN $ ["Resulting unifier is " ++ (view u1)]      
-                   return t
-                   
-testantiunify :: (Term t, Antiunifieable k v t,Unifieable t) => t -> t -> LM t
-testantiunify t s = do logIN $ ["Term 1 is ", skip (view t),"Term 2 is ", skip (view s) ]
-                   
-                       logIN $ ["Antiunifying Term1 and Term2"]
-                       ai <- antiunify [t,s]
-                       logIN $ ["Resulting antiinstance is " ++ (view ai)]    
-                       return t                                   
-testcase1 :: (Term t, Antiunifieable k v t,Unifieable t) => t -> t -> LM t
-testcase1 t s = do --setGlobalLogLevel "Test"
-                   setCurrentLogger "Test.testcase1" 
-                   logIN $ ["Term 1 is ", skip (view t),"Term 2 is ", skip (view s) ]
-                   
-                   logIN $ ["Antiunifying Term1 and Term2"]
-                   ai <- antiunify [t,s]
-                   logIN $ ["Resulting antiinstance is " ++ (view ai)]                   
-                   
-                   logIN $ ["Unifying Term1 and antiinstance"]
-                   u1 <- mgu t ai
-                   logIN $ ["Resulting unifier is " ++ (view u1)]      
-                   
-                   logIN $ ["Unifying Term1 and Term2"]
-                   u2 <- mgu t s
-                   logIN $ ["Resulting unifier is " ++ (view u2)]
-                   
-                   logIN ["Applying unifier to Term1: " ++ (view t)]
-                   au1 <- applyMgu u2 t
-                   logIN $ ["Result is " ++ (view au1)]    
-                   
-                   logIN ["Applying unifier to Term2: " ++ (view s)]
-                   au2 <- applyMgu u2 s
-                   logIN $ ["Result is " ++ (view au2)]            
-                   return au2
-                   
-testcase2 :: (Term t, Antiunifieable k v t,Unifieable t) => t -> t -> LM t
-testcase2 t s = do --setGlobalLogLevel "Test"
-                   setCurrentLogger "Test.testcase2" 
-                   logIN $ ["Term 1 is ", skip (view t),"Term 2 is ", skip (view s) ]
-                   
-                   logIN $ ["Antiunifying Term1 and Term2"]
-                   ai <- antiunify [t,s]
-                   logIN $ ["Resulting antiinstance is " ++ (view ai)]                   
-                   
-                   logIN $ ["Unifying Term1 and antiinstance"]
-                   u1 <- mgu t ai
-                   logIN $ ["Resulting unifier is " ++ (view u1)]
-                   
-                   logIN $ ["Matching Term1 and antiinstance"]
-                   m <- matches t ai
-                   logIN $ ["Result is " ++ (show m)]
-                   return t
-                   
-testcase3 :: (Term t, Antiunifieable k v t,Unifieable t) => t -> t -> LM t
-testcase3 t s = do --setGlobalLogLevel "Test"
-                   setCurrentLogger "Test.testcase3" 
-                   logIN $ ["Term 1 is ", skip (view t),"Term 2 is ", skip (view s) ]
-                   
-                   logIN $ ["Antiunifying Term1 and Term2"]
-                   ai <- antiunify [t,s]
-                   logIN $ ["Resulting antiinstance is ",(view ai)]  
-                   
-                   logIN $ ["Positions of Variable in Anitinstance"]
-                   let varpos = getVarPos ai
-                   logIN $ ["Variables at positions:",(show varpos)]
-                   
-                   return t
-                   
---testinit :: Dec -> Dec -> LM Dec
---testinit d1 d2 = do logIN $ ["Dec1 is ", skip (view d1),"Dec2 is ", skip (view d2) ]
---
---                    logIN $ ["Transforming Dec1 to FunDef"] 
---                    let fdef1 = toFunDef d1
---                    logIN $ ["Resulting FunDef is:", skip (show fdef1)]
---                    
---                    logIN $ ["Transforming Dec2 to FunDef"]
---                    let fdef2 = toFunDef d2
---                    logIN $ ["Resulting FunDef is:", skip (show fdef2)]
---                    return d1
hunk ./src/Main.hs 203
-                   
-dotest  :: (Ppr t) => (t -> t -> LM t) -> (Q t) -> (Q t) -> IO ()
-dotest f t s = runQ $
-    do t1 <- t
-       t2 <- s
-       let (r,l) = runEL  (f t1 t2) 
-       runIO $ putStrLn "*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*"
-       runIO $ putStrLn "|                                 Logging Result                                |"
-       runIO $ putStrLn "*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*"
-       runIO $ putStrLn (view l)
-       runIO $ putStrLn "*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*"
-       runIO $ putStrLn "|                              Computational Result                             |"
-       runIO $ putStrLn "*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*"
-       runIO $ (printQ.return) r
+	
+--testunify :: (Term t, Antiunifieable k v t,Unifieable t) => t -> t -> LM t
+--testunify t s = do --setGlobalLogLevel "Test"
+--                   setCurrentLogger "Test.testunify"
+--                   logIN $ ["Term 1 is ", skip (view t),"Term 2 is ", skip (view s) ]
+--                                      
+--                   logIN $ ["Unifying Term1 and Term1"]
+--                   u1 <- mgu t s
+--                   logIN $ ["Resulting unifier is " ++ (view u1)]      
+--                   return t
+--                   
+--testantiunify :: (Term t, Antiunifieable k v t,Unifieable t) => t -> t -> LM t
+--testantiunify t s = do logIN $ ["Term 1 is ", skip (view t),"Term 2 is ", skip (view s) ]
+--                   
+--                       logIN $ ["Antiunifying Term1 and Term2"]
+--                       ai <- antiunify [t,s]
+--                       logIN $ ["Resulting antiinstance is " ++ (view ai)]    
+--                       return t                                   
+--testcase1 :: (Term t, Antiunifieable k v t,Unifieable t) => t -> t -> LM t
+--testcase1 t s = do --setGlobalLogLevel "Test"
+--                   setCurrentLogger "Test.testcase1" 
+--                   logIN $ ["Term 1 is ", skip (view t),"Term 2 is ", skip (view s) ]
+--                   
+--                   logIN $ ["Antiunifying Term1 and Term2"]
+--                   ai <- antiunify [t,s]
+--                   logIN $ ["Resulting antiinstance is " ++ (view ai)]                   
+--                   
+--                   logIN $ ["Unifying Term1 and antiinstance"]
+--                   u1 <- mgu t ai
+--                   logIN $ ["Resulting unifier is " ++ (view u1)]      
+--                   
+--                   logIN $ ["Unifying Term1 and Term2"]
+--                   u2 <- mgu t s
+--                   logIN $ ["Resulting unifier is " ++ (view u2)]
+--                   
+--                   logIN ["Applying unifier to Term1: " ++ (view t)]
+--                   au1 <- applyMgu u2 t
+--                   logIN $ ["Result is " ++ (view au1)]    
+--                   
+--                   logIN ["Applying unifier to Term2: " ++ (view s)]
+--                   au2 <- applyMgu u2 s
+--                   logIN $ ["Result is " ++ (view au2)]            
+--                   return au2
+--                   
+--testcase2 :: (Term t, Antiunifieable k v t,Unifieable t) => t -> t -> LM t
+--testcase2 t s = do --setGlobalLogLevel "Test"
+--                   setCurrentLogger "Test.testcase2" 
+--                   logIN $ ["Term 1 is ", skip (view t),"Term 2 is ", skip (view s) ]
+--                   
+--                   logIN $ ["Antiunifying Term1 and Term2"]
+--                   ai <- antiunify [t,s]
+--                   logIN $ ["Resulting antiinstance is " ++ (view ai)]                   
+--                   
+--                   logIN $ ["Unifying Term1 and antiinstance"]
+--                   u1 <- mgu t ai
+--                   logIN $ ["Resulting unifier is " ++ (view u1)]
+--                   
+--                   logIN $ ["Matching Term1 and antiinstance"]
+--                   m <- matches t ai
+--                   logIN $ ["Result is " ++ (show m)]
+--                   return t
+--                   
+--testcase3 :: (Term t, Antiunifieable k v t,Unifieable t) => t -> t -> LM t
+--testcase3 t s = do --setGlobalLogLevel "Test"
+--                   setCurrentLogger "Test.testcase3" 
+--                   logIN $ ["Term 1 is ", skip (view t),"Term 2 is ", skip (view s) ]
+--                   
+--                   logIN $ ["Antiunifying Term1 and Term2"]
+--                   ai <- antiunify [t,s]
+--                   logIN $ ["Resulting antiinstance is ",(view ai)]  
+--                   
+--                   logIN $ ["Positions of Variable in Anitinstance"]
+--                   let varpos = getVarPos ai
+--                   logIN $ ["Variables at positions:",(show varpos)]
+--                   
+--                   return t
+--                   
+----testinit :: Dec -> Dec -> LM Dec
+----testinit d1 d2 = do logIN $ ["Dec1 is ", skip (view d1),"Dec2 is ", skip (view d2) ]
+----
+----                    logIN $ ["Transforming Dec1 to FunDef"] 
+----                    let fdef1 = toFunDef d1
+----                    logIN $ ["Resulting FunDef is:", skip (show fdef1)]
+----                    
+----                    logIN $ ["Transforming Dec2 to FunDef"]
+----                    let fdef2 = toFunDef d2
+----                    logIN $ ["Resulting FunDef is:", skip (show fdef2)]
+----                    return d1
+--
+--                   
+--dotest  :: (Ppr t) => (t -> t -> LM t) -> (Q t) -> (Q t) -> IO ()
+--dotest f t s = runQ $
+--    do t1 <- t
+--       t2 <- s
+--       let (r,l) = runEL  (f t1 t2) 
+--       runIO $ putStrLn "*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*"
+--       runIO $ putStrLn "|                                 Logging Result                                |"
+--       runIO $ putStrLn "*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*"
+--       runIO $ putStrLn (view l)
+--       runIO $ putStrLn "*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*"
+--       runIO $ putStrLn "|                              Computational Result                             |"
+--       runIO $ putStrLn "*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*"
+--       runIO $ (printQ.return) r
hunk ./src/Main.hs 311
-igortest = startSynthesis revdef initdef
+igortest = startSynthesis balloonsDef [d||]
hunk ./src/SynthesisEngine.hs 7
+import RuleDevelopment
hunk ./src/SynthesisEngine.hs 10
-import qualified Data.Set as S (null, findMin)
+import qualified Data.Set as S --(null, findMin)
hunk ./src/SynthesisEngine.hs 16
+import Debug.Trace
hunk ./src/SynthesisEngine.hs 18
+import Data.Time.Clock
+import Data.Time.Calendar
+import System.CPUTime
+import System.Mem
hunk ./src/SynthesisEngine.hs 46
-synthesise :: [Dec] -> [Dec] -> LM [Dec] 
+synthesise :: [Dec] -> [Dec] -> LM [[Dec]]
hunk ./src/SynthesisEngine.hs 48
+    setPriority NOTICE
hunk ./src/SynthesisEngine.hs 55
-    return $ rules2decs result
+    return $ hypos2decs result
hunk ./src/SynthesisEngine.hs 58
-synthesiseTargets :: [Name] -> IM [(Name,Rules)]
+synthesiseTargets :: [Name] -> IM [[(Name,Rules)]]
hunk ./src/SynthesisEngine.hs 69
-      else do advanceRule (chooseOneRule openrules) >> currentBestHypos >>= closeHypos
+      else do applyAdvacements (chooseOneRule openrules)  >> currentBestHypos >>= closeHypos
hunk ./src/SynthesisEngine.hs 71
-    chooseOneRule = S.findMin.fragsToSet
-    collect = (\h rs -> unionFs (open h) rs)
+    chooseOneRule = S.findMin
+    collect = (\h rs -> S.union (open h) rs)
hunk ./src/SynthesisEngine.hs 86
--- No real partition, but an implementaion of overfitting :-), simply always
--- splitting the first rule from the rest.
-trivialPartition :: RuleFrag -> IM (RuleFrag,RuleFrags)
-trivialPartition rf = do
-    iod <- gets iodata
-    let cov = covr rf   -- get the indices of rules covered by this fragment
-    let n   = name rf   
-    let (part1,part2) =  ([head cov],(tail cov))
-    let first = coverRules iod n part1
-    let rest  = coverRules iod n part2
-    return (rf,ruleFrags [first,rest])
hunk ./src/SynthesisEngine.hs 87
--- creates new partitions (i.e. RuleFragements) from one RuleFragement
--- the resulting rules may be closed by antiunification
--- and it should be assured, that each RuleFrag has only one open position
--- --> closing pairwise with functionCall and subfunction
-partition :: RuleFrag -> IM [(RuleFrag,[RuleFrag])]
-partition r = return []     --FIXME
+date :: IO (Integer,Int,Int,Integer) -- :: (year,month,day,CPUTime)
+date = do
+       (y,m,d) <- getCurrentTime >>= return . toGregorian . utctDay
+       s       <- getCPUTime
+       return (y,m,d,s)
+
+showDate = date >>= \(y,m,d,s) ->
+             return $ (shows y) . (shows m). (shows d) $ show s
+            
+printLogFile :: String -> IO ()
+printLogFile s = showDate >>= \d -> 
+                              writeFile ("log/" ++ d ++ ".log") s 
hunk ./src/SynthesisEngine.hs 100
--- introduces a function call
-functionCall :: 
-    RuleFrag ->             -- ^the rule to partition 
-                            --  FIXME: need covered target rules here) 
-    IM (RuleFrag,[RuleFrag]) -- ^the modified rule(now closed), and the 
-                            -- synthesised subfunctions
-functionCall r = return (r,[])          -- FIXME
--- TODO:
--- * uses abduce :: Rules -> Rules -> IM FunFragment
--- * find a Funfragment 'frag' in background knowledge which contains a rule f
---   for each rule in the rules covered by r (covering(r)) which matches its rhs
--- * create a new rule from 'r' by replacing its rhs by a function call to 'frag'
--- * for each argument of 'frag' abduce the I/O pairs for a subfunction which
---   returns the argument value from the input of r
--- * call Igor recursively to synthesise the subfunction. 
-   
-subfunction :: 
-    RuleFrag ->                 -- ^the rule to partition 
-                            --  FIXME: need covered target rules here) 
-    IM (RuleFrag,[RuleFrag]) -- ^the modified rule (now closed), and the 
-                            -- synthesised subfunctions
-subfunction r = return (r,[])          -- FIXME
--- TODO:
--- * uses abduce :: Rules -> Rules -> IM FunFragment
--- * replace every open variable by a call to a subfunction 
--- * abduce I/O pairs for every subfunction
--- * the abduced I/O pairs of each subfunction are added to the background 
---   knowledge (check if it is feasible to modify the IM at this point or 
---   better at top-level 
--- * synthesize every subfunction recursively. 
---   !!! 
---       If inserting the synthesized function into a hypothese,
---       a hypothese should never be strict  
---   !!!
- 
hunk ./src/Terms/Class.hs 58
-p ° i | i > 0      = p `Dot` i
+p ° i | i >= 0      = p `Dot` i
hunk ./src/Terms/Class.hs 60
-                              "with index =< 0 !"
+                              "with index < 0 !"
hunk ./src/Terms/Class.hs 150
+    -- | Returns 'True' if both terms have the same constructor symbol at 
+    --   'Position' @p@ or both have a variable. 'false' otherwise.
+    sameAtPos :: t -> t -> Position -> Bool
+        
hunk ./src/Terms/Class.hs 200
-                      (InfixE (Just e1) _e Nothing)   -> map (°1) (getPos e1 s)
-                      (InfixE Nothing _e (Just e2))   -> map (°2) (getPos e2 s)
+                      (InfixE (Just e1) _e Nothing)   -> map (°0) (getPos e1 s)
+                      (InfixE Nothing _e (Just e2))   -> map (°1) (getPos e2 s)
hunk ./src/Terms/Class.hs 203
-                            let pos1 = map (°1) (getPos e1 s)
-                                pos2 = map (°2) (getPos e2 s)
+                            let pos1 = map (°0) (getPos e1 s)
+                                pos2 = map (°1) (getPos e2 s)
hunk ./src/Terms/Class.hs 206
+                      (ListE [])                      -> [Root ° 0]
hunk ./src/Terms/Class.hs 220
-                      --RecUpdE Exp [FieldExp]  
+                      --RecUpdE Exp [FieldExp]
+                        
+    sameAtPos t1 t2 p = 
+        case (subtermAt t1 p, subtermAt t2 p) of
+        (Just st1, Just st2) -> compareAtRootE st1 st2
+        _otherwise           -> False
hunk ./src/Terms/Class.hs 238
-    subterms (ListE l)                       = l
+    subterms (ListE [])                      = []
+    subterms (ListE (l:ls))                  = [l, ListE ls] 
hunk ./src/Terms/Class.hs 274
-                            let pos1 = map (°1) (getPos p1 s)
-                                pos2 = map (°2) (getPos p2 s)
+                            let pos1 = map (°0) (getPos p1 s)
+                                pos2 = map (°1) (getPos p2 s)
hunk ./src/Terms/Class.hs 277
+                      (ListP [])                      -> [Root ° 0]
hunk ./src/Terms/Class.hs 289
-    
+                        
+    sameAtPos t1 t2 p = 
+        case (subtermAt t1 p, subtermAt t2 p) of
+        (Just st1, Just st2) -> compareAtRootP st1 st2
+        _otherwise           -> False
+        
hunk ./src/Terms/Class.hs 299
+    subterms (ListP [])       = []
hunk ./src/Terms/Class.hs 326
-mapGetPos ts s = concat $ snd $ L.mapAccumL (\i t -> (i+1, map (°i) (getPos t s))) 1 ts
+mapGetPos ts s = concat $ snd $ L.mapAccumL (\i t -> (i+1, map (°i) (getPos t s))) 0 ts
hunk ./src/Terms/Class.hs 393
+compareAtRootE :: Exp -> Exp -> Bool
+compareAtRootE (VarE _) (VarE _)                        = True
+compareAtRootE (ConE n1) (ConE n2)                      = n1 == n2
+compareAtRootE (LitE l1) (LitE l2)                      = l1 == l2
+compareAtRootE (TupE v1s)(TupE v2s)                     = (length v1s) == (length v2s)
+compareAtRootE t1@(AppE _ _ ) t2@(AppE _ _ )            = compareAtRootE (head (unfoldAppE t1))(head (unfoldAppE t2))
+compareAtRootE (ListE []) (ListE [])                    = True
+compareAtRootE (ListE []) (ListE _)                     = False
+compareAtRootE (ListE _)  (ListE [])                    = False
+compareAtRootE (ListE _)  (ListE _)                     = True
+compareAtRootE (CondE _ _ _) (CondE _ _ _)              = True    
+compareAtRootE (InfixE _ e1 _) (InfixE _ e2 _)          = compareAtRootE e1 e2
+compareAtRootE  _ _                                     = False
+
hunk ./src/Terms/Class.hs 430
+    
+compareAtRootP :: Pat -> Pat -> Bool
+compareAtRootP (VarP _)(VarP _)               = True
+compareAtRootP (LitP l1)(LitP l2)             = l1 == l2 
+compareAtRootP (ConP n1 _)(ConP n2 _ )        = n1 == n2
+compareAtRootP (InfixP _ p1 _)(InfixP _ p2 _) = p1 == p2 
+compareAtRootP (ListP []) (ListP [])                    = True
+compareAtRootP (ListP []) (ListP _)                     = False
+compareAtRootP (ListP _)  (ListP [])                    = False
+compareAtRootP (ListP _)  (ListP _)                     = True
+compareAtRootP (TupP p1s)(TupP p2s)           = (length p1s) == (length p2s)
+compareAtRootP  _ _                           = False