{-
| trace (showSDoc (
(char ' '
- $$ (ppr.filter (not.isTyVar).varSetElems.fst) rhs
+ $$ (ppr.filter (not.isTyCoVar).varSetElems.fst) rhs
$$ pprCoreExpr (deAnnotate rhs)
$$ char ' '
))) False
rhs_code <- schemeE (d_alts+size) s p' rhs
return (my_discr alt, unitOL (UNPACK size) `appOL` rhs_code)
where
- real_bndrs = filter (not.isTyVar) bndrs
+ real_bndrs = filter (not.isTyCoVar) bndrs
my_discr (DEFAULT, _, _) = NoDiscr {-shouldn't really happen-}
my_discr (DataAlt dc, _, _)
= DiscrP (fromIntegral (dataConTag dc - fIRST_TAG))
my_discr (LitAlt l, _, _)
= case l of MachInt i -> DiscrI (fromInteger i)
+ MachWord w -> DiscrW (fromInteger w)
MachFloat r -> DiscrF (fromRational r)
MachDouble r -> DiscrD (fromRational r)
MachChar i -> DiscrI (ord i)
= case target of
DynamicTarget
-> return (False, panic "ByteCodeGen.generateCCall(dyn)")
- StaticTarget target
+
+ StaticTarget target _
-> do res <- ioToBc (lookupStaticPtr stdcall_adj_target)
return (True, res)
where
stdcall_adj_target
#ifdef mingw32_TARGET_OS
| StdCallConv <- cconv
- = let size = a_reps_sizeW * wORD_SIZE in
+ = let size = fromIntegral a_reps_sizeW * wORD_SIZE in
mkFastString (unpackFS target ++ '@':show size)
#endif
| otherwise
-- if it was, it would be impossible
-- to create a valid return value
-- placeholder on the stack
+
+ blargh :: a -- Used at more than one type
blargh = pprPanic "maybe_getCCallReturn: can't handle:"
(pprType fn_ty)
in
\(DiscrI i) fail_label -> TESTEQ_I i fail_label,
DiscrI minBound,
DiscrI maxBound );
+ DiscrW _ -> ( \(DiscrW i) fail_label -> TESTLT_W i fail_label,
+ \(DiscrW i) fail_label -> TESTEQ_W i fail_label,
+ DiscrW minBound,
+ DiscrW maxBound );
DiscrF _ -> ( \(DiscrF f) fail_label -> TESTLT_F f fail_label,
\(DiscrF f) fail_label -> TESTEQ_F f fail_label,
DiscrF minF,
Nothing -> (minBound, maxBound)
(DiscrI i1) `eqAlt` (DiscrI i2) = i1 == i2
+ (DiscrW w1) `eqAlt` (DiscrW w2) = w1 == w2
(DiscrF f1) `eqAlt` (DiscrF f2) = f1 == f2
(DiscrD d1) `eqAlt` (DiscrD d2) = d1 == d2
(DiscrP i1) `eqAlt` (DiscrP i2) = i1 == i2
_ `eqAlt` _ = False
(DiscrI i1) `leAlt` (DiscrI i2) = i1 <= i2
+ (DiscrW w1) `leAlt` (DiscrW w2) = w1 <= w2
(DiscrF f1) `leAlt` (DiscrF f2) = f1 <= f2
(DiscrD d1) `leAlt` (DiscrD d2) = d1 <= d2
(DiscrP i1) `leAlt` (DiscrP i2) = i1 <= i2
isNoDiscr _ = False
dec (DiscrI i) = DiscrI (i-1)
+ dec (DiscrW w) = DiscrW (w-1)
dec (DiscrP i) = DiscrP (i-1)
dec other = other -- not really right, but if you
-- do cases on floating values, you'll get what you deserve
-- Describes case alts
data Discr
= DiscrI Int
+ | DiscrW Word
| DiscrF Float
| DiscrD Double
| DiscrP Word16
instance Outputable Discr where
ppr (DiscrI i) = int i
+ ppr (DiscrW w) = text (show w)
ppr (DiscrF f) = text (show f)
ppr (DiscrD d) = text (show d)
ppr (DiscrP i) = ppr i
-- whereas value lambdas cannot; that is why they are nuked here
bcView (AnnNote _ (_,e)) = Just e
bcView (AnnCast (_,e) _) = Just e
-bcView (AnnLam v (_,e)) | isTyVar v = Just e
+bcView (AnnLam v (_,e)) | isTyCoVar v = Just e
bcView (AnnApp (_,e) (_, AnnType _)) = Just e
bcView _ = Nothing