%%(c)TheUniversityofGlasgow2006%(c)TheGRASP/AQUAProject,GlasgowUniversity,1998%\section[Literal]{@Literal@:Machineliterals(unboxed,ofcourse)}\begin{code}{-# OPTIONS -fno-warn-incomplete-patterns #-}-- The above warning supression flag is a temporary kludge.-- While working on this module you are encouraged to remove it and fix-- any warnings in the module. See-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings-- for detailsmoduleLiteral(-- * Main data typeLiteral(..)-- Exported to ParseIface-- ** Creating Literals,mkMachInt,mkMachWord,mkMachInt64,mkMachWord64,mkMachFloat,mkMachDouble,mkMachChar,mkMachString-- ** Operations on Literals,literalType,hashLiteral-- ** Predicates on Literals and their contents,litIsDupable,litIsTrivial,inIntRange,inWordRange,tARGET_MAX_INT,inCharRange,isZeroLit,litFitsInChar-- ** Coercions,word2IntLit,int2WordLit,narrow8IntLit,narrow16IntLit,narrow32IntLit,narrow8WordLit,narrow16WordLit,narrow32WordLit,char2IntLit,int2CharLit,float2IntLit,int2FloatLit,double2IntLit,int2DoubleLit,nullAddrLit,float2DoubleLit,double2FloatLit)whereimportTysPrimimportTypeimportOutputableimportFastTypesimportFastStringimportBasicTypesimportBinaryimportConstantsimportData.IntimportData.RatioimportData.WordimportData.Char\end{code}%************************************************************************%**\subsection{Literals}%**%************************************************************************\begin{code}-- | So-called 'Literal's are one of:---- * An unboxed (/machine/) literal ('MachInt', 'MachFloat', etc.),-- which is presumed to be surrounded by appropriate constructors-- (@Int#@, etc.), so that the overall thing makes sense.---- * The literal derived from the label mentioned in a \"foreign label\" -- declaration ('MachLabel')dataLiteral=-------------------- First the primitive guysMachCharChar-- ^ @Char#@ - at least 31 bits. Create with 'mkMachChar'|MachStrFastString-- ^ A string-literal: stored and emitted-- UTF-8 encoded, we'll arrange to decode it-- at runtime. Also emitted with a @'\0'@-- terminator. Create with 'mkMachString'|MachNullAddr-- ^ The @NULL@ pointer, the only pointer value-- that can be represented as a Literal. Create -- with 'nullAddrLit'|MachIntInteger-- ^ @Int#@ - at least @WORD_SIZE_IN_BITS@ bits. Create with 'mkMachInt'|MachInt64Integer-- ^ @Int64#@ - at least 64 bits. Create with 'mkMachInt64'|MachWordInteger-- ^ @Word#@ - at least @WORD_SIZE_IN_BITS@ bits. Create with 'mkMachWord'|MachWord64Integer-- ^ @Word64#@ - at least 64 bits. Create with 'mkMachWord64'|MachFloatRational-- ^ @Float#@. Create with 'mkMachFloat'|MachDoubleRational-- ^ @Double#@. Create with 'mkMachDouble'|MachLabelFastString(MaybeInt)FunctionOrData-- ^ A label literal. Parameters:---- 1) The name of the symbol mentioned in the declaration---- 2) 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 assembly.\end{code}Binaryinstance\begin{code}instanceBinaryLiteralwhereput_bh(MachCharaa)=doputBytebh0;put_bhaaput_bh(MachStrab)=doputBytebh1;put_bhabput_bh(MachNullAddr)=doputBytebh2put_bh(MachIntad)=doputBytebh3;put_bhadput_bh(MachInt64ae)=doputBytebh4;put_bhaeput_bh(MachWordaf)=doputBytebh5;put_bhafput_bh(MachWord64ag)=doputBytebh6;put_bhagput_bh(MachFloatah)=doputBytebh7;put_bhahput_bh(MachDoubleai)=doputBytebh8;put_bhaiput_bh(MachLabelajmbfod)=doputBytebh9put_bhajput_bhmbput_bhfodgetbh=doh<-getBytebhcasehof0->doaa<-getbhreturn(MachCharaa)1->doab<-getbhreturn(MachStrab)2->doreturn(MachNullAddr)3->doad<-getbhreturn(MachIntad)4->doae<-getbhreturn(MachInt64ae)5->doaf<-getbhreturn(MachWordaf)6->doag<-getbhreturn(MachWord64ag)7->doah<-getbhreturn(MachFloatah)8->doai<-getbhreturn(MachDoubleai)9->doaj<-getbhmb<-getbhfod<-getbhreturn(MachLabelajmbfod)\end{code}\begin{code}instanceOutputableLiteralwherepprlit=pprLitlitinstanceShowLiteralwhereshowsPrecplit=showsPrecSDocp(pprlit)instanceEqLiteralwherea==b=case(a`compare`b)of{EQ->True;_->False}a/=b=case(a`compare`b)of{EQ->False;_->True}instanceOrdLiteralwherea<=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}compareab=cmpLitab\end{code}Construction~~~~~~~~~~~~\begin{code}-- | Creates a 'Literal' of type @Int#@mkMachInt::Integer->LiteralmkMachIntx=-- ASSERT2( inIntRange x, integer x ) -- 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.MachIntx-- | Creates a 'Literal' of type @Word#@mkMachWord::Integer->LiteralmkMachWordx=-- ASSERT2( inWordRange x, integer x ) MachWordx-- | Creates a 'Literal' of type @Int64#@mkMachInt64::Integer->LiteralmkMachInt64x=MachInt64x-- | Creates a 'Literal' of type @Word64#@mkMachWord64::Integer->LiteralmkMachWord64x=MachWord64x-- | Creates a 'Literal' of type @Float#@mkMachFloat::Rational->LiteralmkMachFloat=MachFloat-- | Creates a 'Literal' of type @Double#@mkMachDouble::Rational->LiteralmkMachDouble=MachDouble-- | Creates a 'Literal' of type @Char#@mkMachChar::Char->LiteralmkMachChar=MachChar-- | Creates a 'Literal' of type @Addr#@, which is appropriate for passing to-- e.g. some of the \"error\" functions in GHC.Err such as @GHC.Err.runtimeError@mkMachString::String->LiteralmkMachStrings=MachStr(mkFastStrings)-- stored UTF-8 encodedinIntRange,inWordRange::Integer->BoolinIntRangex=x>=tARGET_MIN_INT&&x<=tARGET_MAX_INTinWordRangex=x>=0&&x<=tARGET_MAX_WORDinCharRange::Char->BoolinCharRangec=c>='\0'&&c<=chrtARGET_MAX_CHAR-- | Tests whether the literal represents a zero of whatever type it isisZeroLit::Literal->BoolisZeroLit(MachInt0)=TrueisZeroLit(MachInt640)=TrueisZeroLit(MachWord0)=TrueisZeroLit(MachWord640)=TrueisZeroLit(MachFloat0)=TrueisZeroLit(MachDouble0)=TrueisZeroLit_=False\end{code}Coercions~~~~~~~~~\begin{code}word2IntLit,int2WordLit,narrow8IntLit,narrow16IntLit,narrow32IntLit,narrow8WordLit,narrow16WordLit,narrow32WordLit,char2IntLit,int2CharLit,float2IntLit,int2FloatLit,double2IntLit,int2DoubleLit,float2DoubleLit,double2FloatLit::Literal->Literalword2IntLit(MachWordw)|w>tARGET_MAX_INT=MachInt(w-tARGET_MAX_WORD-1)|otherwise=MachIntwint2WordLit(MachInti)|i<0=MachWord(1+tARGET_MAX_WORD+i)-- (-1) ---> tARGET_MAX_WORD|otherwise=MachWordinarrow8IntLit(MachInti)=MachInt(toInteger(fromIntegeri::Int8))narrow16IntLit(MachInti)=MachInt(toInteger(fromIntegeri::Int16))narrow32IntLit(MachInti)=MachInt(toInteger(fromIntegeri::Int32))narrow8WordLit(MachWordw)=MachWord(toInteger(fromIntegerw::Word8))narrow16WordLit(MachWordw)=MachWord(toInteger(fromIntegerw::Word16))narrow32WordLit(MachWordw)=MachWord(toInteger(fromIntegerw::Word32))char2IntLit(MachCharc)=MachInt(toInteger(ordc))int2CharLit(MachInti)=MachChar(chr(fromIntegeri))float2IntLit(MachFloatf)=MachInt(truncatef)int2FloatLit(MachInti)=MachFloat(fromIntegeri)double2IntLit(MachDoublef)=MachInt(truncatef)int2DoubleLit(MachInti)=MachDouble(fromIntegeri)float2DoubleLit(MachFloatf)=MachDoublefdouble2FloatLit(MachDoubled)=MachFloatdnullAddrLit::LiteralnullAddrLit=MachNullAddr\end{code}Predicates~~~~~~~~~~\begin{code}-- | True if there is absolutely no penalty to duplicating the literal.-- False principally of stringslitIsTrivial::Literal->Bool-- c.f. CoreUtils.exprIsTriviallitIsTrivial(MachStr_)=FalselitIsTrivial_=True-- | True if code space does not go bad if we duplicate this literal-- Currently we treat it just like 'litIsTrivial'litIsDupable::Literal->Bool-- c.f. CoreUtils.exprIsDupablelitIsDupable(MachStr_)=FalselitIsDupable_=TruelitFitsInChar::Literal->BoollitFitsInChar(MachInti)=fromIntegeri<=ordminBound&&fromIntegeri>=ordmaxBoundlitFitsInChar_=False\end{code}Types~~~~~\begin{code}-- | Find the Haskell 'Type' the literal occupiesliteralType::Literal->TypeliteralTypeMachNullAddr=addrPrimTyliteralType(MachChar_)=charPrimTyliteralType(MachStr_)=addrPrimTyliteralType(MachInt_)=intPrimTyliteralType(MachWord_)=wordPrimTyliteralType(MachInt64_)=int64PrimTyliteralType(MachWord64_)=word64PrimTyliteralType(MachFloat_)=floatPrimTyliteralType(MachDouble_)=doublePrimTyliteralType(MachLabel___)=addrPrimTy\end{code}Comparison~~~~~~~~~~\begin{code}cmpLit::Literal->Literal->OrderingcmpLit(MachChara)(MachCharb)=a`compare`bcmpLit(MachStra)(MachStrb)=a`compare`bcmpLit(MachNullAddr)(MachNullAddr)=EQcmpLit(MachInta)(MachIntb)=a`compare`bcmpLit(MachWorda)(MachWordb)=a`compare`bcmpLit(MachInt64a)(MachInt64b)=a`compare`bcmpLit(MachWord64a)(MachWord64b)=a`compare`bcmpLit(MachFloata)(MachFloatb)=a`compare`bcmpLit(MachDoublea)(MachDoubleb)=a`compare`bcmpLit(MachLabela__)(MachLabelb__)=a`compare`bcmpLitlit1lit2|litTaglit1<#litTaglit2=LT|otherwise=GTlitTag::Literal->FastIntlitTag(MachChar_)=_ILIT(1)litTag(MachStr_)=_ILIT(2)litTag(MachNullAddr)=_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)\end{code}Printing~~~~~~~~*MachX(i.e.unboxed)thingsareprintedunadornded(e.g.3,'a',"foo")exceptions:MachFloatgetsaninitialkeywordprefix.\begin{code}pprLit::Literal->SDocpprLit(MachCharch)=pprHsCharchpprLit(MachStrs)=pprHsStringspprLit(MachInti)=pprIntValipprLit(MachInt64i)=ptext(sLit"__int64")<+>integeripprLit(MachWordw)=ptext(sLit"__word")<+>integerwpprLit(MachWord64w)=ptext(sLit"__word64")<+>integerwpprLit(MachFloatf)=ptext(sLit"__float")<+>rationalfpprLit(MachDoubled)=rationaldpprLit(MachNullAddr)=ptext(sLit"__NULL")pprLit(MachLabellmbfod)=ptext(sLit"__label")<+>b<+>pprfodwhereb=casembofNothing->pprHsStringlJustx->doubleQuotes(text(unpackFSl++'@':showx))pprIntVal::Integer->SDoc-- ^ Print negative integers with parens to be sure it's unambiguouspprIntVali|i<0=parens(integeri)|otherwise=integeri\end{code}%************************************************************************%**\subsection{Hashing}%**%************************************************************************Hashvaluesshouldbezeroorapositiveinteger.Nonegativesplease.(TheymessuptheUniqFMforsomereason.)\begin{code}hashLiteral::Literal->InthashLiteral(MachCharc)=ordc+1000-- Keep it out of range of common intshashLiteral(MachStrs)=hashFSshashLiteral(MachNullAddr)=0hashLiteral(MachInti)=hashIntegerihashLiteral(MachInt64i)=hashIntegerihashLiteral(MachWordi)=hashIntegerihashLiteral(MachWord64i)=hashIntegerihashLiteral(MachFloatr)=hashRationalrhashLiteral(MachDoubler)=hashRationalrhashLiteral(MachLabels__)=hashFSshashRational::Rational->InthashRationalr=hashInteger(numeratorr)hashInteger::Integer->InthashIntegeri=1+abs(fromInteger(i`rem`10000))-- The 1+ is to avoid zero, which is a Bad Number-- since we use * to combine hash valueshashFS::FastString->InthashFSs=iBox(uniqueOfFSs)\end{code}