PrelBase.lhs 22.8 KB
Newer Older
1
2
3
4
5
6
7
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
%
\section[PrelBase]{Module @PrelBase@}


\begin{code}
8
9
{-# OPTIONS -fno-implicit-prelude #-}

sof's avatar
sof committed
10
11
module PrelBase(
	module PrelBase,
12
13
	module PrelGHC		-- Re-export PrelGHC, to avoid lots of people 
				-- having to import it explicitly
sof's avatar
sof committed
14
  ) where
15

16
17
import {-# SOURCE #-} PrelErr ( error )
import PrelGHC
18

sof's avatar
sof committed
19
20
infixr 9  .
infixl 9  !!
21
infixl 7  *
22
23
24
25
26
infixl 6  +, -
infixr 5  ++, :
infix  4  ==, /=, <, <=, >=, >
infixr 3  &&
infixr 2  ||
sof's avatar
sof committed
27
infixl 1  >>, >>=
28
29
30
infixr 0  $
\end{code}

31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131

\begin{code}
{-
class Eval a
data Bool = False | True
data Int = I# Int#
data Double	= D# Double#
data  ()  =  ()  --easier to do explicitly: deriving (Eq, Ord, Enum, Show, Bounded)
		 -- (avoids weird-named functions, e.g., con2tag_()#

data  Maybe a  =  Nothing | Just a	
data Ordering = LT | EQ | GT	 deriving( Eq )

type  String = [Char]

data Char = C# Char#	
data [] a = [] | a : [a]  -- do explicitly: deriving (Eq, Ord)
			  -- to avoid weird names like con2tag_[]#


-------------- Stage 2 -----------------------
not True = False
not False = True
True  && x		=  x
False && x		=  False
otherwise = True

maybe :: b -> (a -> b) -> Maybe a -> b
maybe n f Nothing  = n
maybe n f (Just x) = f x

-------------- Stage 3 -----------------------
class  Eq a  where
    (==), (/=)		:: a -> a -> Bool

    x /= y		=  not (x == y)

-- f :: Eq a => a -> a -> Bool
f x y = x == y

g :: Eq a => a -> a -> Bool
g x y =  f x y 

-------------- Stage 4 -----------------------

class  (Eq a) => Ord a  where
    compare             :: a -> a -> Ordering
    (<), (<=), (>=), (>):: a -> a -> Bool
    max, min		:: a -> a -> a

-- An instance of Ord should define either compare or <=
-- Using compare can be more efficient for complex types.
    compare x y
	    | x == y    = EQ
	    | x <= y    = LT
	    | otherwise = GT

    x <= y  = compare x y /= GT
    x <	 y  = compare x y == LT
    x >= y  = compare x y /= LT
    x >	 y  = compare x y == GT
    max x y = case (compare x y) of { LT -> y ; EQ -> x ; GT -> x }
    min x y = case (compare x y) of { LT -> x ; EQ -> x ; GT -> y }

eqInt	(I# x) (I# y) = x ==# y

instance Eq Int where
    (==) x y = x `eqInt` y

instance Ord Int where
    compare x y = error "help"
  
class  Bounded a  where
    minBound, maxBound :: a


type  ShowS     = String -> String

class  Show a  where
    showsPrec :: Bool -> a -> ShowS
    showList  :: [a] -> ShowS

    showList ls = showList__ (showsPrec True) ls 

showList__ :: (a -> ShowS) ->  [a] -> ShowS
showList__ showx []     = showString "[]"

showString      :: String -> ShowS
showString      =  (++)

[] ++ [] = []

shows           :: (Show a) => a -> ShowS
shows           =  showsPrec True

-- show            :: (Show a) => a -> String
--show x          =  shows x ""
-}
\end{code}


132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
%*********************************************************
%*							*
\subsection{Standard classes @Eq@, @Ord@, @Bounded@, @Eval@}
%*							*
%*********************************************************

\begin{code}
class  Eq a  where
    (==), (/=)		:: a -> a -> Bool

    x /= y		=  not (x == y)

class  (Eq a) => Ord a  where
    compare             :: a -> a -> Ordering
    (<), (<=), (>=), (>):: a -> a -> Bool
    max, min		:: a -> a -> a

-- An instance of Ord should define either compare or <=
-- Using compare can be more efficient for complex types.
    compare x y
	    | x == y    = EQ
	    | x <= y    = LT
	    | otherwise = GT

    x <= y  = compare x y /= GT
    x <	 y  = compare x y == LT
    x >= y  = compare x y /= LT
    x >	 y  = compare x y == GT
    max x y = case (compare x y) of { LT -> y ; EQ -> x ; GT -> x }
    min x y = case (compare x y) of { LT -> x ; EQ -> x ; GT -> y }

class  Bounded a  where
    minBound, maxBound :: a

class Eval a
\end{code}

%*********************************************************
%*							*
\subsection{Monadic classes @Functor@, @Monad@, @MonadZero@, @MonadPlus@}
%*							*
%*********************************************************

\begin{code}
class  Functor f  where
    map         :: (a -> b) -> f a -> f b

class  Monad m  where
    (>>=)       :: m a -> (a -> m b) -> m b
    (>>)        :: m a -> m b -> m b
    return      :: a -> m a

    m >> k      =  m >>= \_ -> k

class  (Monad m) => MonadZero m  where
    zero        :: m a

class  (MonadZero m) => MonadPlus m where
   (++)         :: m a -> m a -> m a
\end{code}


%*********************************************************
%*							*
\subsection{Classes @Num@ and @Enum@}
%*							*
%*********************************************************

\begin{code}
sof's avatar
sof committed
201
class  Enum a	where
202
203
204
205
206
207
208
    toEnum              :: Int -> a
    fromEnum            :: a -> Int
    enumFrom		:: a -> [a]		-- [n..]
    enumFromThen	:: a -> a -> [a]	-- [n,n'..]
    enumFromTo		:: a -> a -> [a]	-- [n..m]
    enumFromThenTo	:: a -> a -> a -> [a]	-- [n,n'..m]

sof's avatar
sof committed
209
    enumFromTo n m      =  map toEnum [fromEnum n .. fromEnum m]
210
    enumFromThenTo n n' m
sof's avatar
sof committed
211
                        =  map toEnum [fromEnum n, fromEnum n' .. fromEnum m]
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226

class  (Eq a, Show a, Eval a) => Num a  where
    (+), (-), (*)	:: a -> a -> a
    negate		:: a -> a
    abs, signum		:: a -> a
    fromInteger		:: Integer -> a
    fromInt		:: Int -> a -- partain: Glasgow extension

    x - y		=  x + negate y
    fromInt (I# i#)	= fromInteger (int2Integer# i#)
					-- Go via the standard class-op if the
					-- non-standard one ain't provided
\end{code}

\begin{code}
sof's avatar
sof committed
227
228
{-# SPECIALISE succ :: Int -> Int #-}
{-# SPECIALISE pred :: Int -> Int #-}
229
230
231
232
233
234
235
236
237
238
succ, pred              :: Enum a => a -> a
succ                    =  toEnum . (+1) . fromEnum
pred                    =  toEnum . (subtract 1) . fromEnum

chr = (toEnum   :: Int  -> Char)
ord = (fromEnum :: Char -> Int)

ord_0 :: Num a => a
ord_0 = fromInt (ord '0')

239
{-# SPECIALISE subtract :: Int -> Int -> Int #-}
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
subtract	:: (Num a) => a -> a -> a
subtract x y	=  y - x
\end{code}


%*********************************************************
%*							*
\subsection{The @Show@ class}
%*							*
%*********************************************************

\begin{code}
type  ShowS     = String -> String

class  Show a  where
    showsPrec :: Int -> a -> ShowS
    showList  :: [a] -> ShowS

sof's avatar
sof committed
258
    showList ls = showList__ (showsPrec 0) ls 
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
\end{code}

%*********************************************************
%*							*
\subsection{The list type}
%*							*
%*********************************************************

\begin{code}
data [] a = [] | a : [a]  -- do explicitly: deriving (Eq, Ord)
			  -- to avoid weird names like con2tag_[]#

instance (Eq a) => Eq [a]  where
    []     == []     = True	
    (x:xs) == (y:ys) = x == y && xs == ys
sof's avatar
sof committed
274
    xs     == ys     = False			
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
    xs     /= ys     = if (xs == ys) then False else True

instance (Ord a) => Ord [a] where
    a <  b  = case compare a b of { LT -> True;  EQ -> False; GT -> False }
    a <= b  = case compare a b of { LT -> True;  EQ -> True;  GT -> False }
    a >= b  = case compare a b of { LT -> False; EQ -> True;  GT -> True  }
    a >  b  = case compare a b of { LT -> False; EQ -> False; GT -> True  }

    max a b = case compare a b of { LT -> b; EQ -> a;  GT -> a }
    min a b = case compare a b of { LT -> a; EQ -> a;  GT -> b }

    compare []     []     = EQ
    compare (x:xs) []     = GT
    compare []     (y:ys) = LT
    compare (x:xs) (y:ys) = case compare x y of
                                 LT -> LT	
			         GT -> GT		
				 EQ -> compare xs ys

instance Functor [] where
    map f []             =  []
    map f (x:xs)         =  f x : map f xs

instance  Monad []  where
    m >>= k             = foldr ((++) . k) [] m
sof's avatar
sof committed
300
    m >> k              = foldr ((++) . (\ _ -> k)) [] m
301
302
303
304
305
306
    return x            = [x]

instance  MonadZero []  where
    zero                = []

instance  MonadPlus []  where
sof's avatar
sof committed
307
#ifdef USE_REPORT_PRELUDE
308
    xs ++ ys            =  foldr (:) ys xs
sof's avatar
sof committed
309
310
311
312
#else
    [] ++ ys            =  ys
    (x:xs) ++ ys        =  x : (xs ++ ys)
#endif
313
314
315

instance  (Show a) => Show [a]  where
    showsPrec p         = showList
sof's avatar
sof committed
316
    showList  ls	= showList__ (showsPrec 0) ls
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
\end{code}

\end{code}

A few list functions that appear here because they are used here.
The rest of the prelude list functions are in PrelList.

\begin{code}
foldr                   :: (a -> b -> b) -> b -> [a] -> b
foldr f z []            =  z
foldr f z (x:xs)        =  f x (foldr f z xs)

-- takeWhile, applied to a predicate p and a list xs, returns the longest
-- prefix (possibly empty) of xs of elements that satisfy p.  dropWhile p xs
-- returns the remaining suffix.  Span p xs is equivalent to 
-- (takeWhile p xs, dropWhile p xs), while break p uses the negation of p.

takeWhile               :: (a -> Bool) -> [a] -> [a]
takeWhile p []          =  []
takeWhile p (x:xs) 
            | p x       =  x : takeWhile p xs
            | otherwise =  []

dropWhile               :: (a -> Bool) -> [a] -> [a]
dropWhile p []          =  []
dropWhile p xs@(x:xs')
            | p x       =  dropWhile p xs'
            | otherwise =  xs

-- List index (subscript) operator, 0-origin
(!!)                    :: [a] -> Int -> a
sof's avatar
sof committed
348
#ifdef USE_REPORT_PRELUDE
349
350
351
352
(x:_)  !! 0             =  x
(_:xs) !! n | n > 0     =  xs !! (n-1)
(_:_)  !! _             =  error "PreludeList.!!: negative index"
[]     !! _             =  error "PreludeList.!!: index too large"
sof's avatar
sof committed
353
354
355
356
357
358
359
360
361
362
363
364
365
#else
-- HBC version (stolen), then unboxified
-- The semantics is not quite the same for error conditions
-- in the more efficient version.
--
_      !! n | n < 0  =  error "(!!){PreludeList}: negative index\n"
xs     !! n          =  sub xs (case n of { I# n# -> n# })
                           where sub :: [a] -> Int# -> a
                                 sub []      _ = error "(!!){PreludeList}: index too large\n"
                                 sub (x:xs) n# = if n# ==# 0#
						 then x
						 else sub xs (n# -# 1#)
#endif
366
367
368
369
370
371
372
373
374
375
376
377
\end{code}


%*********************************************************
%*							*
\subsection{Type @Void@}
%*							*
%*********************************************************

The type @Void@ is built in, but it needs a @Show@ instance.

\begin{code}
sof's avatar
sof committed
378
379
380
void :: Void
void = error "You tried to evaluate void"

381
382
instance  Show Void  where
    showsPrec p f  =  showString "<<void>>"
sof's avatar
sof committed
383
    showList ls    = showList__ (showsPrec 0) ls
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
\end{code}


%*********************************************************
%*							*
\subsection{Type @Bool@}
%*							*
%*********************************************************

\begin{code}
data  Bool  =  False | True	deriving (Eq, Ord, Enum, Bounded, Show {- Read -})

-- Boolean functions

(&&), (||)		:: Bool -> Bool -> Bool
True  && x		=  x
sof's avatar
sof committed
400
401
False && x		=  False
True  || x		=  True
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
False || x		=  x

not			:: Bool -> Bool
not True		=  False
not False		=  True

otherwise		:: Bool
otherwise 		=  True
\end{code}


%*********************************************************
%*							*
\subsection{The @()@ type}
%*							*
%*********************************************************

The Unit type is here because virtually any program needs it (whereas
some programs may get away without consulting PrelTup).  Furthermore,
the renamer currently *always* asks for () to be in scope, so that
ccalls can use () as their default type; so when compiling PrelBase we
need ().  (We could arrange suck in () only if -fglasgow-exts, but putting
it here seems more direct.

\begin{code}
data  ()  =  ()  --easier to do explicitly: deriving (Eq, Ord, Enum, Show, Bounded)
		 -- (avoids weird-named functions, e.g., con2tag_()#
429

430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
instance Eq () where
    () == () = True
    () /= () = False

instance Ord () where
    () <= () = True
    () <  () = False
    () >= () = True
    () >  () = False
    max () () = ()
    min () () = ()
    compare () () = EQ

instance Enum () where
    toEnum 0    = ()
    toEnum _	= error "Prelude.Enum.().toEnum: argument not 0"
    fromEnum () = 0
    enumFrom () 	= [()]
    enumFromThen () () 	= [()]
    enumFromTo () () 	= [()]
    enumFromThenTo () () () = [()]

instance  Show ()  where
    showsPrec p () = showString "()"
sof's avatar
sof committed
454
    showList ls    = showList__ (showsPrec 0) ls
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
\end{code}

%*********************************************************
%*							*
\subsection{Type @Ordering@}
%*							*
%*********************************************************

\begin{code}
data Ordering = LT | EQ | GT	deriving (Eq, Ord, Enum, Bounded, Show {- Read -})
\end{code}


%*********************************************************
%*							*
\subsection{Type @Char@ and @String@}
%*							*
%*********************************************************

\begin{code}
type  String = [Char]

data Char = C# Char#	deriving (Eq, Ord)

instance  Enum Char  where
    toEnum   (I# i) | i >=# 0# && i <=# 255# =  C# (chr# i)
sof's avatar
sof committed
481
		    | otherwise = error ("Prelude.Enum.Char.toEnum:out of range: " ++ show (I# i))
482
483
    fromEnum (C# c)     	 =  I# (ord# c)

sof's avatar
sof committed
484
485
486
487
488
489
    enumFrom   (C# c)	       =  efttCh (ord# c)  1#   (># 255#)
    enumFromTo (C# c1) (C# c2) = efttCh (ord# c1) 1#  (># (ord# c2))

    enumFromThen (C# c1) (C# c2)
	| c1 `leChar#` c2 = efttCh (ord# c1) (ord# c2 -# ord# c1) (># 255#)
	| otherwise       = efttCh (ord# c1) (ord# c2 -# ord# c1) (<# 0#)
490

sof's avatar
sof committed
491
492
493
494
495
496
    enumFromThenTo (C# c1) (C# c2) (C# c3)
	| c1 `leChar#` c2 = efttCh (ord# c1) (ord# c2 -# ord# c1) (># (ord# c3))
	| otherwise       = efttCh (ord# c1) (ord# c2 -# ord# c1) (<# (ord# c3))

efttCh :: Int# -> Int# -> (Int# -> Bool) -> [Char]
efttCh now step done 
497
498
  = go now
  where
sof's avatar
sof committed
499
500
    go now | done now  = []
	   | otherwise = C# (chr# now) : go (now +# step)
501
502
503
504
505
506
507
508
509
510
511
512
513

instance  Show Char  where
    showsPrec p '\'' = showString "'\\''"
    showsPrec p c    = showChar '\'' . showLitChar c . showChar '\''

    showList cs = showChar '"' . showl cs
		 where showl ""       = showChar '"'
		       showl ('"':cs) = showString "\\\"" . showl cs
		       showl (c:cs)   = showLitChar c . showl cs
\end{code}


\begin{code}
sof's avatar
sof committed
514
isAscii, isLatin1, isControl, isPrint, isSpace, isUpper,
515
516
 isLower, isAlpha, isDigit, isOctDigit, isHexDigit, isAlphanum :: Char -> Bool
isAscii c	 	=  fromEnum c < 128
sof's avatar
sof committed
517
isLatin1 c              =  c <= '\xff'
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
isControl c		=  c < ' ' || c >= '\DEL' && c <= '\x9f'
isPrint c		=  not (isControl c)

-- isSpace includes non-breaking space
-- Done with explicit equalities both for efficiency, and to avoid a tiresome
-- recursion with PrelList elem
isSpace c		=  c == ' '	||
			   c == '\t'	||
			   c == '\n'	||
			   c == '\r'	||
			   c == '\f'	||
			   c == '\v'	||
			   c == '\xa0'

-- The upper case ISO characters have the multiplication sign dumped
-- randomly in the middle of the range.  Go figure.
isUpper c		=  c >= 'A' && c <= 'Z' || 
                           c >= '\xC0' && c <= '\xD6' ||
                           c >= '\xD8' && c <= '\xDE'
-- The lower case ISO characters have the division sign dumped
-- randomly in the middle of the range.  Go figure.
isLower c		=  c >= 'a' && c <= 'z' ||
                           c >= '\xDF' && c <= '\xF6' ||
                           c >= '\xF8' && c <= '\xFF'
sof's avatar
sof committed
542
isAlpha c		=  isLower c || isUpper c
543
544
545
546
547
548
isDigit c		=  c >= '0' && c <= '9'
isOctDigit c		=  c >= '0' && c <= '7'
isHexDigit c		=  isDigit c || c >= 'A' && c <= 'F' ||
                                        c >= 'a' && c <= 'f'
isAlphanum c		=  isAlpha c || isDigit c

sof's avatar
sof committed
549
-- Case-changing operations
550
551

toUpper, toLower	:: Char -> Char
sof's avatar
sof committed
552
553
554
toUpper c | isLower c	&& c /= '\xDF' && c /= '\xFF'
 =  toEnum (fromEnum c - fromEnum 'a' + fromEnum 'A')
  | otherwise	=  c
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574

toLower c | isUpper c	=  toEnum (fromEnum c - fromEnum 'A' 
                                              + fromEnum 'a')
	  | otherwise	=  c

asciiTab = -- Using an array drags in the array module.  listArray ('\NUL', ' ')
	   ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL",
	    "BS",  "HT",  "LF",  "VT",  "FF",  "CR",  "SO",  "SI", 
	    "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB",
	    "CAN", "EM",  "SUB", "ESC", "FS",  "GS",  "RS",  "US", 
	    "SP"] 
\end{code}

%*********************************************************
%*							*
\subsection{Type @Int@}
%*							*
%*********************************************************

\begin{code}
575
576
577
data Int = I# Int#

instance Eq Int where
sof's avatar
sof committed
578
579
    (==) x y = x `eqInt` y
    (/=) x y = x `neInt` y
580
581

instance Ord Int where
sof's avatar
sof committed
582
    compare x y = compareInt x y 
583

sof's avatar
sof committed
584
585
586
587
588
589
    (<)  x y = ltInt x y
    (<=) x y = leInt x y
    (>=) x y = geInt x y
    (>)  x y = gtInt x y
    max x y = case (compareInt x y) of { LT -> y ; EQ -> x ; GT -> x }
    min x y = case (compareInt x y) of { LT -> x ; EQ -> x ; GT -> y }
590

sof's avatar
sof committed
591
592
593
(I# x) `compareInt` (I# y) | x <# y    = LT
			   | x ==# y   = EQ
			   | otherwise = GT
594
595
596
597

instance  Enum Int  where
    toEnum   x = x
    fromEnum x = x
sof's avatar
sof committed
598

599
#ifndef USE_FOLDR_BUILD
sof's avatar
sof committed
600
601
602
603
604
605
606
607
    enumFrom     (I# c)	         = eftInt c  1#
    enumFromTo   (I# c1) (I# c2) = efttInt c1 1#  (># c2)
    enumFromThen (I# c1) (I# c2) = eftInt c1 (c2 -# c1)

    enumFromThenTo (I# c1) (I# c2) (I# c3)
	| c1 <=# c2 = efttInt c1 (c2 -# c1) (># c3)
	| otherwise = efttInt c1 (c2 -# c1) (<# c3)

608
609
610
611
612
613
614
615
#else
    {-# INLINE enumFrom #-}
    {-# INLINE enumFromTo #-}
    enumFrom x           = build (\ c _ -> 
	let g x = x `c` g (x `plusInt` 1) in g x)
    enumFromTo x y	 = build (\ c n ->
	let g x = if x <= y then x `c` g (x `plusInt` 1) else n in g x)
#endif
sof's avatar
sof committed
616
617
618
619
620
621
622
623
624
625
626
627
628

efttInt :: Int# -> Int# -> (Int# -> Bool) -> [Int]
efttInt now step done
  = go now
  where
    go now | done now  = []
	   | otherwise = I# now : go (now +# step)

eftInt :: Int# -> Int# -> [Int]
eftInt now step
  = go now
  where
    go now = I# now : go (now +# step)
629

sof's avatar
sof committed
630

631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
instance  Num Int  where
    (+)	   x y =  plusInt x y
    (-)	   x y =  minusInt x y
    negate x   =  negateInt x
    (*)	   x y =  timesInt x y
    abs    n   = if n `geInt` 0 then n else (negateInt n)

    signum n | n `ltInt` 0 = negateInt 1
	     | n `eqInt` 0 = 0
	     | otherwise   = 1

    fromInteger (J# a# s# d#)
      = case (integer2Int# a# s# d#) of { i# -> I# i# }

    fromInt n		= n

instance  Show Int  where
    showsPrec p n = showSignedInt p n
sof's avatar
sof committed
649
    showList ls   = showList__ (showsPrec 0)  ls
650
651
652
653
654
655
656
657
658
659
660
661
662
663
\end{code}


%*********************************************************
%*							*
\subsection{Type @Integer@, @Float@, @Double@}
%*							*
%*********************************************************

Just the type declarations.  If we don't actually use any @Integers@ we'd
rather not link the @Integer@ module at all; and the default-decl stuff
in the renamer tends to slurp in @Double@ regardless.

\begin{code}
664
665
data Float	= F# Float#
data Double	= D# Double#
666
667
668
669
670
671
672
673
674
675
676
data Integer	= J# Int# Int# ByteArray#
\end{code}


%*********************************************************
%*							*
\subsection{The function type}
%*							*
%*********************************************************

\begin{code}
sof's avatar
sof committed
677
678
instance Eval (a -> b) 

679
680
instance  Show (a -> b)  where
    showsPrec p f  =  showString "<<function>>"
sof's avatar
sof committed
681
682
    showList ls	   = showList__ (showsPrec 0) ls

683
684
685
686
687
688
689
690
691
692
693

-- identity function
id			:: a -> a
id x			=  x

-- constant function
const			:: a -> b -> a
const x _		=  x

-- function composition
{-# INLINE (.) #-}
sof's avatar
sof committed
694
695
(.)	  :: (b -> c) -> (a -> b) -> a -> c
(.) f g	x = f (g x)
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760

-- flip f  takes its (first) two arguments in the reverse order of f.
flip			:: (a -> b -> c) -> b -> a -> c
flip f x y		=  f y x

-- right-associating infix application operator (useful in continuation-
-- passing style)
($)			:: (a -> b) -> a -> b
f $ x			=  f x

-- until p f  yields the result of applying f until p holds.
until			:: (a -> Bool) -> (a -> a) -> a -> a
until p f x | p x	=  x
	    | otherwise =  until p f (f x)

-- asTypeOf is a type-restricted version of const.  It is usually used
-- as an infix operator, and its typing forces its first argument
-- (which is usually overloaded) to have the same type as the second.
asTypeOf		:: a -> a -> a
asTypeOf		=  const
\end{code}


%*********************************************************
%*							*
\subsection{Miscellaneous}
%*							*
%*********************************************************


\begin{code}
data Lift a = Lift a
\end{code}




%*********************************************************
%*							*
\subsection{Support code for @Show@}
%*							*
%*********************************************************

\begin{code}
shows           :: (Show a) => a -> ShowS
shows           =  showsPrec 0

show            :: (Show a) => a -> String
show x          =  shows x ""

showChar        :: Char -> ShowS
showChar        =  (:)

showString      :: String -> ShowS
showString      =  (++)

showParen       :: Bool -> ShowS -> ShowS
showParen b p   =  if b then showChar '(' . p . showChar ')' else p

showList__ :: (a -> ShowS) ->  [a] -> ShowS

showList__ showx []     = showString "[]"
showList__ showx (x:xs) = showChar '[' . showx x . showl xs
  where
    showl []     = showChar ']'
sof's avatar
sof committed
761
    showl (x:xs) = showChar ',' . showx x . showl xs
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787

showSpace :: ShowS
showSpace = {-showChar ' '-} \ xs -> ' ' : xs
\end{code}

Code specific for characters

\begin{code}
showLitChar 		   :: Char -> ShowS
showLitChar c | c > '\DEL' =  showChar '\\' . protectEsc isDigit (shows (ord c))
showLitChar '\DEL'	   =  showString "\\DEL"
showLitChar '\\'	   =  showString "\\\\"
showLitChar c | c >= ' '   =  showChar c
showLitChar '\a'	   =  showString "\\a"
showLitChar '\b'	   =  showString "\\b"
showLitChar '\f'	   =  showString "\\f"
showLitChar '\n'	   =  showString "\\n"
showLitChar '\r'	   =  showString "\\r"
showLitChar '\t'	   =  showString "\\t"
showLitChar '\v'	   =  showString "\\v"
showLitChar '\SO'	   =  protectEsc (== 'H') (showString "\\SO")
showLitChar c		   =  showString ('\\' : asciiTab!!ord c)

protectEsc p f		   = f . cont
			     where cont s@(c:_) | p c = "\\&" ++ s
				   cont s	      = s
sof's avatar
sof committed
788
789
790
791
792

intToDigit :: Int -> Char
intToDigit i
 | i >= 0  && i <=  9   =  toEnum (fromEnum '0' + i)
 | i >= 10 && i <= 15   =  toEnum (fromEnum 'a' + i -10)
793
 | otherwise		=  error ("Char.intToDigit: not a digit" ++ show i)
sof's avatar
sof committed
794

795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
\end{code}

Code specific for Ints.

\begin{code}
showSignedInt :: Int -> Int -> ShowS
showSignedInt p (I# n) r
  = -- from HBC version; support code follows
    if n <# 0# && p > 6 then '(':itos n++(')':r) else itos n ++ r

itos :: Int# -> String
itos n =
    if n <# 0# then
	if negateInt# n <# 0# then
	    -- n is minInt, a difficult number
	    itos (n `quotInt#` 10#) ++ itos' (negateInt# (n `remInt#` 10#)) []
	else
	    '-':itos' (negateInt# n) []
    else 
	itos' n []
  where
    itos' :: Int# -> String -> String
    itos' n cs = 
	if n <# 10# then
	    C# (chr# (n +# ord# '0'#)) : cs
	else 
	    itos' (n `quotInt#` 10#) (C# (chr# (n `remInt#` 10# +# ord# '0'#)) : cs)
\end{code}

%*********************************************************
%*							*
\subsection{Numeric primops}
%*							*
%*********************************************************

Definitions of the boxed PrimOps; these will be
used in the case of partial applications, etc.

\begin{code}
sof's avatar
sof committed
834
835
836
{-# INLINE eqInt #-}
{-# INLINE neInt #-}

837
838
839
840
841
842
843
844
845
846
847
848
849
plusInt	(I# x) (I# y) = I# (x +# y)
minusInt(I# x) (I# y) = I# (x -# y)
timesInt(I# x) (I# y) = I# (x *# y)
quotInt	(I# x) (I# y) = I# (quotInt# x y)
remInt	(I# x) (I# y) = I# (remInt# x y)
negateInt (I# x)      = I# (negateInt# x)
gtInt	(I# x) (I# y) = x ># y
geInt	(I# x) (I# y) = x >=# y
eqInt	(I# x) (I# y) = x ==# y
neInt	(I# x) (I# y) = x /=# y
ltInt	(I# x) (I# y) = x <# y
leInt	(I# x) (I# y) = x <=# y
\end{code}