- returnUs (stg_rhs, stg_binds)
-\end{code}
-
-
-%************************************************************************
-%* *
-\subsection[coreToStg-lits]{Converting literals}
-%* *
-%************************************************************************
-
-Literals: the NoRep kind need to be de-no-rep'd.
-We always replace them with a simple variable, and float a suitable
-binding out to the top level.
-
-If an Integer is small enough (Haskell implementations must support
-Ints in the range $[-2^29+1, 2^29-1]$), wrap it up in @int2Integer@;
-otherwise, wrap with @litString2Integer@.
-
-\begin{code}
-tARGET_MIN_INT, tARGET_MAX_INT :: Integer
-tARGET_MIN_INT = -536870912
-tARGET_MAX_INT = 536870912
-
-litToStgArg :: Literal -> UniqSM (StgArg, Bag StgBinding)
-
-litToStgArg (NoRepStr s)
- = newStgVar stringTy `thenUs` \ var ->
- let
- rhs = StgRhsClosure noCostCentre -- No cost centre (ToDo?)
- stgArgOcc -- safe
- bOGUS_FVs
- Updatable -- WAS: ReEntrant (see note below)
- [] -- No arguments
- val
-
--- We used not to update strings, so that they wouldn't clog up the heap,
--- but instead be unpacked each time. But on some programs that costs a lot
--- [eg hpg], so now we update them.
-
- val = if (any is_NUL (_UNPK_ s)) then -- must cater for NULs in literal string
- StgApp (StgVarArg unpackCString2Id)
- [StgLitArg (MachStr s),
- StgLitArg (mkMachInt (toInteger (_LENGTH_ s)))]
- bOGUS_LVs
- else
- StgApp (StgVarArg unpackCStringId)
- [StgLitArg (MachStr s)]
- bOGUS_LVs
- in
- returnUs (StgVarArg var, unitBag (StgNonRec var rhs))
- where
- is_NUL c = c == '\0'
-
-litToStgArg (NoRepInteger i integer_ty)
- -- extremely convenient to look out for a few very common
- -- Integer literals!
- | i == 0 = returnUs (StgVarArg integerZeroId, emptyBag)
- | i == 1 = returnUs (StgVarArg integerPlusOneId, emptyBag)
- | i == 2 = returnUs (StgVarArg integerPlusTwoId, emptyBag)
- | i == (-1) = returnUs (StgVarArg integerMinusOneId, emptyBag)
-
- | otherwise
- = newStgVar integer_ty `thenUs` \ var ->
- let
- rhs = StgRhsClosure noCostCentre -- No cost centre (ToDo?)
- stgArgOcc -- safe
- bOGUS_FVs
- Updatable -- Update an integer
- [] -- No arguments
- val
-
- val
- | i > tARGET_MIN_INT && i < tARGET_MAX_INT
- = -- Start from an Int
- StgPrim Int2IntegerOp [StgLitArg (mkMachInt i)] bOGUS_LVs
-
- | otherwise
- = -- Start from a string
- StgPrim Addr2IntegerOp [StgLitArg (MachStr (_PK_ (show i)))] bOGUS_LVs
- in
- returnUs (StgVarArg var, unitBag (StgNonRec var rhs))
-
-litToStgArg (NoRepRational r rational_ty)
- = --ASSERT(is_rational_ty)
- (if is_rational_ty then \x->x else pprTrace "litToStgArg:not rational?" (pprType PprDebug rational_ty)) $
- litToStgArg (NoRepInteger (numerator r) integer_ty) `thenUs` \ (num_atom, binds1) ->
- litToStgArg (NoRepInteger (denominator r) integer_ty) `thenUs` \ (denom_atom, binds2) ->
- newStgVar rational_ty `thenUs` \ var ->
- let
- rhs = StgRhsCon noCostCentre -- No cost centre (ToDo?)
- ratio_data_con -- Constructor
- [num_atom, denom_atom]
- in
- returnUs (StgVarArg var, binds1 `unionBags`
- binds2 `unionBags`
- unitBag (StgNonRec var rhs))
- where
- (is_rational_ty, ratio_data_con, integer_ty)
- = case (maybeAppDataTyCon rational_ty) of
- Just (tycon, [i_ty], [con])
- -> ASSERT(is_integer_ty i_ty)
- (uniqueOf tycon == ratioTyConKey, con, i_ty)
-
- _ -> (False, panic "ratio_data_con", panic "integer_ty")
-
- is_integer_ty ty
- = case (maybeAppDataTyCon ty) of
- Just (tycon, [], _) -> uniqueOf tycon == integerTyConKey
- _ -> False
-
-litToStgArg other_lit = returnUs (StgLitArg other_lit, emptyBag)