ghc/lib/ghc/PrelBase.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[PrelBase]{Module @PrelBase@}
   5
   6
   7 \begin{code}
   8 {-# OPTIONS -fno-implicit-prelude #-}
   9
  10 module PrelBase(
  11         module PrelBase,
  12         module GHC              -- Re-export GHC, to avoid lots of people having
  13                                 -- to import it explicitly
  14   ) where
  15
  16 import {-# SOURCE #-}   IOBase  ( error )
  17 import GHC
  18
  19 infixr 9  ., !!
  20 infixl 7  *
  21 infixl 6  +, -
  22 infixr 5  ++, :
  23 infix  4  ==, /=, <, <=, >=, >
  24 infixr 3  &&
  25 infixr 2  ||
  26 infixr 1  >>, >>=
  27 infixr 0  $
  28 \end{code}
  29
  30 %*********************************************************
  31 %*                                                      *
  32 \subsection{Standard classes @Eq@, @Ord@, @Bounded@, @Eval@}
  33 %*                                                      *
  34 %*********************************************************
  35
  36 \begin{code}
  37 class  Eq a  where
  38     (==), (/=)          :: a -> a -> Bool
  39
  40     x /= y              =  not (x == y)
  41
  42 class  (Eq a) => Ord a  where
  43     compare             :: a -> a -> Ordering
  44     (<), (<=), (>=), (>):: a -> a -> Bool
  45     max, min            :: a -> a -> a
  46
  47 -- An instance of Ord should define either compare or <=
  48 -- Using compare can be more efficient for complex types.
  49     compare x y
  50             | x == y    = EQ
  51             | x <= y    = LT
  52             | otherwise = GT
  53
  54     x <= y  = compare x y /= GT
  55     x <  y  = compare x y == LT
  56     x >= y  = compare x y /= LT
  57     x >  y  = compare x y == GT
  58     max x y = case (compare x y) of { LT -> y ; EQ -> x ; GT -> x }
  59     min x y = case (compare x y) of { LT -> x ; EQ -> x ; GT -> y }
  60
  61 class  Bounded a  where
  62     minBound, maxBound :: a
  63
  64 class Eval a
  65 \end{code}
  66
  67 %*********************************************************
  68 %*                                                      *
  69 \subsection{Monadic classes @Functor@, @Monad@, @MonadZero@, @MonadPlus@}
  70 %*                                                      *
  71 %*********************************************************
  72
  73 \begin{code}
  74 class  Functor f  where
  75     map         :: (a -> b) -> f a -> f b
  76
  77 class  Monad m  where
  78     (>>=)       :: m a -> (a -> m b) -> m b
  79     (>>)        :: m a -> m b -> m b
  80     return      :: a -> m a
  81
  82     m >> k      =  m >>= \_ -> k
  83
  84 class  (Monad m) => MonadZero m  where
  85     zero        :: m a
  86
  87 class  (MonadZero m) => MonadPlus m where
  88    (++)         :: m a -> m a -> m a
  89 \end{code}
  90
  91
  92 %*********************************************************
  93 %*                                                      *
  94 \subsection{Classes @Num@ and @Enum@}
  95 %*                                                      *
  96 %*********************************************************
  97
  98 \begin{code}
  99 class  Enum a   where
 100     toEnum              :: Int -> a
 101     fromEnum            :: a -> Int
 102     enumFrom            :: a -> [a]             -- [n..]
 103     enumFromThen        :: a -> a -> [a]        -- [n,n'..]
 104     enumFromTo          :: a -> a -> [a]        -- [n..m]
 105     enumFromThenTo      :: a -> a -> a -> [a]   -- [n,n'..m]
 106
 107     enumFromTo n m      =  map toEnum [fromEnum n .. fromEnum m]
 108     enumFromThenTo n n' m
 109                         =  map toEnum [fromEnum n, fromEnum n' .. fromEnum m]
 110
 111 class  (Eq a, Show a, Eval a) => Num a  where
 112     (+), (-), (*)       :: a -> a -> a
 113     negate              :: a -> a
 114     abs, signum         :: a -> a
 115     fromInteger         :: Integer -> a
 116     fromInt             :: Int -> a -- partain: Glasgow extension
 117
 118     x - y               =  x + negate y
 119     fromInt (I# i#)     = fromInteger (int2Integer# i#)
 120                                         -- Go via the standard class-op if the
 121                                         -- non-standard one ain't provided
 122 \end{code}
 123
 124 \begin{code}
 125 succ, pred              :: Enum a => a -> a
 126 succ                    =  toEnum . (+1) . fromEnum
 127 pred                    =  toEnum . (subtract 1) . fromEnum
 128
 129 chr = (toEnum   :: Int  -> Char)
 130 ord = (fromEnum :: Char -> Int)
 131
 132 ord_0 :: Num a => a
 133 ord_0 = fromInt (ord '0')
 134
 135 {-# GENERATE_SPECS subtract a{Int#,Double#,Int,Double,Complex(Double#),Complex(Double)} #-}
 136 subtract        :: (Num a) => a -> a -> a
 137 subtract x y    =  y - x
 138 \end{code}
 139
 140
 141 %*********************************************************
 142 %*                                                      *
 143 \subsection{The @Show@ class}
 144 %*                                                      *
 145 %*********************************************************
 146
 147 \begin{code}
 148 type  ShowS     = String -> String
 149
 150 class  Show a  where
 151     showsPrec :: Int -> a -> ShowS
 152     showList  :: [a] -> ShowS
 153
 154     showList ls = showList__ (showsPrec 0) ls
 155 \end{code}
 156
 157 %*********************************************************
 158 %*                                                      *
 159 \subsection{The list type}
 160 %*                                                      *
 161 %*********************************************************
 162
 163 \begin{code}
 164 data [] a = [] | a : [a]  -- do explicitly: deriving (Eq, Ord)
 165                           -- to avoid weird names like con2tag_[]#
 166
 167 instance (Eq a) => Eq [a]  where
 168     []     == []     = True
 169     (x:xs) == (y:ys) = x == y && xs == ys
 170     xs     == ys     = False
 171     xs     /= ys     = if (xs == ys) then False else True
 172
 173 instance (Ord a) => Ord [a] where
 174     a <  b  = case compare a b of { LT -> True;  EQ -> False; GT -> False }
 175     a <= b  = case compare a b of { LT -> True;  EQ -> True;  GT -> False }
 176     a >= b  = case compare a b of { LT -> False; EQ -> True;  GT -> True  }
 177     a >  b  = case compare a b of { LT -> False; EQ -> False; GT -> True  }
 178
 179     max a b = case compare a b of { LT -> b; EQ -> a;  GT -> a }
 180     min a b = case compare a b of { LT -> a; EQ -> a;  GT -> b }
 181
 182     compare []     []     = EQ
 183     compare (x:xs) []     = GT
 184     compare []     (y:ys) = LT
 185     compare (x:xs) (y:ys) = case compare x y of
 186                                  LT -> LT
 187                                  GT -> GT
 188                                  EQ -> compare xs ys
 189
 190 instance Functor [] where
 191     map f []             =  []
 192     map f (x:xs)         =  f x : map f xs
 193
 194 instance  Monad []  where
 195     m >>= k             = foldr ((++) . k) [] m
 196     m >> k              = foldr ((++) . (\ _ -> k)) [] m
 197     return x            = [x]
 198
 199 instance  MonadZero []  where
 200     zero                = []
 201
 202 instance  MonadPlus []  where
 203 #ifdef USE_REPORT_PRELUDE
 204     xs ++ ys            =  foldr (:) ys xs
 205 #else
 206     [] ++ ys            =  ys
 207     (x:xs) ++ ys        =  x : (xs ++ ys)
 208 #endif
 209
 210 instance  (Show a) => Show [a]  where
 211     showsPrec p         = showList
 212     showList  ls        = showList__ (showsPrec 0) ls
 213 \end{code}
 214
 215 \end{code}
 216
 217 A few list functions that appear here because they are used here.
 218 The rest of the prelude list functions are in PrelList.
 219
 220 \begin{code}
 221 foldr                   :: (a -> b -> b) -> b -> [a] -> b
 222 foldr f z []            =  z
 223 foldr f z (x:xs)        =  f x (foldr f z xs)
 224
 225 -- takeWhile, applied to a predicate p and a list xs, returns the longest
 226 -- prefix (possibly empty) of xs of elements that satisfy p.  dropWhile p xs
 227 -- returns the remaining suffix.  Span p xs is equivalent to
 228 -- (takeWhile p xs, dropWhile p xs), while break p uses the negation of p.
 229
 230 takeWhile               :: (a -> Bool) -> [a] -> [a]
 231 takeWhile p []          =  []
 232 takeWhile p (x:xs)
 233             | p x       =  x : takeWhile p xs
 234             | otherwise =  []
 235
 236 dropWhile               :: (a -> Bool) -> [a] -> [a]
 237 dropWhile p []          =  []
 238 dropWhile p xs@(x:xs')
 239             | p x       =  dropWhile p xs'
 240             | otherwise =  xs
 241
 242 -- List index (subscript) operator, 0-origin
 243 (!!)                    :: [a] -> Int -> a
 244 #ifdef USE_REPORT_PRELUDE
 245 (x:_)  !! 0             =  x
 246 (_:xs) !! n | n > 0     =  xs !! (n-1)
 247 (_:_)  !! _             =  error "PreludeList.!!: negative index"
 248 []     !! _             =  error "PreludeList.!!: index too large"
 249 #else
 250 -- HBC version (stolen), then unboxified
 251 -- The semantics is not quite the same for error conditions
 252 -- in the more efficient version.
 253 --
 254 _      !! n | n < 0  =  error "(!!){PreludeList}: negative index\n"
 255 xs     !! n          =  sub xs (case n of { I# n# -> n# })
 256                            where sub :: [a] -> Int# -> a
 257                                  sub []      _ = error "(!!){PreludeList}: index too large\n"
 258                                  sub (x:xs) n# = if n# ==# 0#
 259                                                  then x
 260                                                  else sub xs (n# -# 1#)
 261 #endif
 262 \end{code}
 263
 264
 265 %*********************************************************
 266 %*                                                      *
 267 \subsection{Type @Void@}
 268 %*                                                      *
 269 %*********************************************************
 270
 271 The type @Void@ is built in, but it needs a @Show@ instance.
 272
 273 \begin{code}
 274 void :: Void
 275 void = error "You tried to evaluate void"
 276
 277 instance  Show Void  where
 278     showsPrec p f  =  showString "<<void>>"
 279     showList ls    = showList__ (showsPrec 0) ls
 280 \end{code}
 281
 282
 283 %*********************************************************
 284 %*                                                      *
 285 \subsection{Type @Bool@}
 286 %*                                                      *
 287 %*********************************************************
 288
 289 \begin{code}
 290 data  Bool  =  False | True     deriving (Eq, Ord, Enum, Bounded, Show {- Read -})
 291
 292 -- Boolean functions
 293
 294 (&&), (||)              :: Bool -> Bool -> Bool
 295 True  && x              =  x
 296 False && x              =  False
 297 True  || x              =  True
 298 False || x              =  x
 299
 300 not                     :: Bool -> Bool
 301 not True                =  False
 302 not False               =  True
 303
 304 otherwise               :: Bool
 305 otherwise               =  True
 306 \end{code}
 307
 308
 309 %*********************************************************
 310 %*                                                      *
 311 \subsection{Type @Maybe@}
 312 %*                                                      *
 313 %*********************************************************
 314
 315 \begin{code}
 316 data  Maybe a  =  Nothing | Just a      deriving (Eq, Ord, Show {- Read -})
 317
 318 maybe :: b -> (a -> b) -> Maybe a -> b
 319 maybe n f Nothing  = n
 320 maybe n f (Just x) = f x
 321
 322 instance  Functor Maybe  where
 323     map f Nothing       = Nothing
 324     map f (Just a)      = Just (f a)
 325
 326 instance  Monad Maybe  where
 327     (Just x) >>= k      = k x
 328     Nothing  >>= k      = Nothing
 329
 330     (Just x) >>  k      = k
 331     Nothing  >>  k      = Nothing
 332
 333     return              = Just
 334
 335 instance  MonadZero Maybe  where
 336     zero                = Nothing
 337
 338 instance  MonadPlus Maybe  where
 339     Nothing ++ ys       = ys
 340     xs      ++ ys       = xs
 341 \end{code}
 342
 343
 344 %*********************************************************
 345 %*                                                      *
 346 \subsection{The @()@ type}
 347 %*                                                      *
 348 %*********************************************************
 349
 350 The Unit type is here because virtually any program needs it (whereas
 351 some programs may get away without consulting PrelTup).  Furthermore,
 352 the renamer currently *always* asks for () to be in scope, so that
 353 ccalls can use () as their default type; so when compiling PrelBase we
 354 need ().  (We could arrange suck in () only if -fglasgow-exts, but putting
 355 it here seems more direct.
 356
 357 \begin{code}
 358 data  ()  =  ()  --easier to do explicitly: deriving (Eq, Ord, Enum, Show, Bounded)
 359                  -- (avoids weird-named functions, e.g., con2tag_()#
 360 instance Eq () where
 361     () == () = True
 362     () /= () = False
 363
 364 instance Ord () where
 365     () <= () = True
 366     () <  () = False
 367     () >= () = True
 368     () >  () = False
 369     max () () = ()
 370     min () () = ()
 371     compare () () = EQ
 372
 373 instance Enum () where
 374     toEnum 0    = ()
 375     toEnum _    = error "Prelude.Enum.().toEnum: argument not 0"
 376     fromEnum () = 0
 377     enumFrom ()         = [()]
 378     enumFromThen () ()  = [()]
 379     enumFromTo () ()    = [()]
 380     enumFromThenTo () () () = [()]
 381
 382 instance Bounded () where
 383     minBound = ()
 384     maxBound = ()
 385
 386 instance  Show ()  where
 387     showsPrec p () = showString "()"
 388     showList ls    = showList__ (showsPrec 0) ls
 389 \end{code}
 390
 391 %*********************************************************
 392 %*                                                      *
 393 \subsection{Type @Either@}
 394 %*                                                      *
 395 %*********************************************************
 396
 397 \begin{code}
 398 data  Either a b  =  Left a | Right b   deriving (Eq, Ord, Show {- Read -} )
 399
 400 either                  :: (a -> c) -> (b -> c) -> Either a b -> c
 401 either f g (Left x)     =  f x
 402 either f g (Right y)    =  g y
 403 \end{code}
 404
 405
 406 %*********************************************************
 407 %*                                                      *
 408 \subsection{Type @Ordering@}
 409 %*                                                      *
 410 %*********************************************************
 411
 412 \begin{code}
 413 data Ordering = LT | EQ | GT    deriving (Eq, Ord, Enum, Bounded, Show {- Read -})
 414 \end{code}
 415
 416
 417 %*********************************************************
 418 %*                                                      *
 419 \subsection{Type @Char@ and @String@}
 420 %*                                                      *
 421 %*********************************************************
 422
 423 \begin{code}
 424 type  String = [Char]
 425
 426 data Char = C# Char#    deriving (Eq, Ord)
 427
 428 instance  Enum Char  where
 429     toEnum   (I# i) | i >=# 0# && i <=# 255# =  C# (chr# i)
 430                     | otherwise = error ("Prelude.Enum.Char.toEnum:out of range: " ++ show (I# i))
 431     fromEnum (C# c)              =  I# (ord# c)
 432
 433     enumFrom   (C# c)          =  efttCh (ord# c)  1#   (># 255#)
 434     enumFromTo (C# c1) (C# c2) = efttCh (ord# c1) 1#  (># (ord# c2))
 435
 436     enumFromThen (C# c1) (C# c2)
 437         | c1 `leChar#` c2 = efttCh (ord# c1) (ord# c2 -# ord# c1) (># 255#)
 438         | otherwise       = efttCh (ord# c1) (ord# c2 -# ord# c1) (<# 0#)
 439
 440     enumFromThenTo (C# c1) (C# c2) (C# c3)
 441         | c1 `leChar#` c2 = efttCh (ord# c1) (ord# c2 -# ord# c1) (># (ord# c3))
 442         | otherwise       = efttCh (ord# c1) (ord# c2 -# ord# c1) (<# (ord# c3))
 443
 444 efttCh :: Int# -> Int# -> (Int# -> Bool) -> [Char]
 445 efttCh now step done
 446   = go now
 447   where
 448     go now | done now  = []
 449            | otherwise = C# (chr# now) : go (now +# step)
 450
 451 instance  Bounded Char  where
 452     minBound            =  '\0'
 453     maxBound            =  '\255'
 454
 455 instance  Show Char  where
 456     showsPrec p '\'' = showString "'\\''"
 457     showsPrec p c    = showChar '\'' . showLitChar c . showChar '\''
 458
 459     showList cs = showChar '"' . showl cs
 460                  where showl ""       = showChar '"'
 461                        showl ('"':cs) = showString "\\\"" . showl cs
 462                        showl (c:cs)   = showLitChar c . showl cs
 463 \end{code}
 464
 465
 466 \begin{code}
 467 isAscii, isLatin1, isControl, isPrint, isSpace, isUpper,
 468  isLower, isAlpha, isDigit, isOctDigit, isHexDigit, isAlphanum :: Char -> Bool
 469 isAscii c               =  fromEnum c < 128
 470 isLatin1 c              =  c <= '\xff'
 471 isControl c             =  c < ' ' || c >= '\DEL' && c <= '\x9f'
 472 isPrint c               =  not (isControl c)
 473
 474 -- isSpace includes non-breaking space
 475 -- Done with explicit equalities both for efficiency, and to avoid a tiresome
 476 -- recursion with PrelList elem
 477 isSpace c               =  c == ' '     ||
 478                            c == '\t'    ||
 479                            c == '\n'    ||
 480                            c == '\r'    ||
 481                            c == '\f'    ||
 482                            c == '\v'    ||
 483                            c == '\xa0'
 484
 485 -- The upper case ISO characters have the multiplication sign dumped
 486 -- randomly in the middle of the range.  Go figure.
 487 isUpper c               =  c >= 'A' && c <= 'Z' ||
 488                            c >= '\xC0' && c <= '\xD6' ||
 489                            c >= '\xD8' && c <= '\xDE'
 490 -- The lower case ISO characters have the division sign dumped
 491 -- randomly in the middle of the range.  Go figure.
 492 isLower c               =  c >= 'a' && c <= 'z' ||
 493                            c >= '\xDF' && c <= '\xF6' ||
 494                            c >= '\xF8' && c <= '\xFF'
 495 isAlpha c               =  isLower c || isUpper c
 496 isDigit c               =  c >= '0' && c <= '9'
 497 isOctDigit c            =  c >= '0' && c <= '7'
 498 isHexDigit c            =  isDigit c || c >= 'A' && c <= 'F' ||
 499                                         c >= 'a' && c <= 'f'
 500 isAlphanum c            =  isAlpha c || isDigit c
 501
 502 -- Case-changing operations
 503
 504 toUpper, toLower        :: Char -> Char
 505 toUpper c | isLower c   && c /= '\xDF' && c /= '\xFF'
 506  =  toEnum (fromEnum c - fromEnum 'a' + fromEnum 'A')
 507   | otherwise   =  c
 508
 509 toLower c | isUpper c   =  toEnum (fromEnum c - fromEnum 'A'
 510                                               + fromEnum 'a')
 511           | otherwise   =  c
 512
 513 asciiTab = -- Using an array drags in the array module.  listArray ('\NUL', ' ')
 514            ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL",
 515             "BS",  "HT",  "LF",  "VT",  "FF",  "CR",  "SO",  "SI",
 516             "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB",
 517             "CAN", "EM",  "SUB", "ESC", "FS",  "GS",  "RS",  "US",
 518             "SP"]
 519 \end{code}
 520
 521 %*********************************************************
 522 %*                                                      *
 523 \subsection{Type @Int@}
 524 %*                                                      *
 525 %*********************************************************
 526
 527 \begin{code}
 528 data Int = I# Int#
 529
 530 instance Eq Int where
 531     (==) x y = x `eqInt` y
 532     (/=) x y = x `neInt` y
 533
 534 instance Ord Int where
 535     compare x y = compareInt x y
 536
 537     (<)  x y = ltInt x y
 538     (<=) x y = leInt x y
 539     (>=) x y = geInt x y
 540     (>)  x y = gtInt x y
 541     max x y = case (compareInt x y) of { LT -> y ; EQ -> x ; GT -> x }
 542     min x y = case (compareInt x y) of { LT -> x ; EQ -> x ; GT -> y }
 543
 544 (I# x) `compareInt` (I# y) | x <# y    = LT
 545                            | x ==# y   = EQ
 546                            | otherwise = GT
 547
 548 instance  Enum Int  where
 549     toEnum   x = x
 550     fromEnum x = x
 551
 552 #ifndef USE_FOLDR_BUILD
 553     enumFrom     (I# c)          = eftInt c  1#
 554     enumFromTo   (I# c1) (I# c2) = efttInt c1 1#  (># c2)
 555     enumFromThen (I# c1) (I# c2) = eftInt c1 (c2 -# c1)
 556
 557     enumFromThenTo (I# c1) (I# c2) (I# c3)
 558         | c1 <=# c2 = efttInt c1 (c2 -# c1) (># c3)
 559         | otherwise = efttInt c1 (c2 -# c1) (<# c3)
 560
 561 #else
 562     {-# INLINE enumFrom #-}
 563     {-# INLINE enumFromTo #-}
 564     enumFrom x           = build (\ c _ ->
 565         let g x = x `c` g (x `plusInt` 1) in g x)
 566     enumFromTo x y       = build (\ c n ->
 567         let g x = if x <= y then x `c` g (x `plusInt` 1) else n in g x)
 568 #endif
 569
 570 efttInt :: Int# -> Int# -> (Int# -> Bool) -> [Int]
 571 efttInt now step done
 572   = go now
 573   where
 574     go now | done now  = []
 575            | otherwise = I# now : go (now +# step)
 576
 577 eftInt :: Int# -> Int# -> [Int]
 578 eftInt now step
 579   = go now
 580   where
 581     go now = I# now : go (now +# step)
 582
 583
 584 instance  Bounded Int where
 585     minBound =  negate 2147483647   -- **********************
 586     maxBound =  2147483647          -- **********************
 587
 588 instance  Num Int  where
 589     (+)    x y =  plusInt x y
 590     (-)    x y =  minusInt x y
 591     negate x   =  negateInt x
 592     (*)    x y =  timesInt x y
 593     abs    n   = if n `geInt` 0 then n else (negateInt n)
 594
 595     signum n | n `ltInt` 0 = negateInt 1
 596              | n `eqInt` 0 = 0
 597              | otherwise   = 1
 598
 599     fromInteger (J# a# s# d#)
 600       = case (integer2Int# a# s# d#) of { i# -> I# i# }
 601
 602     fromInt n           = n
 603
 604 instance  Show Int  where
 605     showsPrec p n = showSignedInt p n
 606     showList ls   = showList__ (showsPrec 0)  ls
 607 \end{code}
 608
 609
 610 %*********************************************************
 611 %*                                                      *
 612 \subsection{Type @Integer@, @Float@, @Double@}
 613 %*                                                      *
 614 %*********************************************************
 615
 616 Just the type declarations.  If we don't actually use any @Integers@ we'd
 617 rather not link the @Integer@ module at all; and the default-decl stuff
 618 in the renamer tends to slurp in @Double@ regardless.
 619
 620 \begin{code}
 621 data Float      = F# Float#
 622 data Double     = D# Double#
 623 data Integer    = J# Int# Int# ByteArray#
 624 \end{code}
 625
 626
 627 %*********************************************************
 628 %*                                                      *
 629 \subsection{The function type}
 630 %*                                                      *
 631 %*********************************************************
 632
 633 \begin{code}
 634 instance  Show (a -> b)  where
 635     showsPrec p f  =  showString "<<function>>"
 636     showList ls    = showList__ (showsPrec 0) ls
 637
 638
 639 -- identity function
 640 id                      :: a -> a
 641 id x                    =  x
 642
 643 -- constant function
 644 const                   :: a -> b -> a
 645 const x _               =  x
 646
 647 -- function composition
 648 {-# INLINE (.) #-}
 649 {-# GENERATE_SPECS (.) a b c #-}
 650 (.)       :: (b -> c) -> (a -> b) -> a -> c
 651 (.) f g x = f (g x)
 652
 653 -- flip f  takes its (first) two arguments in the reverse order of f.
 654 flip                    :: (a -> b -> c) -> b -> a -> c
 655 flip f x y              =  f y x
 656
 657 -- right-associating infix application operator (useful in continuation-
 658 -- passing style)
 659 ($)                     :: (a -> b) -> a -> b
 660 f $ x                   =  f x
 661
 662 -- until p f  yields the result of applying f until p holds.
 663 until                   :: (a -> Bool) -> (a -> a) -> a -> a
 664 until p f x | p x       =  x
 665             | otherwise =  until p f (f x)
 666
 667 -- asTypeOf is a type-restricted version of const.  It is usually used
 668 -- as an infix operator, and its typing forces its first argument
 669 -- (which is usually overloaded) to have the same type as the second.
 670 asTypeOf                :: a -> a -> a
 671 asTypeOf                =  const
 672 \end{code}
 673
 674
 675 %*********************************************************
 676 %*                                                      *
 677 \subsection{Miscellaneous}
 678 %*                                                      *
 679 %*********************************************************
 680
 681
 682 \begin{code}
 683 data Lift a = Lift a
 684 {-# GENERATE_SPECS data a :: Lift a #-}
 685 \end{code}
 686
 687
 688
 689
 690 %*********************************************************
 691 %*                                                      *
 692 \subsection{Support code for @Show@}
 693 %*                                                      *
 694 %*********************************************************
 695
 696 \begin{code}
 697 shows           :: (Show a) => a -> ShowS
 698 shows           =  showsPrec 0
 699
 700 show            :: (Show a) => a -> String
 701 show x          =  shows x ""
 702
 703 showChar        :: Char -> ShowS
 704 showChar        =  (:)
 705
 706 showString      :: String -> ShowS
 707 showString      =  (++)
 708
 709 showParen       :: Bool -> ShowS -> ShowS
 710 showParen b p   =  if b then showChar '(' . p . showChar ')' else p
 711
 712 {-# GENERATE_SPECS showList__ a #-}
 713 showList__ :: (a -> ShowS) ->  [a] -> ShowS
 714
 715 showList__ showx []     = showString "[]"
 716 showList__ showx (x:xs) = showChar '[' . showx x . showl xs
 717   where
 718     showl []     = showChar ']'
 719     showl (x:xs) = showString ", " . showx x . showl xs
 720
 721 showSpace :: ShowS
 722 showSpace = {-showChar ' '-} \ xs -> ' ' : xs
 723 \end{code}
 724
 725 Code specific for characters
 726
 727 \begin{code}
 728 showLitChar                :: Char -> ShowS
 729 showLitChar c | c > '\DEL' =  showChar '\\' . protectEsc isDigit (shows (ord c))
 730 showLitChar '\DEL'         =  showString "\\DEL"
 731 showLitChar '\\'           =  showString "\\\\"
 732 showLitChar c | c >= ' '   =  showChar c
 733 showLitChar '\a'           =  showString "\\a"
 734 showLitChar '\b'           =  showString "\\b"
 735 showLitChar '\f'           =  showString "\\f"
 736 showLitChar '\n'           =  showString "\\n"
 737 showLitChar '\r'           =  showString "\\r"
 738 showLitChar '\t'           =  showString "\\t"
 739 showLitChar '\v'           =  showString "\\v"
 740 showLitChar '\SO'          =  protectEsc (== 'H') (showString "\\SO")
 741 showLitChar c              =  showString ('\\' : asciiTab!!ord c)
 742
 743 protectEsc p f             = f . cont
 744                              where cont s@(c:_) | p c = "\\&" ++ s
 745                                    cont s             = s
 746
 747 intToDigit :: Int -> Char
 748 intToDigit i
 749  | i >= 0  && i <=  9   =  toEnum (fromEnum '0' + i)
 750  | i >= 10 && i <= 15   =  toEnum (fromEnum 'a' + i -10)
 751  | otherwise            =  error "Char.intToDigit: not a digit" -- ....
 752
 753 \end{code}
 754
 755 Code specific for Ints.
 756
 757 \begin{code}
 758 showSignedInt :: Int -> Int -> ShowS
 759 showSignedInt p (I# n) r
 760   = -- from HBC version; support code follows
 761     if n <# 0# && p > 6 then '(':itos n++(')':r) else itos n ++ r
 762
 763 itos :: Int# -> String
 764 itos n =
 765     if n <# 0# then
 766         if negateInt# n <# 0# then
 767             -- n is minInt, a difficult number
 768             itos (n `quotInt#` 10#) ++ itos' (negateInt# (n `remInt#` 10#)) []
 769         else
 770             '-':itos' (negateInt# n) []
 771     else
 772         itos' n []
 773   where
 774     itos' :: Int# -> String -> String
 775     itos' n cs =
 776         if n <# 10# then
 777             C# (chr# (n +# ord# '0'#)) : cs
 778         else
 779             itos' (n `quotInt#` 10#) (C# (chr# (n `remInt#` 10# +# ord# '0'#)) : cs)
 780 \end{code}
 781
 782 %*********************************************************
 783 %*                                                      *
 784 \subsection{Numeric primops}
 785 %*                                                      *
 786 %*********************************************************
 787
 788 Definitions of the boxed PrimOps; these will be
 789 used in the case of partial applications, etc.
 790
 791 \begin{code}
 792 {-# INLINE eqInt #-}
 793 {-# INLINE neInt #-}
 794
 795 plusInt (I# x) (I# y) = I# (x +# y)
 796 minusInt(I# x) (I# y) = I# (x -# y)
 797 timesInt(I# x) (I# y) = I# (x *# y)
 798 quotInt (I# x) (I# y) = I# (quotInt# x y)
 799 remInt  (I# x) (I# y) = I# (remInt# x y)
 800 negateInt (I# x)      = I# (negateInt# x)
 801 gtInt   (I# x) (I# y) = x ># y
 802 geInt   (I# x) (I# y) = x >=# y
 803 eqInt   (I# x) (I# y) = x ==# y
 804 neInt   (I# x) (I# y) = x /=# y
 805 ltInt   (I# x) (I# y) = x <# y
 806 leInt   (I# x) (I# y) = x <=# y
 807 \end{code}