%
% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1998
%
\section[Literal]{@Literal@: Machine literals (unboxed, of course)}

\begin{code}
module Literal
	( Literal(..)		-- Exported to ParseIface
	, mkMachInt, mkMachWord
	, mkMachInt64, mkMachWord64, mkMachFloat, mkMachDouble, mkStringLit, mkMachChar
	, litSize
	, litIsDupable, litIsTrivial
	, literalType
	, hashLiteral

	, inIntRange, inWordRange, targetMaxInt, targetMaxWord, inCharRange
	, isZeroLit
	) where

#include "HsVersions.h"

import TysPrim
import Type
import TyCon
import Outputable
import FastTypes
import FastString
import Binary
import Ratio
import FastString
import Unique
import DynFlags ( DynFlags,TargetConsts(..),targetConsts )

import Data.Char ( chr, ord )
\end{code}


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

\begin{code}
targetMinInt,targetMaxInt,targetMaxWord :: DynFlags -> Integer
targetMinInt dflags = minInt (targetConsts dflags)
targetMaxInt dflags = maxInt (targetConsts dflags)
targetMaxWord dflags = maxWord (targetConsts dflags)
\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
  = MachStr	FastString	-- A string-literal: stored and emitted
				-- UTF-8 encoded, we'll arrange to decode it
				-- at runtime.  Also emitted with a '\0'
				-- terminator.

  | MachNullPtr                 -- the NULL pointer, the only pointer value
                                -- that can be represented as a Literal.

  | MachInteger	 Integer  TyCon	-- Any integral type (Int*#, Word*#, Char#)
  | MachRational Rational TyCon -- Any rational type (Float#, Double#)

        -- MachLabel is used (only) for the literal derived from a 
	-- "foreign label" declaration.
	-- string argument is the name of a symbol.  This literal
	-- refers to the *address* of the label.
  | MachLabel   FastString		-- always an Addr#
  		(Maybe Int)             -- the size (in bytes) of the arguments
					-- the label expects. Only applicable with
					-- 'stdcall' labels.
					-- Just x => "@<x>" will be appended to label
					--           name when emitting asm.
\end{code}

\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

mkMachInt    x = MachInteger x intPrimTyCon
mkMachWord   x = MachInteger x wordPrimTyCon
mkMachInt64  x = MachInteger x int64PrimTyCon
mkMachWord64 x = MachInteger x word64PrimTyCon

mkMachFloat, mkMachDouble :: Rational -> Literal
mkMachFloat  x = MachRational x floatPrimTyCon
mkMachDouble x = MachRational x doublePrimTyCon

mkMachChar :: Char -> Literal
mkMachChar c = MachInteger (toInteger (ord c)) charPrimTyCon

mkStringLit :: String -> Literal
mkStringLit s = MachStr (mkFastString s) -- stored UTF-8 encoded

inIntRange, inWordRange :: DynFlags -> Integer -> Bool
inIntRange dflags x = x >= targetMinInt dflags && x <= targetMaxInt dflags
inWordRange dflags x = x >= 0 && x <= targetMaxWord dflags

inCharRange :: Char -> Bool
inCharRange c =  c >= '\0' && c <= '\x10ffff'

isZeroLit :: Literal -> Bool
isZeroLit (MachInteger  0 _) = True
isZeroLit (MachRational 0 _) = True
isZeroLit other		 = False
\end{code}


	Predicates
	~~~~~~~~~~
\begin{code}
litIsTrivial :: Literal -> Bool
-- True if there is absolutely no penalty to duplicating the literal
--	c.f. CoreUtils.exprIsTrivial
-- False principally of strings
litIsTrivial (MachStr _) = False
litIsTrivial other	 = True

litIsDupable :: Literal -> Bool
-- True if code space does not go bad if we duplicate this literal
--	c.f. CoreUtils.exprIsDupable
-- Currently we treat it just like litIsTrivial
litIsDupable (MachStr _) = False
litIsDupable other	 = True

litSize :: Literal -> Int
-- Used by CoreUnfold.sizeExpr
litSize (MachStr str) = 1 + ((lengthFS str + 3) `div` 4)
	-- Every literal has size at least 1, otherwise
	-- 	f "x" 
	-- might be too small
	-- [Sept03: make literal strings a bit bigger to avoid fruitless 
	--  duplication of little strings]
litSize _other	      = 1
\end{code}

	Types
	~~~~~
\begin{code}
literalType :: Literal -> Type
literalType MachNullPtr     = mkForAllTy ptrAlphaTyVar ptrAlphaTy
literalType (MachStr  _)    = stringPrimTy
literalType (MachInteger  _ tc) = mkTyConTy tc
literalType (MachRational _ tc) = mkTyConTy tc
literalType (MachLabel _ _) = addrPrimTy
\end{code}


	Comparison
	~~~~~~~~~~
\begin{code}
cmpLit (MachStr       a)   (MachStr	   b)   = a `compare` b
cmpLit (MachNullPtr)       (MachNullPtr)        = EQ
cmpLit (MachInteger   a _) (MachInteger    b _) = a `compare` b
cmpLit (MachRational  a _) (MachRational   b _) = a `compare` b
cmpLit (MachLabel     a _) (MachLabel      b _) = a `compare` b
cmpLit lit1		   lit2		        | litTag lit1 <# litTag lit2 = LT
					        | otherwise  		     = GT

litTag (MachStr       _)   = _ILIT(2)
litTag (MachNullPtr)       = _ILIT(3)
litTag (MachInteger  _ _)  = _ILIT(4)
litTag (MachRational _ _)  = _ILIT(9)
litTag (MachLabel   _ _)   = _ILIT(10)
\end{code}

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

\begin{code}
pprLit (MachStr s)    	= pprHsString s
pprLit (MachInteger i tc) 
  | tc == charPrimTyCon, i >= 0, i <= 0x10ffff 
  = pprHsChar (chr (fromInteger i))
  | tc == intPrimTyCon  
  = if i < 0 then parens (integer i) else integer i
  | otherwise
  = parens (integer i <+> dcolon <+> ppr tc)
pprLit (MachRational r tc)  
  | tc == doublePrimTyCon 
  = rational r
  | otherwise           
  = parens (rational r <+> dcolon <+> ppr tc)
pprLit (MachNullPtr) 	= ptext SLIT("__null")
pprLit (MachLabel l mb) = ptext SLIT("__label") <+> 
			     case mb of
			       Nothing -> pprHsString l
			       Just x  -> doubleQuotes (text (unpackFS l ++ '@':show x))

\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
hashLiteral (MachStr s)     	= hashFS s
hashLiteral (MachNullPtr)    	= 1
hashLiteral (MachInteger  i tc) = hashInteger i + getKey (tyConUnique tc)
hashLiteral (MachRational r tc) = hashRational r + getKey (tyConUnique tc)
hashLiteral (MachLabel 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

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