X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=utils%2Fnofib-analyse%2FGenUtils.lhs;h=6a1fb768e316376255af8b36a384d21524b9e213;hb=8a2809c29de9f23eba7ca682b48390033a9d40f6;hp=0dcb844827859a6544b9953c501fd51f4423f2dc;hpb=6d2b0b3479a3ce00c3b4a01255e4dab09eb08783;p=ghc-hetmet.git diff --git a/utils/nofib-analyse/GenUtils.lhs b/utils/nofib-analyse/GenUtils.lhs index 0dcb844..6a1fb76 100644 --- a/utils/nofib-analyse/GenUtils.lhs +++ b/utils/nofib-analyse/GenUtils.lhs @@ -8,11 +8,11 @@ > module GenUtils ( -> partition', tack, +> partition', tack, > assocMaybeErr, > arrElem, > memoise, -> returnMaybe,handleMaybe, findJust, +> returnMaybe,handleMaybe, findJust, > MaybeErr(..), > maybeMap, > joinMaybe, @@ -25,15 +25,15 @@ > rjustify, > space, > copy, -> combinePairs, -> --trace, -- re-export it -> fst3, -> snd3, -> thd3 +> combinePairs, +> --trace, -- re-export it +> fst3, +> snd3, +> thd3 #if __HASKELL1__ < 3 || ( defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 200 ) -> ,Cmp(..), compare, lookup, isJust +> ,Cmp(..), compare, lookup, isJust #endif @@ -52,7 +52,7 @@ %------------------------------------------------------------------------------ -Here are two defs that everyone seems to define ... +Here are two defs that everyone seems to define ... HBC has it in one of its builtin modules #ifdef __GOFER__ @@ -70,13 +70,13 @@ HBC has it in one of its builtin modules primGenericGe "primGenericGe", primGenericGt "primGenericGt" :: a -> a -> Bool - instance Text (Maybe a) where { showsPrec = primPrint } + instance Text (Maybe a) where { showsPrec = primPrint } instance Eq (Maybe a) where - (==) = primGenericEq + (==) = primGenericEq (/=) = primGenericNe instance (Ord a) => Ord (Maybe a) - where + where Nothing <= _ = True _ <= Nothing = True (Just a) <= (Just b) = a <= b @@ -87,7 +87,7 @@ HBC has it in one of its builtin modules > maybeMap f (Just a) = Just (f a) > maybeMap _ Nothing = Nothing -> joinMaybe :: (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a +> joinMaybe :: (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a > joinMaybe _ Nothing Nothing = Nothing > joinMaybe _ (Just g) Nothing = Just g > joinMaybe _ Nothing (Just g) = Just g @@ -95,8 +95,8 @@ HBC has it in one of its builtin modules > data MaybeErr a err = Succeeded a | Failed err deriving (Eq,Text) -@mkClosure@ makes a closure, when given a comparison and iteration loop. -Be careful, because if the functional always makes the object different, +@mkClosure@ makes a closure, when given a comparison and iteration loop. +Be careful, because if the functional always makes the object different, This will never terminate. > mkClosure :: (a -> a -> Bool) -> (a -> a) -> a -> a @@ -104,19 +104,20 @@ This will never terminate. > where > match (a:b:_) | a `eq` b = a > match (_:c) = match c +> match [] = error "GenUtils.mkClosure: Can't happen" > foldb :: (a -> a -> a) -> [a] -> a > foldb _ [] = error "can't reduce an empty list using foldb" > foldb _ [x] = x > foldb f l = foldb f (foldb' l) -> where +> where > foldb' (x:y:x':y':xs) = f (f x y) (f x' y') : foldb' xs > foldb' (x:y:xs) = f x y : foldb' xs > foldb' xs = xs -Merge two ordered lists into one ordered list. +Merge two ordered lists into one ordered list. -> mergeWith :: (a -> a -> Bool) -> [a] -> [a] -> [a] +> mergeWith :: (a -> a -> Bool) -> [a] -> [a] -> [a] > mergeWith _ [] ys = ys > mergeWith _ xs [] = xs > mergeWith le (x:xs) (y:ys) @@ -136,9 +137,9 @@ quickest sorting function I know of. > sortWith _ [] = [] > sortWith le lst = foldb (mergeWith le) (splitList lst) > where -> splitList (a1:a2:a3:a4:a5:xs) = -> insertWith le a1 -> (insertWith le a2 +> splitList (a1:a2:a3:a4:a5:xs) = +> insertWith le a1 +> (insertWith le a2 > (insertWith le a3 > (insertWith le a4 [a5]))) : splitList xs > splitList [] = [] @@ -154,16 +155,19 @@ quickest sorting function I know of. > handleMaybe m k = case m of > Nothing -> k > _ -> m - + > findJust :: (a -> Maybe b) -> [a] -> Maybe b > findJust f = foldr handleMaybe Nothing . map f Gofer-like stuff: -> fst3 (a,_,_) = a -> snd3 (_,a,_) = a -> thd3 (_,a,_) = a +> fst3 :: (a, b, c) -> a +> fst3 (a, _, _) = a +> snd3 :: (a, b, c) -> b +> snd3 (_, a, _) = a +> thd3 :: (a, b, c) -> c +> thd3 (_, _, a) = a > cjustify, ljustify, rjustify :: Int -> String -> String > cjustify n s = space halfm ++ s ++ space (m - halfm) @@ -174,29 +178,30 @@ Gofer-like stuff: > space :: Int -> String > space n | n < 0 = "" -> | otherwise = copy n ' ' +> | otherwise = copy n ' ' > copy :: Int -> a -> [a] -- make list of n copies of x > copy n x = take n xs where xs = x:xs > partition' :: (Eq b) => (a -> b) -> [a] -> [[a]] -> partition' f [] = [] -> partition' f [x] = [[x]] -> partition' f (x:x':xs) | f x == f x' +> partition' _ [] = [] +> partition' _ [x] = [[x]] +> partition' f (x:x':xs) | f x == f x' > = tack x (partition' f (x':xs)) -> | otherwise +> | otherwise > = [x] : partition' f (x':xs) +> tack :: a -> [[a]] -> [[a]] > tack x xss = (x : head xss) : tail xss > combinePairs :: (Ord a) => [(a,b)] -> [(a,[b])] -> combinePairs xs = -> combine [ (a,[b]) | (a,b) <- sortWith (\ (a,_) (b,_) -> a <= b) xs] +> combinePairs xs = +> combine [ (a,[b]) | (a,b) <- sortWith (\ (a,_) (b,_) -> a <= b) xs] > where -> combine [] = [] -> combine ((a,b):(c,d):r) | a == c = combine ((a,b++d) : r) -> combine (a:r) = a : combine r -> +> combine [] = [] +> combine ((a,b):(c,d):r) | a == c = combine ((a,b++d) : r) +> combine (a:r) = a : combine r +> #if __HASKELL1__ < 3 || ( defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 200 ) @@ -209,27 +214,26 @@ Gofer-like stuff: > data Cmp = LT | EQ | GT > compare a b | a < b = LT -> | a == b = EQ -> | otherwise = GT +> | a == b = EQ +> | otherwise = GT > isJust :: Maybe a -> Bool > isJust (Just _) = True -> isJust _ = False +> isJust _ = False #endif > assocMaybeErr :: (Eq a) => [(a,b)] -> a -> MaybeErr b String > assocMaybeErr env k = case [ val | (key,val) <- env, k == key] of > [] -> Failed "assoc: " -> (val:vs) -> Succeeded val -> +> (val:_) -> Succeeded val Now some utilties involving arrays. Here is a version of @elem@ that uses partual application to optimise lookup. > arrElem :: (Ix a) => [a] -> a -> Bool -> arrElem obj = \x -> inRange size x && arr ! x +> arrElem obj = \x -> inRange size x && arr ! x > where > obj' = sort obj > size = (head obj',last obj') @@ -251,47 +255,3 @@ will give a very efficent variation of the fib function. > memoise bds f = (!) arr > where arr = array bds [ ASSOC(t, f t) | t <- range bds ] -> mapAccumR :: (acc -> x -> (acc, y)) -- Function of elt of input list -> -- and accumulator, returning new -> -- accumulator and elt of result list -> -> acc -- Initial accumulator -> -> [x] -- Input list -> -> (acc, [y]) -- Final accumulator and result list -> -> mapAccumR f b [] = (b, []) -> mapAccumR f b (x:xs) = (b'', x':xs') where -> (b'', x') = f b' x -> (b', xs') = mapAccumR f b xs - -> mapAccumL :: (acc -> x -> (acc, y)) -- Function of elt of input list -> -- and accumulator, returning new -> -- accumulator and elt of result list -> -> acc -- Initial accumulator -> -> [x] -- Input list -> -> (acc, [y]) -- Final accumulator and result list -> -> mapAccumL f b [] = (b, []) -> mapAccumL f b (x:xs) = (b'', x':xs') where -> (b', x') = f b x -> (b'', xs') = mapAccumL f b' xs - -Here is the bi-directional version ... - -> mapAccumB :: (accl -> accr -> x -> (accl, accr,y)) -> -- Function of elt of input list -> -- and accumulator, returning new -> -- accumulator and elt of result list -> -> accl -- Initial accumulator from left -> -> accr -- Initial accumulator from right -> -> [x] -- Input list -> -> (accl, accr, [y]) -- Final accumulator and result list -> -> mapAccumB f a b [] = (a,b,[]) -> mapAccumB f a b (x:xs) = (a'',b'',y:ys) -> where -> (a',b'',y) = f a b' x -> (a'',b',ys) = mapAccumB f a' b xs - - -> assert False x = error "assert Failed" -> assert True x = x