summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorThomas Miedema <thomasmiedema@gmail.com>2014-09-23 08:44:45 -0500
committerAustin Seipp <austin@well-typed.com>2014-09-23 08:44:46 -0500
commit330bb3ef856166d18d959b377f12a51c2629b223 (patch)
tree2beed4c0c3829747428f8b775a9e43eb84144544
parent2a743bbddd4de41a77af9b83ec4720cd013292cf (diff)
downloadhaskell-330bb3ef856166d18d959b377f12a51c2629b223.tar.gz
Delete all /* ! __GLASGOW_HASKELL__ */ code
Summary: ``` git grep -l '\(#ifdef \|#if defined\)(\?__GLASGOW_HASKELL__)\?' ``` Test Plan: validate Reviewers: rwbarton, hvr, austin Reviewed By: rwbarton, hvr, austin Subscribers: rwbarton, simonmar, ezyang, carter Differential Revision: https://phabricator.haskell.org/D218
-rw-r--r--compiler/HsVersions.h6
-rw-r--r--compiler/basicTypes/Unique.lhs12
-rw-r--r--compiler/utils/Binary.hs5
-rw-r--r--compiler/utils/FastBool.lhs17
-rw-r--r--compiler/utils/FastFunctions.lhs25
-rw-r--r--compiler/utils/FastMutInt.lhs46
-rw-r--r--compiler/utils/FastString.lhs8
-rw-r--r--compiler/utils/FastTypes.lhs74
-rw-r--r--compiler/utils/Pretty.lhs4
-rw-r--r--compiler/utils/Util.lhs2
-rw-r--r--libraries/base/cbits/PrelIOUtils.c11
-rw-r--r--testsuite/tests/programs/andy_cherry/GenUtils.hs68
12 files changed, 35 insertions, 243 deletions
diff --git a/compiler/HsVersions.h b/compiler/HsVersions.h
index bd28c69377..7ba82e1898 100644
--- a/compiler/HsVersions.h
+++ b/compiler/HsVersions.h
@@ -22,9 +22,6 @@ you will screw up the layout where they are used in case expressions!
* settings for the target plat instead). */
#include "../includes/ghcautoconf.h"
-/* Global variables may not work in other Haskell implementations,
- * but we need them currently! so the conditional on GLASGOW won't do. */
-#if defined(__GLASGOW_HASKELL__) || !defined(__GLASGOW_HASKELL__)
#define GLOBAL_VAR(name,value,ty) \
{-# NOINLINE name #-}; \
name :: IORef (ty); \
@@ -34,14 +31,13 @@ name = Util.global (value);
{-# NOINLINE name #-}; \
name :: IORef (ty); \
name = Util.globalM (value);
-#endif
#define ASSERT(e) if debugIsOn && not (e) then (assertPanic __FILE__ __LINE__) else
#define ASSERT2(e,msg) if debugIsOn && not (e) then (assertPprPanic __FILE__ __LINE__ (msg)) else
#define WARN( e, msg ) (warnPprTrace (e) __FILE__ __LINE__ (msg)) $
-- Examples: Assuming flagSet :: String -> m Bool
---
+--
-- do { c <- getChar; MASSERT( isUpper c ); ... }
-- do { c <- getChar; MASSERT2( isUpper c, text "Bad" ); ... }
-- do { str <- getStr; ASSERTM( flagSet str ); .. }
diff --git a/compiler/basicTypes/Unique.lhs b/compiler/basicTypes/Unique.lhs
index 897b093e39..8191db6ffd 100644
--- a/compiler/basicTypes/Unique.lhs
+++ b/compiler/basicTypes/Unique.lhs
@@ -66,12 +66,9 @@ import Outputable
-- import StaticFlags
import Util
-#if defined(__GLASGOW_HASKELL__)
--just for implementing a fast [0,61) -> Char function
import GHC.Exts (indexCharOffAddr#, Char(..))
-#else
-import Data.Array
-#endif
+
import Data.Char ( chr, ord )
\end{code}
@@ -260,15 +257,8 @@ iToBase62 n_
chooseChar62 :: FastInt -> Char
{-# INLINE chooseChar62 #-}
-#if defined(__GLASGOW_HASKELL__)
- --then FastInt == Int#
chooseChar62 n = C# (indexCharOffAddr# chars62 n)
!chars62 = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"#
-#else
- --Haskell98 arrays are portable
- chooseChar62 n = (!) chars62 n
- chars62 = listArray (0,61) "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
-#endif
\end{code}
%************************************************************************
diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs
index 53ee903f2f..ea53b31729 100644
--- a/compiler/utils/Binary.hs
+++ b/compiler/utils/Binary.hs
@@ -46,12 +46,9 @@ module Binary
lazyGet,
lazyPut,
-#ifdef __GLASGOW_HASKELL__
- -- GHC only:
ByteArray(..),
getByteArray,
putByteArray,
-#endif
UserData(..), getUserData, setUserData,
newReadState, newWriteState,
@@ -461,7 +458,6 @@ instance Binary DiffTime where
get bh = do r <- get bh
return $ fromRational r
-#if defined(__GLASGOW_HASKELL__) || 1
--to quote binary-0.3 on this code idea,
--
-- TODO This instance is not architecture portable. GMP stores numbers as
@@ -553,7 +549,6 @@ indexByteArray a# n# = W8# (indexWord8Array# a# n#)
instance (Integral a, Binary a) => Binary (Ratio a) where
put_ bh (a :% b) = do put_ bh a; put_ bh b
get bh = do a <- get bh; b <- get bh; return (a :% b)
-#endif
instance Binary (Bin a) where
put_ bh (BinPtr i) = put_ bh (fromIntegral i :: Int32)
diff --git a/compiler/utils/FastBool.lhs b/compiler/utils/FastBool.lhs
index 9558da7079..9aa1a75b37 100644
--- a/compiler/utils/FastBool.lhs
+++ b/compiler/utils/FastBool.lhs
@@ -11,8 +11,6 @@ module FastBool (
FastBool, fastBool, isFastTrue, fastOr, fastAnd
) where
-#if defined(__GLASGOW_HASKELL__)
-
-- Import the beggars
import GHC.Exts
#ifdef DEBUG
@@ -66,21 +64,6 @@ fastAnd _ x = x
#endif /* ! DEBUG */
-
-#else /* ! __GLASGOW_HASKELL__ */
-
-type FastBool = Bool
-fastBool x = x
-isFastTrue x = x
--- make sure these are as strict as the unboxed version,
--- so that the performance characteristics match
-fastOr False False = False
-fastOr _ _ = True
-fastAnd True True = True
-fastAnd _ _ = False
-
-#endif /* ! __GLASGOW_HASKELL__ */
-
fastBool :: Bool -> FastBool
isFastTrue :: FastBool -> Bool
fastOr :: FastBool -> FastBool -> FastBool
diff --git a/compiler/utils/FastFunctions.lhs b/compiler/utils/FastFunctions.lhs
index 457fcc9c93..854bd13b11 100644
--- a/compiler/utils/FastFunctions.lhs
+++ b/compiler/utils/FastFunctions.lhs
@@ -19,8 +19,6 @@ import FastTypes
import Data.IORef
import System.IO.Unsafe
-#if defined(__GLASGOW_HASKELL__)
-
import GHC.Exts
import GHC.Word
import GHC.Base (unsafeChr)
@@ -37,29 +35,6 @@ indexWord8OffFastPtrAsFastChar p i = indexCharOffAddr# p i
indexWord8OffFastPtrAsFastInt p i = word2Int# (indexWord8OffAddr# p i)
-- or ord# (indexCharOffAddr# p i)
-#else /* ! __GLASGOW_HASKELL__ */
-
-import Foreign.Ptr
-import Data.Word
-
--- hey, no harm inlining it, :-P
-{-# INLINE inlinePerformIO #-}
-inlinePerformIO :: IO a -> a
-inlinePerformIO = unsafePerformIO
-
-unsafeDupableInterleaveIO :: IO a -> IO a
-unsafeDupableInterleaveIO = unsafeInterleaveIO
-
--- truly, these functions are unsafe: they assume
--- a certain immutability of the pointer's target area.
-indexWord8OffFastPtr p i = inlinePerformIO (peekByteOff p n) :: Word8
-indexWord8OffFastPtrAsFastInt p i =
- iUnbox (fromIntegral (inlinePerformIO (peekByteOff p n) :: Word8))
-indexWord8OffFastPtrAsFastChar p i =
- fastChr (iUnbox (fromIntegral (inlinePerformIO (peekByteOff p n) :: Word8)))
-
-#endif /* ! __GLASGOW_HASKELL__ */
-
--just so we can refer to the type clearly in a macro
type Global a = IORef a
global :: a -> Global a
diff --git a/compiler/utils/FastMutInt.lhs b/compiler/utils/FastMutInt.lhs
index 0f0ca78e14..e866aa5d38 100644
--- a/compiler/utils/FastMutInt.lhs
+++ b/compiler/utils/FastMutInt.lhs
@@ -16,7 +16,6 @@ module FastMutInt(
readFastMutPtr, writeFastMutPtr
) where
-#ifdef __GLASGOW_HASKELL__
#include "../includes/MachDeps.h"
#ifndef SIZEOF_HSINT
@@ -26,12 +25,6 @@ module FastMutInt(
import GHC.Base
import GHC.Ptr
-#else /* ! __GLASGOW_HASKELL__ */
-
-import Data.IORef
-
-#endif
-
newFastMutInt :: IO FastMutInt
readFastMutInt :: FastMutInt -> IO Int
writeFastMutInt :: FastMutInt -> Int -> IO ()
@@ -42,7 +35,6 @@ writeFastMutPtr :: FastMutPtr -> Ptr a -> IO ()
\end{code}
\begin{code}
-#ifdef __GLASGOW_HASKELL__
data FastMutInt = FastMutInt (MutableByteArray# RealWorld)
newFastMutInt = IO $ \s ->
@@ -72,43 +64,5 @@ readFastMutPtr (FastMutPtr arr) = IO $ \s ->
writeFastMutPtr (FastMutPtr arr) (Ptr i) = IO $ \s ->
case writeAddrArray# arr 0# i s of { s ->
(# s, () #) }
-#else /* ! __GLASGOW_HASKELL__ */
---maybe someday we could use
---http://haskell.org/haskellwiki/Library/ArrayRef
---which has an implementation of IOURefs
---that is unboxed in GHC and just strict in all other compilers...
-newtype FastMutInt = FastMutInt (IORef Int)
-
--- If any default value was chosen, it surely would be 0,
--- so we will use that since IORef requires a default value.
--- Or maybe it would be more interesting to package an error,
--- assuming nothing relies on being able to read a bogus Int?
--- That could interfere with its strictness for smart optimizers
--- (are they allowed to optimize a 'newtype' that way?) ...
--- Well, maybe that can be added (in DEBUG?) later.
-newFastMutInt = fmap FastMutInt (newIORef 0)
-
-readFastMutInt (FastMutInt ioRefInt) = readIORef ioRefInt
-
--- FastMutInt is strict in the value it contains.
-writeFastMutInt (FastMutInt ioRefInt) i = i `seq` writeIORef ioRefInt i
-
-
-newtype FastMutPtr = FastMutPtr (IORef (Ptr ()))
-
--- If any default value was chosen, it surely would be 0,
--- so we will use that since IORef requires a default value.
--- Or maybe it would be more interesting to package an error,
--- assuming nothing relies on being able to read a bogus Ptr?
--- That could interfere with its strictness for smart optimizers
--- (are they allowed to optimize a 'newtype' that way?) ...
--- Well, maybe that can be added (in DEBUG?) later.
-newFastMutPtr = fmap FastMutPtr (newIORef (castPtr nullPtr))
-
-readFastMutPtr (FastMutPtr ioRefPtr) = readIORef ioRefPtr
-
--- FastMutPtr is strict in the value it contains.
-writeFastMutPtr (FastMutPtr ioRefPtr) i = i `seq` writeIORef ioRefPtr i
-#endif
\end{code}
diff --git a/compiler/utils/FastString.lhs b/compiler/utils/FastString.lhs
index 91236cce11..4d98b2bdae 100644
--- a/compiler/utils/FastString.lhs
+++ b/compiler/utils/FastString.lhs
@@ -50,9 +50,7 @@ module FastString
mkFastStringBytes,
mkFastStringByteList,
mkFastStringForeignPtr,
-#if defined(__GLASGOW_HASKELL__)
mkFastString#,
-#endif
-- ** Deconstruction
unpackFS, -- :: FastString -> String
@@ -84,9 +82,7 @@ module FastString
-- ** Construction
sLit,
-#if defined(__GLASGOW_HASKELL__)
mkLitString#,
-#endif
mkLitString,
-- ** Deconstruction
@@ -128,9 +124,7 @@ import Foreign.Safe
import GHC.Conc.Sync (sharedCAF)
#endif
-#if defined(__GLASGOW_HASKELL__)
import GHC.Base ( unpackCString# )
-#endif
#define hASH_TBL_SIZE 4091
#define hASH_TBL_SIZE_UNBOXED 4091#
@@ -573,10 +567,8 @@ type LitString = Ptr Word8
--If it's commonly needed, we should perhaps have
--data LitString = LitString {-#UNPACK#-}!(FastPtr Word8) {-#UNPACK#-}!FastInt
-#if defined(__GLASGOW_HASKELL__)
mkLitString# :: Addr# -> LitString
mkLitString# a# = Ptr a#
-#endif
--can/should we use FastTypes here?
--Is this likely to be memory-preserving if only used on constant strings?
--should we inline it? If lucky, that would make a CAF that wouldn't
diff --git a/compiler/utils/FastTypes.lhs b/compiler/utils/FastTypes.lhs
index 36d8e4c4fd..6b1517c484 100644
--- a/compiler/utils/FastTypes.lhs
+++ b/compiler/utils/FastTypes.lhs
@@ -63,8 +63,6 @@ module FastTypes (
#include "HsVersions.h"
-#if defined(__GLASGOW_HASKELL__)
-
-- Import the beggars
import ExtsCompat46
@@ -112,78 +110,6 @@ pBox p = Ptr p
pUnbox (Ptr p) = p
castFastPtr p = p
-#else /* ! __GLASGOW_HASKELL__ */
-
-import Data.Char (ord, chr)
-
-import Data.Bits
-import Data.Word (Word) --is it a good idea to assume this exists too?
---does anyone need shiftRLFastInt? (apparently yes.)
-
-import Foreign.Ptr
-
-type FastInt = Int
-_ILIT x = x
-iBox x = x
-iUnbox x = x
-(+#) = (+)
-(-#) = (-)
-(*#) = (*)
-quotFastInt = quot
---quotRemFastInt = quotRem
-negateFastInt = negate
-(==#) = (==)
-(/=#) = (/=)
-(<#) = (<)
-(<=#) = (<=)
-(>=#) = (>=)
-(>#) = (>)
-shiftLFastInt = shiftL
-shiftR_FastInt = shiftR
-shiftRAFastInt = shiftR
-shiftRLFastInt n p = fromIntegral (shiftR (fromIntegral n :: Word) p)
---shiftLFastInt n p = n * (2 ^ p)
---assuming quot-Int is faster and the
---same for nonnegative arguments than div-Int
---shiftR_FastInt n p = n `quot` (2 ^ p)
---shiftRAFastInt n p = n `div` (2 ^ p)
---I couldn't figure out how to implement without Word nor Bits
---shiftRLFastInt n p = fromIntegral ((fromIntegral n :: Word) `quot` (2 ^ (fromIntegral p :: Word)))
-
-bitAndFastInt = (.&.)
-bitOrFastInt = (.|.)
-
-type FastBool = Bool
-fastBool x = x
-isFastTrue x = x
--- make sure these are as strict as the unboxed version,
--- so that the performance characteristics match
-fastOr False False = False
-fastOr _ _ = True
-fastAnd True True = True
-fastAnd _ _ = False
-
-type FastChar = Char
-_CLIT c = c
-cBox c = c
-cUnbox c = c
-fastOrd = ord
-fastChr = chr --or unsafeChr if there was a standard location for it
-eqFastChar = (==)
-
-type FastPtr a = Ptr a
-pBox p = p
-pUnbox p = p
-castFastPtr = castPtr
-
---These are among the type-signatures necessary for !ghc to compile
--- but break ghc (can't give a signature for an import...)
---Note that the comparisons actually do return Bools not FastBools.
-(+#), (-#), (*#) :: FastInt -> FastInt -> FastInt
-(==#), (/=#), (<#), (<=#), (>=#), (>#) :: FastInt -> FastInt -> Bool
-
-#endif /* ! __GLASGOW_HASKELL__ */
-
minFastInt, maxFastInt :: FastInt -> FastInt -> FastInt
minFastInt x y = if x <# y then x else y
maxFastInt x y = if x <# y then y else x
diff --git a/compiler/utils/Pretty.lhs b/compiler/utils/Pretty.lhs
index f6a5a44e2e..0357c8cfba 100644
--- a/compiler/utils/Pretty.lhs
+++ b/compiler/utils/Pretty.lhs
@@ -184,12 +184,10 @@ import Panic
import Numeric (fromRat)
import System.IO
-#if defined(__GLASGOW_HASKELL__)
--for a RULES
import GHC.Base ( unpackCString# )
import GHC.Exts ( Int# )
import GHC.Ptr ( Ptr(..) )
-#endif
-- Don't import Util( assertPanic ) because it makes a loop in the module structure
@@ -556,13 +554,11 @@ ztext :: FastZString -> Doc
ztext s = case iUnbox (lengthFZS s) of {sl -> textBeside_ (ZStr s) sl Empty}
zeroWidthText s = textBeside_ (Str s) (_ILIT(0)) Empty
-#if defined(__GLASGOW_HASKELL__)
-- RULE that turns (text "abc") into (ptext (A# "abc"#)) to avoid the
-- intermediate packing/unpacking of the string.
{-# RULES
"text/str" forall a. text (unpackCString# a) = ptext (Ptr a)
#-}
-#endif
nest k p = mkNest (iUnbox k) (reduceDoc p) -- Externally callable version
diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs
index 999eb90c33..7292b4a4b3 100644
--- a/compiler/utils/Util.lhs
+++ b/compiler/utils/Util.lhs
@@ -737,7 +737,6 @@ matchVectors = snd . foldl' go (0 :: Int, IM.empty)
im' = IM.insertWith (.|.) (ord char) (2 ^ ix) im
in seq ix' $ seq im' $ (ix', im')
-#ifdef __GLASGOW_HASKELL__
{-# SPECIALIZE INLINE restrictedDamerauLevenshteinDistance'
:: Word32 -> Int -> Int -> String -> String -> Int #-}
{-# SPECIALIZE INLINE restrictedDamerauLevenshteinDistance'
@@ -757,7 +756,6 @@ matchVectors = snd . foldl' go (0 :: Int, IM.empty)
{-# SPECIALIZE matchVectors :: String -> IM.IntMap Word32 #-}
{-# SPECIALIZE matchVectors :: String -> IM.IntMap Integer #-}
-#endif
fuzzyMatch :: String -> [String] -> [String]
fuzzyMatch key vals = fuzzyLookup key [(v,v) | v <- vals]
diff --git a/libraries/base/cbits/PrelIOUtils.c b/libraries/base/cbits/PrelIOUtils.c
index 415e6b7a0d..4d569032f3 100644
--- a/libraries/base/cbits/PrelIOUtils.c
+++ b/libraries/base/cbits/PrelIOUtils.c
@@ -1,4 +1,4 @@
-/*
+/*
* (c) The University of Glasgow 2002
*
* static versions of the inline functions in HsBase.h
@@ -6,14 +6,9 @@
#define INLINE
-#ifdef __GLASGOW_HASKELL__
-# include "Rts.h"
-#endif
-
+#include "Rts.h"
#include "HsBase.h"
-#ifdef __GLASGOW_HASKELL__
-
void errorBelch2(const char*s, char *t)
{
errorBelch(s,t);
@@ -48,5 +43,3 @@ const char* localeEncoding(void)
#endif
}
#endif
-
-#endif /* __GLASGOW_HASKELL__ */
diff --git a/testsuite/tests/programs/andy_cherry/GenUtils.hs b/testsuite/tests/programs/andy_cherry/GenUtils.hs
index 3e1de07fb8..8ff67576b5 100644
--- a/testsuite/tests/programs/andy_cherry/GenUtils.hs
+++ b/testsuite/tests/programs/andy_cherry/GenUtils.hs
@@ -9,7 +9,7 @@
module GenUtils (
- trace,
+ trace,
assocMaybe, assocMaybeErr,
arrElem,
@@ -46,15 +46,9 @@ import Debug.Trace ( trace )
-- -------------------------------------------------------------------------
--- 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
-#if defined(__GLASGOW_HASKELL__) || defined(__GOFER__)
-
---in 1.3: data Maybe a = Nothing | Just a deriving (Eq,Ord,Text)
-
-#endif
-
infix 1 =: -- 1.3
type Assoc a b = (a,b) -- 1.3
(=:) a b = (a,b)
@@ -68,10 +62,10 @@ mapMaybe f (a:r) = case f a of
-- This version returns nothing, if *any* one fails.
mapMaybeFail f (x:xs) = case f x of
- Just x' -> case mapMaybeFail f xs of
- Just xs' -> Just (x':xs')
- Nothing -> Nothing
- Nothing -> Nothing
+ Just x' -> case mapMaybeFail f xs of
+ Just xs' -> Just (x':xs')
+ Nothing -> Nothing
+ Nothing -> Nothing
mapMaybeFail f [] = Just []
maybeToBool :: Maybe a -> Bool
@@ -87,7 +81,7 @@ maybeMap f (Just a) = Just (f a)
maybeMap f 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 +89,8 @@ joinMaybe f (Just g) (Just h) = Just (f g h)
data MaybeErr a err = Succeeded a | Failed err deriving (Eq,Show{-was: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
@@ -112,14 +106,14 @@ foldb :: (a -> a -> a) -> [a] -> a
foldb f [] = error "can't reduce an empty list using foldb"
foldb f [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)
@@ -139,9 +133,9 @@ sortWith :: (a -> a -> Bool) -> [a] -> [a]
sortWith le [] = []
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 [] = []
@@ -166,12 +160,12 @@ copy :: Int -> a -> [a] -- make list of n copies of x
copy n x = take n xs where xs = x:xs
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
assocMaybe :: (Eq a) => [(a,b)] -> a -> Maybe b
assocMaybe env k = case [ val | (key,val) <- env, k == key] of
@@ -189,9 +183,9 @@ deSucc (Succeeded e) = e
mapAccumL :: (a -> b -> (c,a)) -> a -> [b] -> ([c],a)
mapAccumL f s [] = ([],s)
mapAccumL f s (b:bs) = (c:cs,s'')
- where
- (c,s') = f s b
- (cs,s'') = mapAccumL f s' bs
+ where
+ (c,s') = f s b
+ (cs,s'') = mapAccumL f s' bs
@@ -200,7 +194,7 @@ mapAccumL f s (b:bs) = (c:cs,s'')
-- 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
size = (maximum obj,minimum obj)
arr = listArray size [ i `elem` obj | i <- range size ]
@@ -209,7 +203,7 @@ arrElem obj = \x -> inRange size x && arr ! x
-- again using arrays, of course. Remember @b@ can be a function !
-- Note again the use of partiual application.
-arrCond :: (Ix a)
+arrCond :: (Ix a)
=> (a,a) -- the bounds
-> [(Assoc [a] b)] -- the simple lookups
-> [(Assoc (a -> Bool) b)] -- the functional lookups
@@ -233,12 +227,12 @@ memoise bds f = (!) arr
formatText :: Int -> [String] -> [String]
formatText n = map unwords . cutAt n []
where
- cutAt :: Int -> [String] -> [String] -> [[String]]
- cutAt m wds [] = [reverse wds]
- cutAt m wds (wd:rest) = if len <= m || null wds
- then cutAt (m-(len+1)) (wd:wds) rest
- else reverse wds : cutAt n [] (wd:rest)
- where len = length wd
+ cutAt :: Int -> [String] -> [String] -> [[String]]
+ cutAt m wds [] = [reverse wds]
+ cutAt m wds (wd:rest) = if len <= m || null wds
+ then cutAt (m-(len+1)) (wd:wds) rest
+ else reverse wds : cutAt n [] (wd:rest)
+ where len = length wd