-
--- "_" => build (\ c n -> c 'c' n) -- LATER
-
--- "str" ==> build (\ c n -> foldr charTy T c n "str")
-
-{- LATER:
-dsExpr (HsLitOut (HsString str) _)
- = newTyVarsDs [alphaTyVar] `thenDs` \ [new_tyvar] ->
- let
- new_ty = mkTyVarTy new_tyvar
- in
- newSysLocalsDs [
- charTy `mkFunTy` (new_ty `mkFunTy` new_ty),
- new_ty,
- mkForallTy [alphaTyVar]
- ((charTy `mkFunTy` (alphaTy `mkFunTy` alphaTy))
- `mkFunTy` (alphaTy `mkFunTy` alphaTy))
- ] `thenDs` \ [c,n,g] ->
- returnDs (mkBuild charTy new_tyvar c n g (
- foldl App
- (CoTyApp (CoTyApp (Var foldrId) charTy) new_ty) *** ensure non-prim type ***
- [VarArg c,VarArg n,LitArg (NoRepStr str)]))
--}
-
--- otherwise, leave it as a NoRepStr;
--- the Core-to-STG pass will wrap it in an application of "unpackCStringId".
-
-dsExpr (HsLitOut (HsString str) _)
- = returnDs (mkLit (NoRepStr str stringTy))
-
-dsExpr (HsLitOut (HsLitLit str) ty)
- | isUnLiftedType ty
- = returnDs (mkLit (MachLitLit str ty))
- | otherwise
- = case (maybeBoxedPrimType ty) of
- Just (boxing_data_con, prim_ty) ->
- returnDs ( mkConApp boxing_data_con [mkLit (MachLitLit str prim_ty)] )
- _ ->
- pprError "ERROR:"
- (vcat
- [ hcat [ text "Cannot see data constructor of ``literal-literal''s type: "
- , text "value:", quotes (quotes (ptext str))
- , text "; type: ", ppr ty
- ]
- , text "Try compiling with -fno-prune-tydecls."
- ])
-
- where
- (data_con, prim_ty)
- = case (maybeBoxedPrimType ty) of
- Just (boxing_data_con, prim_ty) -> (boxing_data_con, prim_ty)
- Nothing
- -> pprPanic "ERROR: ``literal-literal'' not a single-constructor type: "
- (hcat [ptext str, text "; type: ", ppr ty])
-
-dsExpr (HsLitOut (HsInt i) ty)
- = returnDs (mkLit (NoRepInteger i ty))
-
-dsExpr (HsLitOut (HsFrac r) ty)
- = returnDs (mkLit (NoRepRational r ty))
-
--- others where we know what to do:
-
-dsExpr (HsLitOut (HsIntPrim i) _)
- | (i >= toInteger minInt && i <= toInteger maxInt)
- = returnDs (mkLit (mkMachInt i))
- | otherwise
- = error ("ERROR: Int constant " ++ show i ++ out_of_range_msg)
-
-dsExpr (HsLitOut (HsFloatPrim f) _)
- = returnDs (mkLit (MachFloat f))
- -- ToDo: range checking needed!
-
-dsExpr (HsLitOut (HsDoublePrim d) _)
- = returnDs (mkLit (MachDouble d))
- -- ToDo: range checking needed!
-
-dsExpr (HsLitOut (HsChar c) _)
- = returnDs ( mkConApp charDataCon [mkLit (MachChar c)] )
-
-dsExpr (HsLitOut (HsCharPrim c) _)
- = returnDs (mkLit (MachChar c))
-
-dsExpr (HsLitOut (HsStringPrim s) _)
- = returnDs (mkLit (MachStr s))
-
--- end of literals magic. --