[Main and Test modified
martin.hofmann@uni-bamberg.de**20081203144553] move ./src/Test.hs ./src/Main.hs
hunk ./src/Main.hs 2
-module Test where
+module Main where
hunk ./src/Main.hs 12
-
+import Data.Initialiser hiding (printQ, showQ)
hunk ./src/Main.hs 53
-list1,list2,list3,list4,list5,list6 :: Q [Exp]       
+list1,list2,list3,list4,list5,list6 :: Q [Exp]      
hunk ./src/Main.hs 211
-                         
+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
+           |]
+                               
hunk ./src/Main.hs 334
- 
-main = dotest testunify term7 term7v
+
+loop ::  Int -> Int
+loop i = if odd i then loop (i+1) else loop (i-1)
+
+main = igortest -- print test1 --  dotest testunify term7 term7v
+igortest = startSynthesis revdef initdef
hunk ./src/Test.lhs 9
-> import qualified Data.PSQueue as Q
hunk ./src/Test.lhs 10
-> import qualified Data.List as L
+> import qualified Data.Set as S
+> import Data.List (foldl')
hunk ./src/Test.lhs 13
-> ins :: (Eq a) =>[a] -> Maybe [[a]] -> Maybe [[a]]
-> ins l Nothing   = Just $ [l]
-> ins l (Just ls) = Just $ l:ls
+> type P = (Int,[String])
+> type Ps = (S.Set P)
+> data  Foo = Foo
+>     { foo :: !(M.Map Int (S.Set P))  
+>     , bar :: !(M.Map String (S.Set P))
+>     , baz :: !(M.Map  P Int)
+>     }
+>   deriving(Show)
hunk ./src/Test.lhs 22
-> del :: (Eq a) => [a] -> Maybe [[a]] -> Maybe [[a]]
-> del l Nothing   = Nothing
-> del l (Just ls) = let postDel = L.delete l ls
->                   in if length postDel > 0
->                         then Just postDel
->                         else Nothing
+ alterfoo fun  hsp@(HSpace m _ _ )  = 
+    case r of
+        Just r' ->  hsp{rateHyposMap = M.alter f r' m}
+        Nothing -> hsp
+    
+alterRuleHyposMap f hs hsp@(HSpace _ m _ )  = 
+    hsp{ruleHyposMap = F.fold (M.alter f) m hs}
+    
+alterHypoRateMap f h hsp@(HSpace _ _ m )  = 
+    hsp{hypoRateMap = f h m}
+    
+> initFoo = Foo M.empty M.empty M.empty
hunk ./src/Test.lhs 35
-> rep :: (Eq a) =>[a] -> [a] -> Maybe [[a]] -> Maybe [[a]]
-> rep l1 l2 v = ins l2 (del l1 v)
+> changefoo :: (Maybe Ps -> Maybe Ps) -> Maybe Int -> Foo -> Foo
+> changefoo fun k f@(Foo fo _ _ ) = 
+>   case k of
+>       Just k' -> f{foo = M.alter fun k' fo}
+>       Nothing -> f
hunk ./src/Test.lhs 41
-> qins :: (Ord a, Show a) => [a] -> Q.PSQ Int [[a]] -> Q.PSQ Int [[a]]
-> qins = \l ls -> Q.alter (ins l) (length l) ls
+> changebar :: (Maybe Ps -> Maybe Ps) -> [String] -> Foo -> Foo
+> changebar fun s f@(Foo _ br _ ) = 
+>   f{bar = foldl' (flip (M.alter fun)) br s}
hunk ./src/Test.lhs 45
-> mins :: (Ord a, Show a) => [a] -> M.Map Int [[a]] -> M.Map Int [[a]]
-> mins = \l ls -> M.alter (ins l) (length l) ls
+> changebaz :: (P -> M.Map P Int -> M.Map P Int) -> P -> Foo -> Foo
+> changebaz fun i f@(Foo _ _ bz ) = 
+>   f{baz = fun i bz}
hunk ./src/Test.lhs 49
-> qdel :: (Ord a, Show a) => [a] -> Q.PSQ Int [[a]] -> Q.PSQ Int [[a]]
-> qdel = \l ls -> Q.alter (del l) (length l) ls
+> insert :: P -> Foo -> Foo
+> insert p@(i,strs) fo  =
+>   changefoo (maybeInsert p) (Just i) $
+>   changebar (maybeInsert p) strs $
+>   changebaz (flip M.insert valueP) p $
+>   fo  
+>   where
+>   maybeInsert e s = 
+>       case s of 
+>         Just s' -> return $ S.insert e s'
+>         Nothing -> return $ S.singleton e  
+>   valueP =  foldl' ( flip $(+).length) 0 strs
hunk ./src/Test.lhs 62
-> mdel :: (Ord a, Show a) => [a] -> M.Map Int [[a]] -> M.Map Int [[a]]
-> mdel = \l ls -> M.alter (del l) (length l) ls
+> delete :: P -> Foo -> Foo
+> delete p@(i,strs) f@(Foo _ _ bz) = 
+>   changefoo (maybeDelete p) (M.lookup p bz) $
+>   changebar (maybeDelete p) strs$
+>   changebaz  M.delete p $
+>   f
hunk ./src/Test.lhs 69
-> qrep :: (Ord a, Show a) => [a] -> [a] -> Q.PSQ Int [[a]] -> Q.PSQ Int [[a]]
-> qrep l1 l2 =  \ls -> qins l2 $qdel l1 ls
+>   where
+>   maybeDelete _ Nothing = Nothing 
+>   maybeDelete e (Just s) = 
+>       let postDel =  S.delete e s
+>       in if S.null postDel 
+>          then Nothing
+>          else Just postDel
hunk ./src/Test.lhs 77
-> mrep :: (Ord a, Show a) => [a] -> [a] -> M.Map Int [[a]] -> M.Map Int [[a]]
-> mrep l1 l2 =  \ls -> mins l2 $mdel l1 ls
+> changeStrings :: (String,[String]) -> Foo -> Foo
+> changeStrings (old,news) fo =
+>   ins $ del fo
+>   where
+>   del = \f -> foldl' (flip delete) f $ affectedPs 
+>   ins = \f -> foldl' (flip insert) f $ modifiedPs
+>   affectedPs = case M.lookup  old (bar fo) of 
+>                  Just s  -> S.toList s
+>                  Nothing -> []
+>   modifiedPs = map change affectedPs
+>   change = (\(i,olds) -> (i, news ++ (filter (/=old) olds))) 
hunk ./src/Test.lhs 89
-> testm = mins "askfg" $ mins "a" $ mins "b" $ mins "asd" $ mins "ab" $ mins "agsdf" $ mins "as" M.empty
-> testq = qins "askfg" $ qins "a" $ qins "b" $ qins "asd" $ qins "ab" $ qins "agsdf" $ qins "as" Q.empty
-
-> testqrep = qrep "a" "bbbbbb" testq
-> testmrep = mrep "a" "bbbbbb" testm 
- 
-IMHO, it needs to be checked, whether the keys were the same _and_ whether the result of 'f' was 'Nothing'. Otherwise, it cannot be used for insert, delete and update at the same time.
-
-I took the liberty to slightly change the code, but maybe I am wrong. 
-
-
-alter :: (Show p, Show k, Ord k, Ord p) => (Maybe p -> Maybe p) -> k -> PSQ k p -> PSQ k p
-alter f k q = 
-  case tourView q of
-    Null -> 
-      case f Nothing of
-        Nothing -> empty
-        Just p  -> singleton k p
-    Single k' p -> 
-      case f (if k==k' then Just p else Nothing) of
-        -- WAS: Nothing -> empty
-        Nothing -> if k==k'     
-                      then empty                        
-                      -- binding has been deleted
-                      else singleton k' p               
-                      -- key k not found, current binding left unchanged
-        -- WAS : Just p' -> singleton k p'              
-        Just p' -> if k==k'                             
-                      then singleton k p'               
-                      -- p has been altered to p'
-                      else insert k p' $ singleton k' p 
-                      -- new binding (k :-> p') inserted, current left unchanged
-    tl `Play` tr
-      | k <= maxKey tl -> alter f k tl `unsafePlay` tr
-      | otherwise      -> tl `unsafePlay` alter f k tr
- 
-Nevertheless, thanks a lot for the implementation.
-
-Greetings, 
-
-
-Martin