ghc/lib/std/PrelBase.lhs

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