-
-*************************************************************
-%* *
-\subsection{Making literals}
-%* *
-%************************************************************************
-
-\begin{code}
-mkCharExpr :: Char -> CoreExpr -- Returns C# c :: Int
-mkIntExpr :: Integer -> CoreExpr -- Returns I# i :: Int
-mkIntegerExpr :: Integer -> DsM CoreExpr -- Result :: Integer
-mkStringExpr :: String -> DsM CoreExpr -- Result :: String
-mkStringExprFS :: FastString -> DsM CoreExpr -- Result :: String
-
-mkIntExpr i = mkConApp intDataCon [mkIntLit i]
-mkCharExpr c = mkConApp charDataCon [mkLit (MachChar c)]
-
-mkIntegerExpr i
- | inIntRange i -- Small enough, so start from an Int
- = dsLookupDataCon smallIntegerDataConName `thenDs` \ integer_dc ->
- returnDs (mkSmallIntegerLit integer_dc 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
- = dsLookupGlobalId plusIntegerName `thenDs` \ plus_id ->
- dsLookupGlobalId timesIntegerName `thenDs` \ times_id ->
- dsLookupDataCon smallIntegerDataConName `thenDs` \ integer_dc ->
- let
- lit i = mkSmallIntegerLit integer_dc i
- 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 lit i
- else lit r `plus` lit (i-r)
- | r == 0 = horner b q `times` lit b
- | otherwise = lit r `plus` (horner b q `times` lit b)
- where
- (q,r) = i `quotRem` b
-
- in
- returnDs (horner tARGET_MAX_INT i)
-
-mkSmallIntegerLit small_integer_data_con i = mkConApp small_integer_data_con [mkIntLit i]
-
-mkStringExpr str = mkStringExprFS (mkFastString str)
-
-mkStringExprFS str
- | nullFS str
- = returnDs (mkNilExpr charTy)
-
- | lengthFS str == 1
- = let
- the_char = mkCharExpr (headFS str)
- in
- returnDs (mkConsExpr charTy the_char (mkNilExpr charTy))
-
- | all safeChar chars
- = dsLookupGlobalId unpackCStringName `thenDs` \ unpack_id ->
- returnDs (App (Var unpack_id) (Lit (MachStr str)))
-
- | otherwise
- = dsLookupGlobalId unpackCStringUtf8Name `thenDs` \ unpack_id ->
- returnDs (App (Var unpack_id) (Lit (MachStr str)))
-
- where
- chars = unpackFS str
- safeChar c = ord c >= 1 && ord c <= 0x7F
-\end{code}
-
-