[Pkg-haskell-commits] darcs: helium: Drop 12_no_rec, seemingly not needed any more
Joachim Breitner
mail at joachim-breitner.de
Thu Jun 2 17:25:53 UTC 2011
Thu Jun 2 17:15:50 UTC 2011 Joachim Breitner <mail at joachim-breitner.de>
* Drop 12_no_rec, seemingly not needed any more
Ignore-this: 686053c9769967aaa715ad99a3b19887
R ./patches/12_no_rec
M ./patches/series -1
Thu Jun 2 17:15:50 UTC 2011 Joachim Breitner <mail at joachim-breitner.de>
* Drop 12_no_rec, seemingly not needed any more
Ignore-this: 686053c9769967aaa715ad99a3b19887
diff -rN -u old-helium//patches/12_no_rec new-helium//patches/12_no_rec
--- old-helium//patches/12_no_rec 2011-06-02 17:25:53.648277426 +0000
+++ new-helium//patches/12_no_rec 1970-01-01 00:00:00.000000000 +0000
@@ -1,1126 +0,0 @@
-# Description: Remove rec from code
-# rec is a reserved word in GHC 6.12.1, so it should not be used as a
-# identifier.
-# Forwarded: http://lists.debian.org/debian-haskell/2010/03/msg00114.html
-# Author: Marco Túlio Gontijo e Silva <marcot at debian.org>
-# Last-Update: 2010-03-14
-Index: helium-1.6/Top/src/Top/Implementation/TypeGraph/ApplyHeuristics.hs
-===================================================================
---- helium-1.6.orig/Top/src/Top/Implementation/TypeGraph/ApplyHeuristics.hs 2006-02-05 14:35:54.000000000 -0200
-+++ helium-1.6/Top/src/Top/Implementation/TypeGraph/ApplyHeuristics.hs 2010-03-15 10:27:33.000000000 -0300
-@@ -29,41 +29,41 @@
-
- applyHeuristics :: HasTypeGraph m info => (Path (EdgeId, info) -> [Heuristic info]) -> m [ErrorInfo info]
- applyHeuristics heuristics =
-- let rec thePath =
-+ let rec_ thePath =
- case simplifyPath thePath of
- Empty -> internalError "Top.TypeGraph.ApplyHeuristics" "applyHeuristics" "unexpected empty path"
- Fail -> return []
- path ->
- do err <- evalHeuristics path (heuristics path)
- let restPath = changeStep (\t@(a,_) -> if a `elem` fst err then Fail else Step t) path
-- errs <- rec restPath
-+ errs <- rec_ restPath
- return (err : errs)
- in
- do errorPath <- allErrorPaths
-- rec (removeSomeDuplicates info2ToEdgeNr errorPath)
-+ rec_ (removeSomeDuplicates info2ToEdgeNr errorPath)
-
- evalHeuristics :: HasTypeGraph m info => Path (EdgeId, info) -> [Heuristic info] -> m (ErrorInfo info)
- evalHeuristics path heuristics =
-- rec edgesBegin heuristics
-+ rec_ edgesBegin heuristics
-
- where
- edgesBegin = nubBy eqInfo2 (steps path)
-
-- rec edges [] =
-+ rec_ edges [] =
- case edges of
- (edgeId@(EdgeId _ _ cnr), info) : _ ->
- do logMsg ("\n*** The selected constraint: " ++ show cnr ++ " ***\n")
- return ([edgeId], info)
- _ -> internalError "Top.TypeGraph.ApplyHeuristics" "evalHeuristics" "empty list"
-
-- rec edges (Heuristic heuristic:rest) =
-+ rec_ edges (Heuristic heuristic:rest) =
- case heuristic of
-
- Filter name f ->
- do edges' <- f edges
- logMsg (name ++ " (filter)")
- logMsg (" " ++ showSet [ i | (EdgeId _ _ i, _) <- edges' ])
-- rec edges' rest
-+ rec_ edges' rest
-
- Voting selectors ->
- do logMsg ("Voting with "++show (length selectors) ++ " heuristics")
-@@ -76,9 +76,9 @@
- GT -> (prio, [(head es, info)])
- case listWithBest of
- [] -> do logMsg "Unfortunately, none of the heuristics could be applied"
-- rec edges rest
-+ rec_ edges rest
- _ -> do logMsg ("\n*** Selected with priority "++show thePrio++": "++showSet (map fst listWithBest)++"\n")
-- rec listWithBest rest
-+ rec_ listWithBest rest
-
- evalSelector :: (MonadWriter LogEntries m, HasTypeGraph m info) => [(EdgeId, info)] -> Selector m info -> m [(Int, [EdgeId], info)]
- evalSelector edges selector =
-@@ -184,14 +184,14 @@
- type ChildGraph = [((VertexId, VertexId), [(VertexId, VertexId)])]
-
- childrenGraph :: HasTypeGraph m info => [VertexId] -> m ChildGraph
--childrenGraph = rec []
-+childrenGraph = rec_ []
- where
-- rec as [] = return as
-- rec as (i:is) =
-+ rec_ as [] = return as
-+ rec_ as (i:is) =
- do vertices <- verticesInGroupOf i
- ri <- representativeInGroupOf i
- if ri `elem` (map (fst . fst) as)
-- then rec as is
-+ then rec_ as is
- else do let cs = concat [ [(n, l), (n, r)] | (n, (VApp l r, _)) <- vertices ]
- cs' <- let f t = do r <- representativeInGroupOf (snd t)
- return (r, t)
-@@ -200,7 +200,7 @@
- . groupBy (\x y -> fst x == fst y)
- . sortBy (\x y -> fst x `compare` fst y)
- $ cs'
-- rec ([ ((ri, rc), xs) | (rc, xs) <- children ] ++ as) (map fst children ++ is)
-+ rec_ ([ ((ri, rc), xs) | (rc, xs) <- children ] ++ as) (map fst children ++ is)
-
- infiniteGroups :: [(VertexId, VertexId)] -> [[VertexId]]
- infiniteGroups xs =
-@@ -219,10 +219,10 @@
- in recursive
-
- allSubPathsList :: HasTypeGraph m info => [(VertexId, VertexId)] -> VertexId -> [VertexId] -> m (TypeGraphPath info)
--allSubPathsList childList vertex targets = rec S.empty vertex
-+allSubPathsList childList vertex targets = rec_ S.empty vertex
- where
-- rec :: HasTypeGraph m info => S.Set VertexId -> VertexId -> m (TypeGraphPath info)
-- rec without start =
-+ rec_ :: HasTypeGraph m info => S.Set VertexId -> VertexId -> m (TypeGraphPath info)
-+ rec_ without start =
- do vs <- verticesInGroupOf start
- case any (`elem` map fst vs) targets of
-
-@@ -234,7 +234,7 @@
- let recDown (newStart, childTargets) =
- do let newWithout = without `S.union` S.fromList (map fst vs){- don't return to this equivalence group -}
- f ct = let set = S.fromList [ t | t <- childTargets, t /= ct ]
-- in rec (set `S.union` newWithout) ct
-+ in rec_ (set `S.union` newWithout) ct
- path <- allPathsListWithout without start [newStart]
- newPaths <- mapM f childTargets
- return (path :+: altList newPaths)
-Index: helium-1.6/Top/src/Top/Implementation/TypeGraph/Basics.hs
-===================================================================
---- helium-1.6.orig/Top/src/Top/Implementation/TypeGraph/Basics.hs 2006-02-05 14:35:54.000000000 -0200
-+++ helium-1.6/Top/src/Top/Implementation/TypeGraph/Basics.hs 2010-03-15 10:27:33.000000000 -0300
-@@ -92,24 +92,24 @@
- compare (CliqueX xs) (CliqueX ys) = compare xs ys
-
- isSubsetClique :: Clique -> Clique -> Bool
--isSubsetClique (CliqueX as) (CliqueX bs) = rec as bs
-+isSubsetClique (CliqueX as) (CliqueX bs) = rec_ as bs
- where
-- rec [] _ = True
-- rec _ [] = False
-- rec a@(x:xs) (y:ys)
-- | x == y = rec xs ys
-- | x > y = rec a ys
-+ rec_ [] _ = True
-+ rec_ _ [] = False
-+ rec_ a@(x:xs) (y:ys)
-+ | x == y = rec_ xs ys
-+ | x > y = rec_ a ys
- | otherwise = False
-
- isDisjointClique :: Clique -> Clique -> Bool
--isDisjointClique (CliqueX as) (CliqueX bs) = rec as bs
-+isDisjointClique (CliqueX as) (CliqueX bs) = rec_ as bs
- where
-- rec [] _ = True
-- rec _ [] = True
-- rec a@(x:xs) b@(y:ys)
-+ rec_ [] _ = True
-+ rec_ _ [] = True
-+ rec_ a@(x:xs) b@(y:ys)
- | x == y = False
-- | x > y = rec a ys
-- | otherwise = rec xs b
-+ | x > y = rec_ a ys
-+ | otherwise = rec_ xs b
-
- cliqueRepresentative :: Clique -> VertexId
- cliqueRepresentative (CliqueX xs) =
-Index: helium-1.6/Top/src/Top/Implementation/TypeGraph/EquivalenceGroup.hs
-===================================================================
---- helium-1.6.orig/Top/src/Top/Implementation/TypeGraph/EquivalenceGroup.hs 2006-02-05 14:35:54.000000000 -0200
-+++ helium-1.6/Top/src/Top/Implementation/TypeGraph/EquivalenceGroup.hs 2010-03-15 10:27:33.000000000 -0300
-@@ -129,7 +129,7 @@
- equalPaths without start targets eqgroup =
- reduceNumberOfPaths $
- tailSharingBy (\(e1, _) (e2, _) -> e1 `compare` e2) $
-- rec start (edgeList, cliqueList)
-+ rec_ start (edgeList, cliqueList)
- where
- -- msg = "Path from "++show start++" to "++show targets++" without "++show (S.elems without)
- edgeList = let p (EdgeId v1 v2 _, _) =
-@@ -142,8 +142,8 @@
- -- Allow a second visit of a clique in a path?
- secondCliqueVisit = False
-
-- rec :: VertexId -> ([(EdgeId, info)], [[ParentChild]]) -> TypeGraphPath info
-- rec v1 (es, cs)
-+ rec_ :: VertexId -> ([(EdgeId, info)], [[ParentChild]]) -> TypeGraphPath info
-+ rec_ v1 (es, cs)
- | v1 `S.member` targetSet = Empty
- | otherwise =
- let (edges1,es' ) = partition (\(EdgeId a _ _, _) -> v1 == a) es
-@@ -157,10 +157,10 @@
- altList $
- map (\(EdgeId _ neighbour edgeNr, info) ->
- Step (EdgeId v1 neighbour edgeNr, Initial info)
-- :+: rec neighbour rest) edges1
-+ :+: rec_ neighbour rest) edges1
- ++ map (\(EdgeId neighbour _ edgeNr, info) ->
- Step (EdgeId v1 neighbour edgeNr, Initial info)
-- :+: rec neighbour rest) edges2
-+ :+: rec_ neighbour rest) edges2
- ++ concatMap (\list ->
- let (sources, others) = partition ((v1==) . child) list
- sourceParents = map parent sources
-@@ -171,8 +171,8 @@
- , child pc == neighbour
- , let beginPath = altList1 (map g sourceParents)
- restPath
-- | secondCliqueVisit = rec neighbour (es'', map (filter (/= pc)) restCliques)
-- | otherwise = rec neighbour rest
-+ | secondCliqueVisit = rec_ neighbour (es'', map (filter (/= pc)) restCliques)
-+ | otherwise = rec_ neighbour rest
- g sp = Step ( EdgeId v1 neighbour impliedEdgeNr
- , Implied (childSide pc) sp (parent pc)
- )
-Index: helium-1.6/Top/src/Top/Implementation/TypeGraph/Path.hs
-===================================================================
---- helium-1.6.orig/Top/src/Top/Implementation/TypeGraph/Path.hs 2006-02-05 14:35:54.000000000 -0200
-+++ helium-1.6/Top/src/Top/Implementation/TypeGraph/Path.hs 2010-03-15 10:27:33.000000000 -0300
-@@ -60,11 +60,11 @@
- (<++>) = mCombine (++)
-
- steps :: Path a -> [a]
--steps = ($ []) . rec where
-- rec path =
-+steps = ($ []) . rec_ where
-+ rec_ path =
- case path of
-- x :|: y -> rec x . rec y
-- x :+: y -> rec x . rec y
-+ x :|: y -> rec_ x . rec_ y
-+ x :+: y -> rec_ x . rec_ y
- Step a -> (a:)
- Fail -> id
- Empty -> id
-@@ -73,13 +73,13 @@
- mapPath f = changeStep (Step . f)
-
- changeStep :: (a -> Path b) -> Path a -> Path b
--changeStep f = rec
-+changeStep f = rec_
- where
-- rec path =
-+ rec_ path =
- case path of
- Step a -> f a
-- x :|: y -> rec x :|: rec y
-- x :+: y -> rec x :+: rec y
-+ x :|: y -> rec_ x :|: rec_ y
-+ x :+: y -> rec_ x :+: rec_ y
- Fail -> Fail
- Empty -> Empty
-
-@@ -93,12 +93,12 @@
- Empty -> return Empty
-
- minCompleteInPath :: (a -> a -> Ordering) -> Path a -> Maybe a
--minCompleteInPath f = rec . simplifyPath
-+minCompleteInPath f = rec_ . simplifyPath
- where
-- rec path =
-+ rec_ path =
- case path of
-- x :|: y -> do v1 <- rec x; v2 <- rec y; return (minimumBy f [v1, v2])
-- x :+: y -> do v1 <- rec x; v2 <- rec y; return (maximumBy f [v1, v2])
-+ x :|: y -> do v1 <- rec_ x; v2 <- rec_ y; return (minimumBy f [v1, v2])
-+ x :+: y -> do v1 <- rec_ x; v2 <- rec_ y; return (maximumBy f [v1, v2])
- Step a -> Just a
- Fail -> Nothing
- Empty -> Nothing
-@@ -127,7 +127,7 @@
- case simplifyPath thePath of
- Empty -> Empty
- Fail -> Fail
-- p -> rec p
-+ p -> rec_ p
-
- where
- eqf x y = compf x y == EQ
-@@ -136,10 +136,10 @@
- compfM (Just x) (Just y) = compf x y
- compfM m1 _ = if isJust m1 then GT else LT
-
-- -- invariant: rec does not have Empty's or Fail's
-- rec (Step a) = Step a
-- rec (p1 :+: p2) = p1 :+: rec p2
-- rec path =
-+ -- invariant: rec_ does not have Empty's or Fail's
-+ rec_ (Step a) = Step a
-+ rec_ (p1 :+: p2) = p1 :+: rec_ p2
-+ rec_ path =
- let sharedTail = map (\((p, tl):rest) -> combine (p:map fst rest) tl)
- . groupBy (\x y -> snd x `eqfM` snd y)
- . sortBy (\x y -> snd x `compfM` snd y)
-@@ -184,18 +184,18 @@
-
- -- returns a list with 'smallest minimal sets'
- minimalSets :: (a -> a -> Bool) -> Path a -> [[a]]
--minimalSets eqF = rec where
-+minimalSets eqF = rec_ where
-
-- -- invariant: rec returns lists with the same length
-- rec path =
-+ -- invariant: rec_ returns lists with the same length
-+ rec_ path =
- case simplifyPath path of
- Empty -> []
- Fail -> [[]]
- p ->
- let a = head (steps p)
-- sol1 = rec (changeStep (\b -> if a `eqF` b then Empty else Step b) p)
-+ sol1 = rec_ (changeStep (\b -> if a `eqF` b then Empty else Step b) p)
- sol2 = [ a : set
-- | set <- rec (changeStep (\b -> if a `eqF` b then Fail else Step b) p)
-+ | set <- rec_ (changeStep (\b -> if a `eqF` b then Fail else Step b) p)
- ]
- in case (sol1, sol2) of
- (x:_, y:_) ->
-@@ -206,8 +206,8 @@
- _ -> sol1 ++ sol2
-
- removeSomeDuplicates :: Ord b => (a -> b) -> Path a -> Path a
--removeSomeDuplicates toOrd = simplifyPath . rec M.empty where
-- rec fm path =
-+removeSomeDuplicates toOrd = simplifyPath . rec_ M.empty where
-+ rec_ fm path =
- case path of
-
- left :+: right ->
-@@ -215,20 +215,20 @@
- Step a -> let int = toOrd a
- fm' = M.insert int Empty fm
- in case M.lookup int fm of
-- Just left' -> left' :+: rec fm right
-- Nothing -> left :+: rec fm' right
-- p1 :+: p2 -> rec fm (p1 :+: (p2 :+: right))
-- _ -> rec fm left :+: rec fm right
-+ Just left' -> left' :+: rec_ fm right
-+ Nothing -> left :+: rec_ fm' right
-+ p1 :+: p2 -> rec_ fm (p1 :+: (p2 :+: right))
-+ _ -> rec_ fm left :+: rec_ fm right
-
- left :|: right ->
- case left of
- Step a -> let int = toOrd a
- fm' = M.insert int Fail fm
- in case M.lookup int fm of
-- Just left' -> left' :|: rec fm right
-- Nothing -> left :|: rec fm' right
-- p1 :|: p2 -> rec fm (p1 :|: (p2 :|: right))
-- _ -> rec fm left :|: rec fm right
-+ Just left' -> left' :|: rec_ fm right
-+ Nothing -> left :|: rec_ fm' right
-+ p1 :|: p2 -> rec_ fm (p1 :|: (p2 :|: right))
-+ _ -> rec_ fm left :|: rec_ fm right
-
- Step a ->
- M.findWithDefault path (toOrd a) fm
-@@ -266,24 +266,24 @@
- reduceNumberOfPaths = maybe id limitNumberOfPaths maxNumberOfEqualPaths
-
- limitNumberOfPaths :: Int -> Path a -> Path a
--limitNumberOfPaths size = fst . rec size
-+limitNumberOfPaths size = fst . rec_ size
- where
- fromInt :: Num a => Int -> a
- fromInt = fromInteger . toInteger
-
-- rec sz path =
-+ rec_ sz path =
- case path of
- Empty -> (path, 1)
- Fail -> (path, 0)
- Step _ -> (path, 1)
-- p1 :+: p2 -> let (p1', n1) = rec sz p1
-+ p1 :+: p2 -> let (p1', n1) = rec_ sz p1
- newSize
- | n1 == 0 = sz
- | otherwise = ceiling ((fromInt sz / fromInt n1) :: Double)
-- (p2', n2) = rec newSize p2
-+ (p2', n2) = rec_ newSize p2
- in (p1' :+: p2', n1*n2)
-- p1 :|: p2 -> let both@(p1' , n1) = rec sz p1
-- (p2', n2) = rec (sz - n1) p2
-+ p1 :|: p2 -> let both@(p1' , n1) = rec_ sz p1
-+ (p2', n2) = rec_ (sz - n1) p2
- in if n1 >= sz
- then both
- else (p1' :|: p2', n1 + n2)
-\ No newline at end of file
-Index: helium-1.6/Top/src/Top/Implementation/TypeGraph/Standard.hs
-===================================================================
---- helium-1.6.orig/Top/src/Top/Implementation/TypeGraph/Standard.hs 2006-02-05 14:35:54.000000000 -0200
-+++ helium-1.6/Top/src/Top/Implementation/TypeGraph/Standard.hs 2010-03-15 10:27:33.000000000 -0300
-@@ -42,9 +42,9 @@
-
- instance TypeGraph (StandardTypeGraph info) info where
-
-- addTermGraph synonyms = rec
-+ addTermGraph synonyms = rec_
- where
-- rec unique tp stg =
-+ rec_ unique tp stg =
- let (newtp, original) =
- case expandToplevelTC synonyms tp of
- Nothing -> (tp, Nothing)
-@@ -57,8 +57,8 @@
- let vid = VertexId unique
- in (unique+1, vid, addVertex vid (VCon s, original) stg)
- TApp t1 t2 ->
-- let (u1, v1, g1) = rec unique t1 stg
-- (u2, v2, g2) = rec u1 t2 g1
-+ let (u1, v1, g1) = rec_ unique t1 stg
-+ (u2, v2, g2) = rec_ u1 t2 g1
- vid = VertexId u2
- in (u2+1, vid, addVertex vid (VApp v1 v2, original) g2)
-
-@@ -79,7 +79,7 @@
- vertices . getGroupOf i
-
- substituteTypeSafe synonyms =
-- let rec history (TVar i) stg
-+ let rec_ history (TVar i) stg
- | i `elem` history = Nothing
- | otherwise =
- case maybeGetGroupOf (VertexId i) stg of
-@@ -89,15 +89,15 @@
- do newtp <- typeOfGroup synonyms (getGroupOf (VertexId i) stg)
- case newtp of
- TVar j -> Just (TVar j)
-- _ -> rec (i:history) newtp stg
-+ _ -> rec_ (i:history) newtp stg
-
-- rec _ tp@(TCon _) _ = Just tp
-+ rec_ _ tp@(TCon _) _ = Just tp
-
-- rec history (TApp l r) stg =
-- do l' <- rec history l stg
-- r' <- rec history r stg
-+ rec_ history (TApp l r) stg =
-+ do l' <- rec_ [...incomplete...]
More information about the Pkg-haskell-commits
mailing list