2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
4 \section[Util]{Highly random utility functions}
7 #if defined(COMPILING_GHC)
8 # include "HsVersions.h"
9 # define IF_NOT_GHC(a) {--}
12 # define TAG_ _CMP_TAG
17 # define tagCmp_ _tagCmp
18 # define FAST_STRING String
19 # define ASSERT(x) {-nothing-}
20 # define IF_NOT_GHC(a) a
24 #ifndef __GLASGOW_HASKELL__
33 -- Haskell-version support
34 #ifndef __GLASGOW_HASKELL__
38 -- general list processing
39 IF_NOT_GHC(forall COMMA exists COMMA)
40 zipEqual, nOfThem, lengthExceeds, isSingleton,
41 #if defined(COMPILING_GHC)
47 #ifdef USE_SEMANTIQUE_STRANAL
48 clookup, clookrepl, elemIndex, (\\\),
52 hasNoDups, equivClasses, runs, removeDups,
55 IF_NOT_GHC(quicksort COMMA stableSortLt COMMA mergesort COMMA)
57 IF_NOT_GHC(mergeSort COMMA) naturalMergeSortLe, -- from Carsten
58 IF_NOT_GHC(naturalMergeSort COMMA mergeSortLe COMMA)
60 -- transitive closures
64 mapAccumL, mapAccumR, mapAccumB,
67 IF_NOT_GHC(cmpString COMMA)
68 #ifdef USE_FAST_STRINGS
74 IF_NOT_GHC(cfst COMMA applyToPair COMMA applyToFst COMMA)
75 IF_NOT_GHC(applyToSnd COMMA foldPair COMMA)
79 #if defined(COMPILING_GHC)
80 , panic, pprPanic, pprTrace
84 #endif {- COMPILING_GHC -}
86 -- and to make the interface self-sufficient...
88 # if defined(COMPILING_GHC)
89 , Maybe(..){-.. for pragmas...-}, PrettyRep, Pretty(..)
95 #ifdef USE_ATTACK_PRAGMAS
96 -- as more-or-less of a *HACK*, Util exports
97 -- many types abstractly, so that pragmas will be
98 -- able to see them (given that most modules
127 CoreCaseAlternatives,
186 NamedThing(..), -- SIGH
187 OptIdInfo(..), -- SIGH
189 Outputable(..), -- SIGH
212 SpecialisedInstanceSig,
242 UnfoldingCoreBinding,
243 UnfoldingCoreDefault,
256 #if ! OMIT_NATIVE_CODEGEN
264 getIdUniType, typeOfBasicLit, typeOfPat,
265 getIdKind, kindOfBasicLit,
270 cmpProtoName, eqProtoName,
271 cmpByLocalName, eqByLocalName,
277 ppNil, ppStr, ppInt, ppInteger, ppDouble,
278 #if __GLASGOW_HASKELL__ >= 23
281 cNil, cStr, cAppend, cCh, cShow,
282 #if __GLASGOW_HASKELL__ >= 23
286 -- mkBlackHoleCLabel,
295 pprCoreBinding, pprCoreExpr, pprTyCon, pprUniType,
300 #endif {-USE_ATTACK_PRAGMAS-}
303 #if defined(COMPILING_GHC)
308 import Maybes ( Maybe(..) )
311 #if defined(COMPILING_GHC)
316 # ifdef USE_ATTACK_PRAGMAS
353 # if ! OMIT_NATIVE_CODEGEN
354 import AsmRegAlloc ( Reg )
359 # endif {-USE_ATTACK_PRAGMAS-}
364 %************************************************************************
366 \subsection[Utils-version-support]{Functions to help pre-1.2 versions of (non-Glasgow) Haskell}
368 %************************************************************************
370 This is our own idea:
372 #ifndef __GLASGOW_HASKELL__
373 data TAG_ = LT_ | EQ_ | GT_
375 tagCmp_ :: Ord a => a -> a -> TAG_
376 tagCmp_ a b = if a == b then EQ_ else if a < b then LT_ else GT_
380 %************************************************************************
382 \subsection[Utils-lists]{General list processing}
384 %************************************************************************
386 Quantifiers are not standard in Haskell. The following fill in the gap.
389 forall :: (a -> Bool) -> [a] -> Bool
390 forall pred [] = True
391 forall pred (x:xs) = pred x && forall pred xs
393 exists :: (a -> Bool) -> [a] -> Bool
394 exists pred [] = False
395 exists pred (x:xs) = pred x || exists pred xs
398 A paranoid @zip@ that checks the lists are of equal length.
399 Alastair Reid thinks this should only happen if DEBUGging on;
403 zipEqual :: [a] -> [b] -> [(a,b)]
406 zipEqual a b = zip a b
409 zipEqual (a:as) (b:bs) = (a,b) : zipEqual as bs
410 zipEqual as bs = panic "zipEqual: unequal lists"
415 nOfThem :: Int -> a -> [a]
416 nOfThem n thing = take n (repeat thing)
418 lengthExceeds :: [a] -> Int -> Bool
420 [] `lengthExceeds` n = 0 > n
421 (x:xs) `lengthExceeds` n = (1 > n) || (xs `lengthExceeds` (n - 1))
423 isSingleton :: [a] -> Bool
425 isSingleton [x] = True
426 isSingleton _ = False
429 Debugging/specialising versions of \tr{elem} and \tr{notElem}
431 #if defined(COMPILING_GHC)
432 isIn, isn'tIn :: (Eq a) => String -> a -> [a] -> Bool
435 isIn msg x ys = elem__ x ys
436 isn'tIn msg x ys = notElem__ x ys
438 --these are here to be SPECIALIZEd (automagically)
440 elem__ x (y:ys) = x==y || elem__ x ys
442 notElem__ x [] = True
443 notElem__ x (y:ys) = x /= y && notElem__ x ys
451 | i _GE_ ILIT(100) = panic ("Over-long elem in: " ++ msg)
452 | otherwise = x == y || elem (i _ADD_ ILIT(1)) x ys
455 = notElem ILIT(0) x ys
457 notElem i x [] = True
459 | i _GE_ ILIT(100) = panic ("Over-long notElem in: " ++ msg)
460 | otherwise = x /= y && notElem (i _ADD_ ILIT(1)) x ys
464 # ifdef USE_ATTACK_PRAGMAS
465 {-# SPECIALIZE isIn :: String -> BasicLit -> [BasicLit] -> Bool #-}
466 {-# SPECIALIZE isIn :: String -> Class -> [Class] -> Bool #-}
467 {-# SPECIALIZE isIn :: String -> Id -> [Id] -> Bool #-}
468 {-# SPECIALIZE isIn :: String -> Int -> [Int] -> Bool #-}
469 {-# SPECIALIZE isIn :: String -> MagicId -> [MagicId] -> Bool #-}
470 {-# SPECIALIZE isIn :: String -> Name -> [Name] -> Bool #-}
471 {-# SPECIALIZE isIn :: String -> TyCon -> [TyCon] -> Bool #-}
472 {-# SPECIALIZE isIn :: String -> TyVar -> [TyVar] -> Bool #-}
473 {-# SPECIALIZE isIn :: String -> TyVarTemplate -> [TyVarTemplate] -> Bool #-}
474 {-# SPECIALIZE isIn :: String -> Unique -> [Unique] -> Bool #-}
475 {-# SPECIALIZE isIn :: String -> _PackedString -> [_PackedString] -> Bool #-}
476 {-# SPECIALIZE isn'tIn :: String -> (Id, Id) -> [(Id, Id)] -> Bool #-}
477 {-# SPECIALIZE isn'tIn :: String -> Int -> [Int] -> Bool #-}
478 {-# SPECIALIZE isn'tIn :: String -> Id -> [Id] -> Bool #-}
479 {-# SPECIALIZE isn'tIn :: String -> MagicId -> [MagicId] -> Bool #-}
480 {-# SPECIALIZE isn'tIn :: String -> TyCon -> [TyCon] -> Bool #-}
481 {-# SPECIALIZE isn'tIn :: String -> TyVar -> [TyVar] -> Bool #-}
482 {-# SPECIALIZE isn'tIn :: String -> TyVarTemplate -> [TyVarTemplate] -> Bool #-}
485 #endif {- COMPILING_GHC -}
488 %************************************************************************
490 \subsection[Utils-assoc]{Association lists}
492 %************************************************************************
494 See also @assocMaybe@ and @mkLookupFun@ in module @Maybes@.
497 assoc :: (Eq a) => String -> [(a, b)] -> a -> b
499 assoc crash_msg lst key
501 then panic ("Failed in assoc: " ++ crash_msg)
503 where res = [ val | (key', val) <- lst, key == key']
505 #if defined(COMPILING_GHC)
506 # ifdef USE_ATTACK_PRAGMAS
507 {-# SPECIALIZE assoc :: String -> [(Id, a)] -> Id -> a #-}
508 {-# SPECIALIZE assoc :: String -> [(Class, a)] -> Class -> a #-}
509 {-# SPECIALIZE assoc :: String -> [(Name, a)] -> Name -> a #-}
510 {-# SPECIALIZE assoc :: String -> [(PrimKind, a)] -> PrimKind -> a #-}
511 {-# SPECIALIZE assoc :: String -> [(String, a)] -> String -> a #-}
512 {-# SPECIALIZE assoc :: String -> [(TyCon, a)] -> TyCon -> a #-}
513 {-# SPECIALIZE assoc :: String -> [(TyVar, a)] -> TyVar -> a #-}
514 {-# SPECIALIZE assoc :: String -> [(TyVarTemplate, a)] -> TyVarTemplate -> a #-}
515 {-# SPECIALIZE assoc :: String -> [(UniType, a)] -> UniType -> a #-}
516 {-# SPECIALIZE assoc :: String -> [(_PackedString, a)] -> _PackedString -> a #-}
521 Given a list of associations one wants to look for the most recent
522 association for a given key. A couple of functions follow that cover
523 the simple lookup, the lookup with a default value when the key not
524 found, and two corresponding functions operating on unzipped lists
528 #ifdef USE_SEMANTIQUE_STRANAL
530 clookup :: (Eq a) => [a] -> [b] -> a -> b
531 clookup = clookupElse (panic "clookup")
533 -- clookupElse :: (Eq a) => b -> [a] -> [b] -> a -> b
534 clookupElse d [] [] a = d
535 clookupElse d (x:xs) (y:ys) a
537 | True = clookupElse d xs ys a
541 The following routine given a curried environment replaces the entry
542 labelled with a given name with a new value given. The new value is
543 given in the form of a function that allows to transform the old entry.
545 Assumption is that the list of labels contains the given one and that
546 the two lists of the curried environment are of equal lengths.
549 #ifdef USE_SEMANTIQUE_STRANAL
550 clookrepl :: Eq a => [a] -> [b] -> a -> (b -> b) -> [b]
551 clookrepl (a:as) (b:bs) x f
552 = if x == a then (f b:bs) else (b:clookrepl as bs x f)
556 The following returns the index of an element in a list.
559 #ifdef USE_SEMANTIQUE_STRANAL
561 elemIndex :: Eq a => [a] -> a -> Int
562 elemIndex as x = indx as x 0
564 indx :: Eq a => [a] -> a -> Int -> Int
565 indx (a:as) x n = if a==x then n else indx as x ((n+1)::Int)
566 # if defined(COMPILING_GHC)
567 indx [] x n = pprPanic "element not in list in elemIndex" ppNil
569 indx [] x n = error "element not in list in elemIndex"
574 %************************************************************************
576 \subsection[Utils-dups]{Duplicate-handling}
578 %************************************************************************
580 List difference (non-associative). In the result of @xs \\\ ys@, the
581 first occurrence of each element of ys in turn (if any) has been
582 removed from xs. Thus, @(xs ++ ys) \\\ xs == ys@. This function is
583 a copy of @\\@ from report 1.1 and is added to overshade the buggy
584 version from the 1.0 version of Haskell.
586 This routine can be removed after the compiler bootstraps itself and
587 a proper @\\@ is can be applied.
590 #ifdef USE_SEMANTIQUE_STRANAL
591 (\\\) :: (Eq a) => [a] -> [a] -> [a]
597 | otherwise = x : xs `del` y
602 hasNoDups :: (Eq a) => [a] -> Bool
603 hasNoDups xs = f [] xs
605 f seen_so_far [] = True
606 f seen_so_far (x:xs) = if x `is_elem` seen_so_far then
611 #if defined(COMPILING_GHC)
612 is_elem = isIn "hasNoDups"
616 #if defined(COMPILING_GHC)
617 # ifdef USE_ATTACK_PRAGMAS
618 {-# SPECIALIZE hasNoDups :: [TyVar] -> Bool #-}
624 equivClasses :: (a -> a -> TAG_) -- Comparison
628 equivClasses cmp stuff@[] = []
629 equivClasses cmp stuff@[item] = [stuff]
630 equivClasses cmp items
631 = runs eq (sortLt lt items)
633 eq a b = case cmp a b of { EQ_ -> True; _ -> False }
634 lt a b = case cmp a b of { LT_ -> True; _ -> False }
637 The first cases in @equivClasses@ above are just to cut to the point
640 @runs@ groups a list into a list of lists, each sublist being a run of
641 identical elements of the input list. It is passed a predicate @p@ which
642 tells when two elements are equal.
645 runs :: (a -> a -> Bool) -- Equality
650 runs p (x:xs) = case (span (p x) xs) of
651 (first, rest) -> (x:first) : (runs p rest)
655 removeDups :: (a -> a -> TAG_) -- Comparison function
657 -> ([a], -- List with no duplicates
658 [[a]]) -- List of duplicate groups. One representative from
659 -- each group appears in the first result
661 removeDups cmp [] = ([], [])
662 removeDups cmp [x] = ([x],[])
664 = case (mapAccumR collect_dups [] (equivClasses cmp xs)) of { (dups, xs') ->
667 collect_dups dups_so_far [x] = (dups_so_far, x)
668 collect_dups dups_so_far dups@(x:xs) = (dups:dups_so_far, x)
671 %************************************************************************
673 \subsection[Utils-sorting]{Sorting}
675 %************************************************************************
677 %************************************************************************
679 \subsubsection[Utils-quicksorting]{Quicksorts}
681 %************************************************************************
684 -- tail-recursive, etc., "quicker sort" [as per Meira thesis]
685 quicksort :: (a -> a -> Bool) -- Less-than predicate
687 -> [a] -- Result list in increasing order
690 quicksort lt [x] = [x]
691 quicksort lt (x:xs) = split x [] [] xs
693 split x lo hi [] = quicksort lt lo ++ (x : quicksort lt hi)
694 split x lo hi (y:ys) | y `lt` x = split x (y:lo) hi ys
695 | True = split x lo (y:hi) ys
698 Quicksort variant from Lennart's Haskell-library contribution. This
699 is a {\em stable} sort.
702 stableSortLt = sortLt -- synonym; when we want to highlight stable-ness
704 sortLt :: (a -> a -> Bool) -- Less-than predicate
706 -> [a] -- Result list
708 sortLt lt l = qsort lt l []
710 -- qsort is stable and does not concatenate.
711 qsort :: (a -> a -> Bool) -- Less-than predicate
712 -> [a] -- xs, Input list
713 -> [a] -- r, Concatenate this list to the sorted input list
714 -> [a] -- Result = sort xs ++ r
718 qsort lt (x:xs) r = qpart lt x xs [] [] r
720 -- qpart partitions and sorts the sublists
721 -- rlt contains things less than x,
722 -- rge contains the ones greater than or equal to x.
723 -- Both have equal elements reversed with respect to the original list.
725 qpart lt x [] rlt rge r =
726 -- rlt and rge are in reverse order and must be sorted with an
727 -- anti-stable sorting
728 rqsort lt rlt (x : rqsort lt rge r)
730 qpart lt x (y:ys) rlt rge r =
733 qpart lt x ys (y:rlt) rge r
736 qpart lt x ys rlt (y:rge) r
738 -- rqsort is as qsort but anti-stable, i.e. reverses equal elements
740 rqsort lt [x] r = x:r
741 rqsort lt (x:xs) r = rqpart lt x xs [] [] r
743 rqpart lt x [] rle rgt r =
744 qsort lt rle (x : qsort lt rgt r)
746 rqpart lt x (y:ys) rle rgt r =
749 rqpart lt x ys rle (y:rgt) r
752 rqpart lt x ys (y:rle) rgt r
755 %************************************************************************
757 \subsubsection[Utils-dull-mergesort]{A rather dull mergesort}
759 %************************************************************************
762 mergesort :: (a -> a -> TAG_) -> [a] -> [a]
764 mergesort cmp xs = merge_lists (split_into_runs [] xs)
766 a `le` b = case cmp a b of { LT_ -> True; EQ_ -> True; GT__ -> False }
767 a `ge` b = case cmp a b of { LT_ -> False; EQ_ -> True; GT__ -> True }
769 split_into_runs [] [] = []
770 split_into_runs run [] = [run]
771 split_into_runs [] (x:xs) = split_into_runs [x] xs
772 split_into_runs [r] (x:xs) | x `ge` r = split_into_runs [r,x] xs
773 split_into_runs rl@(r:rs) (x:xs) | x `le` r = split_into_runs (x:rl) xs
774 | True = rl : (split_into_runs [x] xs)
777 merge_lists (x:xs) = merge x (merge_lists xs)
781 merge xl@(x:xs) yl@(y:ys)
783 EQ_ -> x : y : (merge xs ys)
784 LT_ -> x : (merge xs yl)
785 GT__ -> y : (merge xl ys)
788 %************************************************************************
790 \subsubsection[Utils-Carsten-mergesort]{A mergesort from Carsten}
792 %************************************************************************
795 Date: Mon, 3 May 93 20:45:23 +0200
796 From: Carsten Kehler Holst <kehler@cs.chalmers.se>
797 To: partain@dcs.gla.ac.uk
798 Subject: natural merge sort beats quick sort [ and it is prettier ]
800 Here a piece of Haskell code that I'm rather fond of. See it as an
801 attempt to get rid of the ridiculous quick-sort routine. group is
802 quite useful by itself I think it was John's idea originally though I
803 believe the lazy version is due to me [surprisingly complicated].
804 gamma [used to be called] is called gamma because I got inspired by
805 the Gamma calculus. It is not very close to the calculus but does
806 behave less sequentially than both foldr and foldl. One could imagine a
807 version of gamma that took a unit element as well thereby avoiding the
808 problem with empty lists.
810 I've tried this code against
812 1) insertion sort - as provided by haskell
813 2) the normal implementation of quick sort
814 3) a deforested version of quick sort due to Jan Sparud
815 4) a super-optimized-quick-sort of Lennart's
817 If the list is partially sorted both merge sort and in particular
818 natural merge sort wins. If the list is random [ average length of
819 rising subsequences = approx 2 ] mergesort still wins and natural
820 merge sort is marginally beaten by Lennart's soqs. The space
821 consumption of merge sort is a bit worse than Lennart's quick sort
822 approx a factor of 2. And a lot worse if Sparud's bug-fix [see his
823 fpca article ] isn't used because of group.
830 group :: (a -> a -> Bool) -> [a] -> [[a]]
834 let ((h1:t1):tt1) = group p xs
835 (t,tt) = if null xs then ([],[]) else
836 if x `p` h1 then (h1:t1,tt1) else
840 generalMerge :: (a -> a -> Bool) -> [a] -> [a] -> [a]
841 generalMerge p xs [] = xs
842 generalMerge p [] ys = ys
843 generalMerge p (x:xs) (y:ys) | x `p` y = x : generalMerge p xs (y:ys)
844 | otherwise = y : generalMerge p (x:xs) ys
846 -- gamma is now called balancedFold
848 balancedFold :: (a -> a -> a) -> [a] -> a
849 balancedFold f [] = error "can't reduce an empty list using balancedFold"
850 balancedFold f [x] = x
851 balancedFold f l = balancedFold f (balancedFold' f l)
853 balancedFold' :: (a -> a -> a) -> [a] -> [a]
854 balancedFold' f (x:y:xs) = f x y : balancedFold' f xs
855 balancedFold' f xs = xs
857 generalMergeSort p [] = []
858 generalMergeSort p xs = (balancedFold (generalMerge p) . map (: [])) xs
860 generalNaturalMergeSort p [] = []
861 generalNaturalMergeSort p xs = (balancedFold (generalMerge p) . group p) xs
863 mergeSort, naturalMergeSort :: Ord a => [a] -> [a]
865 mergeSort = generalMergeSort (<=)
866 naturalMergeSort = generalNaturalMergeSort (<=)
868 mergeSortLe le = generalMergeSort le
869 naturalMergeSortLe le = generalNaturalMergeSort le
872 %************************************************************************
874 \subsection[Utils-transitive-closure]{Transitive closure}
876 %************************************************************************
878 This algorithm for transitive closure is straightforward, albeit quadratic.
881 transitiveClosure :: (a -> [a]) -- Successor function
882 -> (a -> a -> Bool) -- Equality predicate
884 -> [a] -- The transitive closure
886 transitiveClosure succ eq xs
890 do done (x:xs) | x `is_in` done = do done xs
891 | otherwise = do (x:done) (succ x ++ xs)
894 x `is_in` (y:ys) | eq x y = True
895 | otherwise = x `is_in` ys
898 %************************************************************************
900 \subsection[Utils-accum]{Accumulating}
902 %************************************************************************
904 @mapAccumL@ behaves like a combination
905 of @map@ and @foldl@;
906 it applies a function to each element of a list, passing an accumulating
907 parameter from left to right, and returning a final value of this
908 accumulator together with the new list.
911 mapAccumL :: (acc -> x -> (acc, y)) -- Function of elt of input list
912 -- and accumulator, returning new
913 -- accumulator and elt of result list
914 -> acc -- Initial accumulator
916 -> (acc, [y]) -- Final accumulator and result list
918 mapAccumL f b [] = (b, [])
919 mapAccumL f b (x:xs) = (b'', x':xs') where
921 (b'', xs') = mapAccumL f b' xs
924 @mapAccumR@ does the same, but working from right to left instead. Its type is
925 the same as @mapAccumL@, though.
928 mapAccumR :: (acc -> x -> (acc, y)) -- Function of elt of input list
929 -- and accumulator, returning new
930 -- accumulator and elt of result list
931 -> acc -- Initial accumulator
933 -> (acc, [y]) -- Final accumulator and result list
935 mapAccumR f b [] = (b, [])
936 mapAccumR f b (x:xs) = (b'', x':xs') where
938 (b', xs') = mapAccumR f b xs
941 Here is the bi-directional version, that works from both left and right.
944 mapAccumB :: (accl -> accr -> x -> (accl, accr,y))
945 -- Function of elt of input list
946 -- and accumulator, returning new
947 -- accumulator and elt of result list
948 -> accl -- Initial accumulator from left
949 -> accr -- Initial accumulator from right
951 -> (accl, accr, [y]) -- Final accumulators and result list
953 mapAccumB f a b [] = (a,b,[])
954 mapAccumB f a b (x:xs) = (a'',b'',y:ys)
956 (a',b'',y) = f a b' x
957 (a'',b',ys) = mapAccumB f a' b xs
960 %************************************************************************
962 \subsection[Utils-comparison]{Comparisons}
964 %************************************************************************
966 See also @tagCmp_@ near the versions-compatibility section.
969 cmpString :: String -> String -> TAG_
971 cmpString [] [] = EQ_
972 cmpString (x:xs) (y:ys) = if x == y then cmpString xs ys
973 else if x < y then LT_
975 cmpString [] ys = LT_
976 cmpString xs [] = GT_
978 cmpString _ _ = case (panic "cmpString") of { s -> -- BUG avoidance: never get here
979 cmpString s "" -- will never get here
984 #ifdef USE_FAST_STRINGS
985 cmpPString :: FAST_STRING -> FAST_STRING -> TAG_
988 = case (_tagCmp x y) of { _LT -> LT_ ; _EQ -> EQ_ ; _GT -> GT_ }
993 #ifndef USE_FAST_STRINGS
994 substr :: FAST_STRING -> Int -> Int -> FAST_STRING
997 = ASSERT (beg >= 0 && beg <= end)
998 take (end - beg + 1) (drop beg str)
1002 %************************************************************************
1004 \subsection[Utils-pairs]{Pairs}
1006 %************************************************************************
1008 The following are curried versions of @fst@ and @snd@.
1011 cfst :: a -> b -> a -- stranal-sem only (Note)
1015 The following provide us higher order functions that, when applied
1016 to a function, operate on pairs.
1019 applyToPair :: ((a -> c),(b -> d)) -> (a,b) -> (c,d)
1020 applyToPair (f,g) (x,y) = (f x, g y)
1022 applyToFst :: (a -> c) -> (a,b)-> (c,b)
1023 applyToFst f (x,y) = (f x,y)
1025 applyToSnd :: (b -> d) -> (a,b) -> (a,d)
1026 applyToSnd f (x,y) = (x,f y)
1028 foldPair :: (a->a->a,b->b->b) -> (a,b) -> [(a,b)] -> (a,b)
1029 foldPair fg ab [] = ab
1030 foldPair fg@(f,g) ab ((a,b):abs) = (f a u,g b v)
1031 where (u,v) = foldPair fg ab abs
1035 unzipWith :: (a -> b -> c) -> [(a, b)] -> [c]
1036 unzipWith f pairs = map ( \ (a, b) -> f a b ) pairs
1039 %************************************************************************
1041 \subsection[Utils-errors]{Error handling}
1043 %************************************************************************
1046 #if defined(COMPILING_GHC)
1047 panic x = error ("panic! (the `impossible' happened):\n\t"
1049 ++ "Please report it as a compiler bug "
1050 ++ "to glasgow-haskell-bugs@dcs.glasgow.ac.uk.\n\n" )
1052 pprPanic heading pretty_msg = panic (heading++(ppShow 80 pretty_msg))
1054 pprTrace heading pretty_msg = trace (heading++(ppShow 80 pretty_msg))
1057 assertPanic :: String -> Int -> a
1058 assertPanic file line = panic ("ASSERT failed! file "++file++", line "++show line)
1060 #endif {- COMPILING_GHC -}