Literal.lhs 14.9 KB
Newer Older
1
2
3
4
5
6
%
% (c) The GRASP/AQUA Project, Glasgow University, 1998
%
\section[Literal]{@Literal@: Machine literals (unboxed, of course)}

\begin{code}
7
8
9
10
module Literal
	( Literal(..)		-- Exported to ParseIface
	, mkMachInt, mkMachWord
	, mkMachInt64, mkMachWord64
11
	, isLitLitLit, maybeLitLit, litSize, litIsDupable,
12
13
	, literalType, literalPrimRep
	, hashLiteral
14

15
	, inIntRange, inWordRange, tARGET_MAX_INT, inCharRange
16
	, isZeroLit,
17

18
	, word2IntLit, int2WordLit
apt's avatar
apt committed
19
20
	, narrow8IntLit, narrow16IntLit, narrow32IntLit
	, narrow8WordLit, narrow16WordLit, narrow32WordLit
21
	, char2IntLit, int2CharLit
22
	, float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
apt's avatar
apt committed
23
	, nullAddrLit, float2DoubleLit, double2FloatLit
24
	) where
25
26
27
28
29
30
31

#include "HsVersions.h"

import TysPrim		( charPrimTy, addrPrimTy, floatPrimTy, doublePrimTy,
			  intPrimTy, wordPrimTy, int64PrimTy, word64PrimTy
			)
import PrimRep		( PrimRep(..) )
32
33
import TcType		( Type, tcCmpType )
import Type		( typePrimRep )
34
import PprType		( pprParendType )
35
import CStrings		( pprFSInCStyle )
36
37

import Outputable
38
import FastTypes
39
import FastString
40
import Binary
41
42
import Util		( thenCmp )

43
import Ratio 		( numerator )
44
import FastString	( uniqueOfFS, lengthFS )
45
46
import DATA_INT		( Int8,  Int16,  Int32 )
import DATA_WORD	( Word8, Word16, Word32 )
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
import Char		( ord, chr )
\end{code}



%************************************************************************
%*									*
\subsection{Sizes}
%*									*
%************************************************************************

If we're compiling with GHC (and we're not cross-compiling), then we
know that minBound and maxBound :: Int are the right values for the
target architecture.  Otherwise, we assume -2^31 and 2^31-1
respectively (which will be wrong on a 64-bit machine).

\begin{code}
tARGET_MIN_INT, tARGET_MAX_INT, tARGET_MAX_WORD :: Integer
#if __GLASGOW_HASKELL__
tARGET_MIN_INT  = toInteger (minBound :: Int)
tARGET_MAX_INT  = toInteger (maxBound :: Int)
#else
tARGET_MIN_INT = -2147483648
tARGET_MAX_INT =  2147483647
#endif
tARGET_MAX_WORD = (tARGET_MAX_INT * 2) + 1
73
74
75

tARGET_MAX_CHAR :: Int
tARGET_MAX_CHAR = 0x10ffff
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
\end{code}
 

%************************************************************************
%*									*
\subsection{Literals}
%*									*
%************************************************************************

So-called @Literals@ are {\em either}:
\begin{itemize}
\item
An unboxed (``machine'') literal (type: @IntPrim@, @FloatPrim@, etc.),
which is presumed to be surrounded by appropriate constructors
(@mKINT@, etc.), so that the overall thing makes sense.
\item
An Integer, Rational, or String literal whose representation we are
{\em uncommitted} about; i.e., the surrounding with constructors,
function applications, etc., etc., has not yet been done.
\end{itemize}

\begin{code}
data Literal
  =	------------------
	-- First the primitive guys
101
    MachChar	Int             -- Char#        At least 31 bits
102
  | MachStr	FastString
103
104
105

  | MachAddr	Integer	-- Whatever this machine thinks is a "pointer"

apt's avatar
apt committed
106
  | MachInt	Integer		-- Int#		At least WORD_SIZE_IN_BITS bits
107
  | MachInt64	Integer		-- Int64#	At least 64 bits
apt's avatar
apt committed
108
  | MachWord	Integer		-- Word#	At least WORD_SIZE_IN_BITS bits
109
110
111
112
113
  | MachWord64	Integer		-- Word64#	At least 64 bits

  | MachFloat	Rational
  | MachDouble	Rational

rrt's avatar
rrt committed
114
115
        -- MachLabel is used (only) for the literal derived from a 
	-- "foreign label" declaration.
116
117
	-- string argument is the name of a symbol.  This literal
	-- refers to the *address* of the label.
118
  | MachLabel   FastString		-- always an Addr#
119
120
121
122
123

	-- lit-lits only work for via-C compilation, hence they
	-- are deprecated.  The string is emitted verbatim into
	-- the C file, and can therefore be any C expression,
	-- macro call, #defined constant etc.
124
  | MachLitLit  FastString Type	-- Type might be Addr# or Int# etc
125
126
\end{code}

127
128
129
130
131
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
Binary instance: must do this manually, because we don't want the type
arg of MachLitLit involved.

\begin{code}
instance Binary Literal where
    put_ bh (MachChar aa)     = do putByte bh 0; put_ bh aa
    put_ bh (MachStr ab)      = do putByte bh 1; put_ bh ab
    put_ bh (MachAddr ac)     = do putByte bh 2; put_ bh ac
    put_ bh (MachInt ad)      = do putByte bh 3; put_ bh ad
    put_ bh (MachInt64 ae)    = do putByte bh 4; put_ bh ae
    put_ bh (MachWord af)     = do putByte bh 5; put_ bh af
    put_ bh (MachWord64 ag)   = do putByte bh 6; put_ bh ag
    put_ bh (MachFloat ah)    = do putByte bh 7; put_ bh ah
    put_ bh (MachDouble ai)   = do putByte bh 8; put_ bh ai
    put_ bh (MachLabel aj)    = do putByte bh 9; put_ bh aj
    put_ bh (MachLitLit ak _) = do putByte bh 10; put_ bh ak
    get bh = do
	    h <- getByte bh
	    case h of
	      0 -> do
		    aa <- get bh
		    return (MachChar aa)
	      1 -> do
		    ab <- get bh
		    return (MachStr ab)
	      2 -> do
		    ac <- get bh
		    return (MachAddr ac)
	      3 -> do
		    ad <- get bh
		    return (MachInt ad)
	      4 -> do
		    ae <- get bh
		    return (MachInt64 ae)
	      5 -> do
		    af <- get bh
		    return (MachWord af)
	      6 -> do
		    ag <- get bh
		    return (MachWord64 ag)
	      7 -> do
		    ah <- get bh
		    return (MachFloat ah)
	      8 -> do
		    ai <- get bh
		    return (MachDouble ai)
	      9 -> do
		    aj <- get bh
		    return (MachLabel aj)
	      10 -> do
		    ak <- get bh
		    return (MachLitLit ak (error "MachLitLit: no type"))
\end{code}

181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
\begin{code}
instance Outputable Literal where
    ppr lit = pprLit lit

instance Show Literal where
    showsPrec p lit = showsPrecSDoc p (ppr lit)

instance Eq Literal where
    a == b = case (a `compare` b) of { EQ -> True;   _ -> False }
    a /= b = case (a `compare` b) of { EQ -> False;  _ -> True  }

instance Ord Literal where
    a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
    a <	 b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
    a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
    a >	 b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
    compare a b = cmpLit a b
\end{code}


	Construction
	~~~~~~~~~~~~
\begin{code}
mkMachInt, mkMachWord, mkMachInt64, mkMachWord64 :: Integer -> Literal

206
mkMachInt  x   = -- ASSERT2( inIntRange x,  integer x ) 
207
208
209
210
	 	 -- Not true: you can write out of range Int# literals
		 -- For example, one can write (intToWord# 0xffff0000) to
		 -- get a particular Word bit-pattern, and there's no other
		 -- convenient way to write such literals, which is why we allow it.
211
212
213
214
215
		 MachInt x
mkMachWord x   = -- ASSERT2( inWordRange x, integer x ) 
		 MachWord x
mkMachInt64  x = MachInt64 x
mkMachWord64 x = MachWord64 x
216
217
218
219

inIntRange, inWordRange :: Integer -> Bool
inIntRange  x = x >= tARGET_MIN_INT && x <= tARGET_MAX_INT
inWordRange x = x >= 0		    && x <= tARGET_MAX_WORD
220
221
222

inCharRange :: Int -> Bool
inCharRange c =  c >= 0 && c <= tARGET_MAX_CHAR
223
224
225
226
227
228
229
230
231

isZeroLit :: Literal -> Bool
isZeroLit (MachInt    0) = True
isZeroLit (MachInt64  0) = True
isZeroLit (MachWord   0) = True
isZeroLit (MachWord64 0) = True
isZeroLit (MachFloat  0) = True
isZeroLit (MachDouble 0) = True
isZeroLit other		 = False
232
233
234
235
236
\end{code}

	Coercions
	~~~~~~~~~
\begin{code}
237
word2IntLit, int2WordLit,
apt's avatar
apt committed
238
239
  narrow8IntLit, narrow16IntLit, narrow32IntLit,
  narrow8WordLit, narrow16WordLit, narrow32WordLit,
240
241
  char2IntLit, int2CharLit,
  float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit,
apt's avatar
apt committed
242
  float2DoubleLit, double2FloatLit
243
  :: Literal -> Literal
244
245

word2IntLit (MachWord w) 
246
  | w > tARGET_MAX_INT = MachInt (w - tARGET_MAX_WORD - 1)
247
248
249
250
251
252
  | otherwise	       = MachInt w

int2WordLit (MachInt i)
  | i < 0     = MachWord (1 + tARGET_MAX_WORD + i)	-- (-1)  --->  tARGET_MAX_WORD
  | otherwise = MachWord i

apt's avatar
apt committed
253
254
255
256
257
258
narrow8IntLit    (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int8))
narrow16IntLit   (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int16))
narrow32IntLit   (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int32))
narrow8WordLit   (MachWord w) = MachWord (toInteger (fromInteger w :: Word8))
narrow16WordLit  (MachWord w) = MachWord (toInteger (fromInteger w :: Word16))
narrow32WordLit  (MachWord w) = MachWord (toInteger (fromInteger w :: Word32))
259

260
261
char2IntLit (MachChar c) = MachInt  (toInteger c)
int2CharLit (MachInt  i) = MachChar (fromInteger i)
262

263
264
265
float2IntLit (MachFloat f) = MachInt   (truncate    f)
int2FloatLit (MachInt   i) = MachFloat (fromInteger i)

apt's avatar
apt committed
266
double2IntLit (MachDouble f) = MachInt    (truncate    f)
267
268
269
270
int2DoubleLit (MachInt   i) = MachDouble (fromInteger i)

float2DoubleLit (MachFloat  f) = MachDouble f
double2FloatLit (MachDouble d) = MachFloat  d
apt's avatar
apt committed
271
272
273

nullAddrLit :: Literal
nullAddrLit = MachAddr 0
274
275
276
277
278
279
280
\end{code}

	Predicates
	~~~~~~~~~~
\begin{code}
isLitLitLit (MachLitLit _ _) = True
isLitLitLit _	    	     = False
281
282
283

maybeLitLit (MachLitLit s t) = Just (s,t)
maybeLitLit _		     = Nothing
284
285
286
287
288
289

litIsDupable :: Literal -> Bool
	-- True if code space does not go bad if we duplicate this literal
	-- False principally of strings
litIsDupable (MachStr _) = False
litIsDupable other	 = True
290
291
292
293
294

litSize :: Literal -> Int
	-- used by CoreUnfold.sizeExpr
litSize (MachStr str) = lengthFS str `div` 4
litSize _other	      = 1
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
\end{code}

	Types
	~~~~~
\begin{code}
literalType :: Literal -> Type
literalType (MachChar _)	  = charPrimTy
literalType (MachStr  _)	  = addrPrimTy
literalType (MachAddr _)	  = addrPrimTy
literalType (MachInt  _)	  = intPrimTy
literalType (MachWord  _)	  = wordPrimTy
literalType (MachInt64  _)	  = int64PrimTy
literalType (MachWord64  _)	  = word64PrimTy
literalType (MachFloat _)	  = floatPrimTy
literalType (MachDouble _)	  = doublePrimTy
310
literalType (MachLabel _)	  = addrPrimTy
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
literalType (MachLitLit _ ty)	  = ty
\end{code}

\begin{code}
literalPrimRep :: Literal -> PrimRep

literalPrimRep (MachChar _)	  = CharRep
literalPrimRep (MachStr _)	  = AddrRep  -- specifically: "char *"
literalPrimRep (MachAddr  _)	  = AddrRep
literalPrimRep (MachInt _) 	  = IntRep
literalPrimRep (MachWord _) 	  = WordRep
literalPrimRep (MachInt64 _)	  = Int64Rep
literalPrimRep (MachWord64 _)	  = Word64Rep
literalPrimRep (MachFloat _)	  = FloatRep
literalPrimRep (MachDouble _)	  = DoubleRep
326
literalPrimRep (MachLabel _)	  = AddrRep
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
literalPrimRep (MachLitLit _ ty)  = typePrimRep ty
\end{code}


	Comparison
	~~~~~~~~~~
\begin{code}
cmpLit (MachChar      a)   (MachChar	   b)   = a `compare` b
cmpLit (MachStr       a)   (MachStr	   b)   = a `compare` b
cmpLit (MachAddr      a)   (MachAddr	   b)   = a `compare` b
cmpLit (MachInt       a)   (MachInt	   b)   = a `compare` b
cmpLit (MachWord      a)   (MachWord	   b)   = a `compare` b
cmpLit (MachInt64     a)   (MachInt64	   b)   = a `compare` b
cmpLit (MachWord64    a)   (MachWord64	   b)   = a `compare` b
cmpLit (MachFloat     a)   (MachFloat	   b)   = a `compare` b
cmpLit (MachDouble    a)   (MachDouble	   b)   = a `compare` b
343
cmpLit (MachLabel     a)   (MachLabel      b)   = a `compare` b
344
cmpLit (MachLitLit    a b) (MachLitLit    c d)  = (a `compare` c) `thenCmp` (b `tcCmpType` d)
345
cmpLit lit1		   lit2		        | litTag lit1 <# litTag lit2 = LT
346
347
					        | otherwise  		       = GT

348
349
350
351
352
353
354
355
356
357
358
litTag (MachChar      _)   = _ILIT(1)
litTag (MachStr       _)   = _ILIT(2)
litTag (MachAddr      _)   = _ILIT(3)
litTag (MachInt       _)   = _ILIT(4)
litTag (MachWord      _)   = _ILIT(5)
litTag (MachInt64     _)   = _ILIT(6)
litTag (MachWord64    _)   = _ILIT(7)
litTag (MachFloat     _)   = _ILIT(8)
litTag (MachDouble    _)   = _ILIT(9)
litTag (MachLabel     _)   = _ILIT(10)
litTag (MachLitLit    _ _) = _ILIT(11)
359
360
361
362
363
364
365
366
367
368
369
\end{code}

	Printing
	~~~~~~~~
* MachX (i.e. unboxed) things are printed unadornded (e.g. 3, 'a', "foo")
  exceptions: MachFloat and MachAddr get an initial keyword prefix

\begin{code}
pprLit lit
  = getPprStyle $ \ sty ->
    let
370
      code_style  = codeStyle  sty
371
372
    in
    case lit of
373
374
      MachChar ch | code_style -> hcat [ptext SLIT("(C_)"), text (show ch)]
	          | otherwise  -> pprHsChar ch
375
376

      MachStr s | code_style -> pprFSInCStyle s
377
378
379
	        | otherwise  -> pprHsString s
      -- Warning: printing MachStr in code_style assumes it contains
      -- only characters '\0'..'\xFF'!
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394

      MachInt i | code_style && i == tARGET_MIN_INT -> parens (integer (i+1) <> text "-1")
				-- Avoid a problem whereby gcc interprets
				-- the constant minInt as unsigned.
		| otherwise -> pprIntVal i

      MachInt64 i | code_style -> pprIntVal i		-- Same problem with gcc???
		  | otherwise -> ptext SLIT("__int64") <+> integer i

      MachWord w | code_style -> pprHexVal w
		 | otherwise  -> ptext SLIT("__word") <+> integer w

      MachWord64 w | code_style -> pprHexVal w
		   | otherwise  -> ptext SLIT("__word64") <+> integer w

395
      MachFloat f | code_style -> ptext SLIT("(StgFloat)") <> code_rational f
396
397
                  | otherwise  -> ptext SLIT("__float") <+> rational f

398
399
      MachDouble d | code_style -> code_rational d
		   | otherwise  -> rational d
400
401
402
403

      MachAddr p | code_style -> ptext SLIT("(void*)") <> integer p
	         | otherwise  -> ptext SLIT("__addr") <+> integer p

404
      MachLabel l | code_style -> ptext SLIT("(&") <> ftext l <> char ')'
405
		  | otherwise  -> ptext SLIT("__label") <+> pprHsString l
406

407
      MachLitLit s ty | code_style  -> ftext s
408
		      | otherwise   -> parens (hsep [ptext SLIT("__litlit"), 
409
						     pprHsString s,
410
						     pprParendType ty])
411

412
413
414
415
416
-- negative floating literals in code style need parentheses to avoid
-- interacting with surrounding syntax.
code_rational d | d < 0     = parens (rational d)
                | otherwise = rational d

417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
pprIntVal :: Integer -> SDoc
-- Print negative integers with parens to be sure it's unambiguous
pprIntVal i | i < 0     = parens (integer i)
	    | otherwise = integer i
		
pprHexVal :: Integer -> SDoc
-- Print in C hex format: 0x13fa 
pprHexVal 0 = ptext SLIT("0x0")
pprHexVal w = ptext SLIT("0x") <> go w
	    where
	      go 0 = empty
	      go w = go quot <> dig
		   where
		     (quot,rem) = w `quotRem` 16
		     dig | rem < 10  = char (chr (fromInteger rem + ord '0'))
			 | otherwise = char (chr (fromInteger rem - 10 + ord 'a'))
\end{code}


%************************************************************************
%*									*
\subsection{Hashing}
%*									*
%************************************************************************

Hash values should be zero or a positive integer.  No negatives please.
(They mess up the UniqFM for some reason.)

\begin{code}
hashLiteral :: Literal -> Int
447
hashLiteral (MachChar c)    	= c + 1000	-- Keep it out of range of common ints
448
449
450
451
452
453
454
455
hashLiteral (MachStr s)     	= hashFS s
hashLiteral (MachAddr i)    	= hashInteger i
hashLiteral (MachInt i)   	= hashInteger i
hashLiteral (MachInt64 i) 	= hashInteger i
hashLiteral (MachWord i)   	= hashInteger i
hashLiteral (MachWord64 i) 	= hashInteger i
hashLiteral (MachFloat r)   	= hashRational r
hashLiteral (MachDouble r)  	= hashRational r
456
hashLiteral (MachLabel s)       = hashFS s
457
458
459
460
461
462
463
464
465
466
hashLiteral (MachLitLit s _)    = hashFS s

hashRational :: Rational -> Int
hashRational r = hashInteger (numerator r)

hashInteger :: Integer -> Int
hashInteger i = 1 + abs (fromInteger (i `rem` 10000))
		-- The 1+ is to avoid zero, which is a Bad Number
		-- since we use * to combine hash values

467
hashFS :: FastString -> Int
468
hashFS s = iBox (uniqueOfFS s)
469
\end{code}