+
+*************************************************************
+%* *
+\subsection{Making literals}
+%* *
+%************************************************************************
+
+\begin{code}
+mkIntegerLit :: Integer -> DsM CoreExpr
+mkIntegerLit i
+ | inIntRange i -- Small enough, so start from an Int
+ = returnDs (mkSmallIntegerLit i)
+
+-- Special case for integral literals with a large magnitude:
+-- They are transformed into an expression involving only smaller
+-- integral literals. This improves constant folding.
+
+ | otherwise -- Big, so start from a string
+ = dsLookupGlobalValue plusIntegerName `thenDs` \ plus_id ->
+ dsLookupGlobalValue timesIntegerName `thenDs` \ times_id ->
+ let
+ plus a b = Var plus_id `App` a `App` b
+ times a b = Var times_id `App` a `App` b
+
+ -- Transform i into (x1 + (x2 + (x3 + (...) * b) * b) * b) with abs xi <= b
+ horner :: Integer -> Integer -> CoreExpr
+ horner b i | abs q <= 1 = if r == 0 || r == i
+ then mkSmallIntegerLit i
+ else mkSmallIntegerLit r `plus` mkSmallIntegerLit (i-r)
+ | r == 0 = horner b q `times` mkSmallIntegerLit b
+ | otherwise = mkSmallIntegerLit r `plus` (horner b q `times` mkSmallIntegerLit b)
+ where
+ (q,r) = i `quotRem` b
+
+ in
+ returnDs (horner tARGET_MAX_INT i)
+
+mkSmallIntegerLit i = mkConApp smallIntegerDataCon [mkIntLit i]
+
+mkStringLit :: String -> DsM CoreExpr
+mkStringLit str = mkStringLitFS (_PK_ str)
+
+mkStringLitFS :: FAST_STRING -> DsM CoreExpr
+mkStringLitFS str
+ | _NULL_ str
+ = returnDs (mkNilExpr charTy)
+
+ | _LENGTH_ str == 1
+ = let
+ the_char = mkConApp charDataCon [mkLit (MachChar (_HEAD_INT_ str))]
+ in
+ returnDs (mkConsExpr charTy the_char (mkNilExpr charTy))
+
+ | all safeChar chars
+ = dsLookupGlobalValue unpackCStringName `thenDs` \ unpack_id ->
+ returnDs (App (Var unpack_id) (Lit (MachStr str)))
+
+ | otherwise
+ = dsLookupGlobalValue unpackCStringUtf8Name `thenDs` \ unpack_id ->
+ returnDs (App (Var unpack_id) (Lit (MachStr (_PK_ (stringToUtf8 chars)))))
+
+ where
+ chars = _UNPK_INT_ str
+ safeChar c = c >= 1 && c <= 0xFF
+\end{code}
+
+